1: %% 2: %% %CopyrightBegin% 3: %% 4: %% Copyright Ericsson AB 2009-2013. All Rights Reserved. 5: %% 6: %% The contents of this file are subject to the Erlang Public License, 7: %% Version 1.1, (the "License"); you may not use this file except in 8: %% compliance with the License. You should have received a copy of the 9: %% Erlang Public License along with this software. If not, it can be 10: %% retrieved online at http://www.erlang.org/. 11: %% 12: %% Software distributed under the License is distributed on an "AS IS" 13: %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 14: %% the License for the specific language governing rights and limitations 15: %% under the License. 16: %% 17: %% %CopyrightEnd% 18: %% 19: -module(io_proto_SUITE). 20: -compile(r12). 21: 22: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 23: init_per_group/2,end_per_group/2]). 24: 25: -export([init_per_testcase/2, end_per_testcase/2]). 26: 27: -export([setopts_getopts/1,unicode_options/1,unicode_options_gen/1, 28: binary_options/1, bc_with_r12/1, 29: bc_with_r12_gl/1, read_modes_gl/1,bc_with_r12_ogl/1, 30: read_modes_ogl/1, broken_unicode/1,eof_on_pipe/1,unicode_prompt/1]). 31: 32: 33: -export([io_server_proxy/1,start_io_server_proxy/0, proxy_getall/1, 34: proxy_setnext/2, proxy_quit/1]). 35: %% For spawn 36: -export([toerl_server/3,hold_the_line/3,answering_machine1/3, 37: answering_machine2/3]). 38: 39: -export([uprompt/1]). 40: 41: %-define(without_test_server, true). 42: 43: -ifdef(without_test_server). 44: -define(line, put(line, ?LINE), ). 45: -define(config(X,Y), foo). 46: -define(t, test_server). 47: -define(privdir(_), "./io_SUITE_priv"). 48: -else. 49: -include_lib("test_server/include/test_server.hrl"). 50: -define(privdir(Conf), ?config(priv_dir, Conf)). 51: -endif. 52: 53: %%-define(debug, true). 54: 55: -ifdef(debug). 56: -define(format(S, A), io:format(S, A)). 57: -define(dbg(Data),io:format(standard_error, "DBG: ~p\r\n",[Data])). 58: -define(RM_RF(Dir),begin io:format(standard_error, "Not Removed: ~p\r\n",[Dir]), 59: ok end). 60: -else. 61: -define(format(S, A), ok). 62: -define(dbg(Data),noop). 63: -define(RM_RF(Dir),rm_rf(Dir)). 64: -endif. 65: 66: 67: % Default timetrap timeout (set in init_per_testcase). 68: -define(default_timeout, ?t:minutes(20)). 69: 70: init_per_testcase(_Case, Config) -> 71: ?line Dog = ?t:timetrap(?default_timeout), 72: Term = case os:getenv("TERM") of 73: List when is_list(List) -> 74: List; 75: _ -> 76: "dumb" 77: end, 78: os:putenv("TERM","vt100"), 79: [{watchdog, Dog}, {term, Term} | Config]. 80: end_per_testcase(_Case, Config) -> 81: Dog = ?config(watchdog, Config), 82: Term = ?config(term,Config), 83: os:putenv("TERM",Term), 84: test_server:timetrap_cancel(Dog), 85: ok. 86: 87: suite() -> [{ct_hooks,[ts_install_cth]}]. 88: 89: all() -> 90: [setopts_getopts, unicode_options, unicode_options_gen, 91: binary_options, bc_with_r12, bc_with_r12_gl, 92: bc_with_r12_ogl, read_modes_gl, read_modes_ogl, 93: broken_unicode, eof_on_pipe, unicode_prompt]. 94: 95: groups() -> 96: []. 97: 98: init_per_suite(Config) -> 99: DefShell = get_default_shell(), 100: [{default_shell,DefShell}|Config]. 101: 102: end_per_suite(_Config) -> 103: ok. 104: 105: init_per_group(_GroupName, Config) -> 106: Config. 107: 108: end_per_group(_GroupName, Config) -> 109: Config. 110: 111: 112: 113: -record(state, { 114: q = [], 115: nxt = eof, 116: mode = list 117: }). 118: 119: uprompt(_L) -> 120: [1050,1072,1082,1074,1086,32,1077,32,85,110,105,99,111,100,101,32,63]. 121: 122: unicode_prompt(suite) -> 123: []; 124: unicode_prompt(doc) -> 125: ["Test that an Unicode prompt does not crash the shell"]; 126: unicode_prompt(Config) when is_list(Config) -> 127: ?line PA = filename:dirname(code:which(?MODULE)), 128: case proplists:get_value(default_shell,Config) of 129: old -> 130: ok; 131: new -> 132: ?line rtnode([{putline,""}, 133: {putline, "2."}, 134: {getline, "2"}, 135: {putline, "shell:prompt_func({io_proto_SUITE,uprompt})."}, 136: {getline, "default"}, 137: {putline, "io:get_line('')."}, 138: {putline, "hej"}, 139: {getline, "\"hej\\n\""}, 140: {putline, "io:setopts([{binary,true}])."}, 141: {getline, "ok"}, 142: {putline, "io:get_line('')."}, 143: {putline, "hej"}, 144: {getline, "<<\"hej\\n\">>"} 145: ],[],[],"-pa \""++ PA++"\"") 146: end, 147: %% And one with oldshell 148: ?line rtnode([{putline,""}, 149: {putline, "2."}, 150: {getline_re, ".*2$"}, 151: {putline, "shell:prompt_func({io_proto_SUITE,uprompt})."}, 152: {getline_re, ".*default"}, 153: {putline, "io:get_line('')."}, 154: {putline, "hej"}, 155: {getline_re, ".*\"hej\\\\n\""}, 156: {putline, "io:setopts([{binary,true}])."}, 157: {getline_re, ".*ok"}, 158: {putline, "io:get_line('')."}, 159: {putline, "hej"}, 160: {getline_re, ".*<<\"hej\\\\n\">>"} 161: ],[],[],"-oldshell -pa \""++PA++"\""), 162: ok. 163: 164: 165: setopts_getopts(suite) -> 166: []; 167: setopts_getopts(doc) -> 168: ["Check io:setopts and io:getopts functions"]; 169: setopts_getopts(Config) when is_list(Config) -> 170: ?line FileName = filename:join([?config(priv_dir,Config), 171: "io_proto_SUITE_setopts_getopts.dat"]), 172: ?line {ok,WFile} = file:open(FileName,[write]), 173: ?line Server = start_io_server_proxy(), 174: ?line [{binary, false}] = io:getopts(Server), 175: ?line [getopts] = proxy_getall(Server), 176: ?line [{binary,false},{encoding,latin1}] = lists:sort(io:getopts(WFile)), 177: ?line proxy_setnext(Server,"Hej"), 178: ?line "Hej" = io:get_line(Server,''), 179: ?line proxy_setnext(Server,"Hej"++[532]), 180: ?line [$H,$e,$j,532] = io:get_line(Server,''), 181: ?line ok = io:setopts(Server,[{binary,true}]), 182: ?line proxy_setnext(Server,"Hej"), 183: ?line <<"Hej">> = io:get_line(Server,''), 184: ?line proxy_setnext(Server,"Hej"++[532]), 185: ?line <<72,101,106,200,148>> = io:get_line(Server,''), 186: ?line [$H,$e,$j,532] = lists:flatten(io_lib:format("~ts",[<<72,101,106,200,148>>])), 187: ?line file:write(WFile,<<"HejA">>), 188: ?line file:write(WFile,unicode:characters_to_binary("Hej"++[532],unicode,unicode)), 189: ?line file:write(WFile,unicode:characters_to_binary("Hej"++[532],unicode,{utf16,big})), 190: ?line file:write(WFile,unicode:characters_to_binary("Hej"++[532],unicode,{utf16,little})), 191: ?line file:write(WFile,unicode:characters_to_binary("Hej"++[532],unicode,{utf32,big})), 192: ?line file:write(WFile,unicode:characters_to_binary("Hej"++[532],unicode,{utf32,little})), 193: ?line file:close(WFile), 194: ?line {ok,RFile} = file:open(FileName,[read]), 195: ?line [{binary,false},{encoding,latin1}] = lists:sort(io:getopts(RFile)), 196: ?line [$H,$e,$j,$A] = io:get_chars(RFile,'',4), 197: ?line io:setopts(RFile,[{encoding,unicode}]), 198: ?line [$H,$e,$j,532] = io:get_chars(RFile,'',4), 199: ?line [{binary,false},{encoding,unicode}] = lists:sort(io:getopts(RFile)), 200: ?line io:setopts(RFile,[{encoding,{utf16,big}}]), 201: ?line [$H,$e,$j,532] = io:get_chars(RFile,'',4), 202: ?line [{binary,false},{encoding,{utf16,big}}] = 203: lists:sort(io:getopts(RFile)), 204: ?line io:setopts(RFile,[{encoding,{utf16,little}}]), 205: ?line [$H,$e,$j,532] = io:get_chars(RFile,'',4), 206: ?line [{binary,false},{encoding,{utf16,little}}] = 207: lists:sort(io:getopts(RFile)), 208: ?line io:setopts(RFile,[{encoding,{utf32,big}}]), 209: ?line [$H,$e,$j,532] = io:get_chars(RFile,'',4), 210: ?line [{binary,false},{encoding,{utf32,big}}] = 211: lists:sort(io:getopts(RFile)), 212: ?line io:setopts(RFile,[{encoding,{utf32,little}}]), 213: ?line [$H,$e,$j,532] = io:get_chars(RFile,'',4), 214: ?line [{binary,false},{encoding,{utf32,little}}] = 215: lists:sort(io:getopts(RFile)), 216: ?line eof = io:get_line(RFile,''), 217: ?line file:position(RFile,0), 218: ?line io:setopts(RFile,[{binary,true},{encoding,latin1}]), 219: ?line <<$H,$e,$j,$A>> = io:get_chars(RFile,'',4), 220: ?line [{binary,true},{encoding,latin1}] = lists:sort(io:getopts(RFile)), 221: ?line io:setopts(RFile,[{encoding,unicode}]), 222: ?line <<$H,$e,$j,532/utf8>> = io:get_chars(RFile,'',4), 223: ?line [{binary,true},{encoding,unicode}] = lists:sort(io:getopts(RFile)), 224: ?line io:setopts(RFile,[{encoding,{utf16,big}}]), 225: ?line <<$H,$e,$j,532/utf8>> = io:get_chars(RFile,'',4), 226: ?line [{binary,true},{encoding,{utf16,big}}] = 227: lists:sort(io:getopts(RFile)), 228: ?line io:setopts(RFile,[{encoding,{utf16,little}}]), 229: ?line <<$H,$e,$j,532/utf8>> = io:get_chars(RFile,'',4), 230: ?line [{binary,true},{encoding,{utf16,little}}] = 231: lists:sort(io:getopts(RFile)), 232: ?line io:setopts(RFile,[{encoding,{utf32,big}}]), 233: ?line <<$H,$e,$j,532/utf8>> = io:get_chars(RFile,'',4), 234: ?line [{binary,true},{encoding,{utf32,big}}] = 235: lists:sort(io:getopts(RFile)), 236: ?line io:setopts(RFile,[{encoding,{utf32,little}}]), 237: ?line <<$H,$e,$j,532/utf8>> = io:get_chars(RFile,'',4), 238: ?line [{binary,true},{encoding,{utf32,little}}] = 239: lists:sort(io:getopts(RFile)), 240: ?line eof = io:get_line(RFile,''), 241: ?line file:close(RFile), 242: case proplists:get_value(default_shell,Config) of 243: old -> 244: ok; 245: new -> 246: %% So, lets test another node with new interactive shell 247: ?line rtnode([{putline,""}, 248: {putline, "2."}, 249: {getline, "2"}, 250: {putline, "lists:keyfind(binary,1,io:getopts())."}, 251: {getline, "{binary,false}"}, 252: {putline, "io:get_line('')."}, 253: {putline, "hej"}, 254: {getline, "\"hej\\n\""}, 255: {putline, "io:setopts([{binary,true}])."}, 256: {getline, "ok"}, 257: {putline, "io:get_line('')."}, 258: {putline, "hej"}, 259: {getline, "<<\"hej\\n\">>"} 260: ],[]) 261: end, 262: %% And one with oldshell 263: ?line rtnode([{putline,""}, 264: {putline, "2."}, 265: {getline_re, ".*2$"}, 266: {putline, "lists:keyfind(binary,1,io:getopts())."}, 267: {getline_re, ".*{binary,false}"}, 268: {putline, "io:get_line('')."}, 269: {putline, "hej"}, 270: {getline_re, ".*\"hej\\\\n\""}, 271: {putline, "io:setopts([{binary,true}])."}, 272: {getline_re, ".*ok"}, 273: {putline, "io:get_line('')."}, 274: {putline, "hej"}, 275: {getline_re, ".*<<\"hej\\\\n\">>"} 276: ],[],[],"-oldshell"), 277: ok. 278: 279: 280: get_lc_ctype() -> 281: case {os:type(),os:version()} of 282: {{unix,sunos},{5,N,_}} when N =< 8 -> 283: "iso_8859_1"; 284: _ -> 285: "ISO-8859-1" 286: end. 287: 288: unicode_options(suite) -> 289: []; 290: unicode_options(doc) -> 291: ["Tests various unicode options"]; 292: unicode_options(Config) when is_list(Config) -> 293: DataDir = ?config(data_dir,Config), 294: PrivDir = ?config(priv_dir,Config), 295: %% A string in both russian and greek characters, which is present 296: %% in all the internal test files (but in different formats of course)... 297: TestData = [1090,1093,1077,32,1073,1080,1075,32, 298: 1088,1077,1076,32,1092,1086,1100,32,1093, 299: 1072,1089,32,1089,1086,1100,32,932,951,949, 300: 32,946,953,947,32,961,949,948,32, 301: 963,959,967,32,945,961,949,32,966,959,967,949,963], 302: %% Testdata from Chinese open source customer, that triggered OTP-7974 303: TestData2 = [46,46,46,12411,12370,12411,12370,44,12411,12370,12411,12370,44, 304: 12411,12370,12411,12370,44,12411,12370,12411,12370,44,12411,12370, 305: 12411,12370,44,44,44,12411,12370,12411,12370,44,44,12411,12370,12411, 306: 12370,44,12411,12370,12411,12370,44,12411,12370,12411,12370,44,12411, 307: 12370,12411,12370,44,12411,12370,12411,12370,44,44,44,10], 308: 309: %% The external test files are generated with a BOM writing 310: %% text editor. A shorter line is written (with two characters 311: %% larger than 127). 312: ExternalTestData = [197,116,101,114,101,114,246,118,114,97], 313: InternalBomFiles = ["testdata_utf8_bom.dat", 314: "testdata_utf16_big_bom.dat", 315: "testdata_utf16_little_bom.dat", 316: "testdata_utf32_big_bom.dat", 317: "testdata_utf32_little_bom.dat"], 318: AllNoBom = [{utf8,"testdata_utf8.dat"}, 319: {utf16,"testdata_utf16_big.dat"}, 320: {{utf16,big},"testdata_utf16_big.dat"}, 321: {{utf16,little},"testdata_utf16_little.dat"}, 322: {utf32,"testdata_utf32_big.dat"}, 323: {{utf32,big},"testdata_utf32_big.dat"}, 324: {{utf32,little},"testdata_utf32_little.dat"}], 325: ExternalBomFiles = ["external_utf8_bom.dat", 326: "external_utf16_little_bom.dat", 327: "external_utf16_big_bom.dat"], 328: ReadBomFile = fun(File,Dir) -> 329: %io:format(standard_error,"~s\r\n",[filename:join([Dir,File])]), 330: {ok,F} = file:open(filename:join([Dir,File]), 331: [read,binary]), 332: {ok,Bin} = file:read(F,4), 333: {Type,Bytes} = unicode:bom_to_encoding(Bin), 334: %io:format(standard_error,"~p\r\n",[{Type,Bytes}]), 335: 336: file:position(F,Bytes), 337: io:setopts(F,[{encoding,Type}]), 338: R = unicode:characters_to_list( 339: io:get_chars(F,'',length(TestData)),unicode), 340: file:close(F), 341: R 342: end, 343: ReadBomlessFile = fun({Type,File},DataLen,Dir) -> 344: {ok,F} = file:open(filename:join([Dir,File]), 345: [read,binary, 346: {encoding,Type}]), 347: R = unicode:characters_to_list( 348: io:get_chars(F,'',DataLen),unicode), 349: file:close(F), 350: R 351: end, 352: ReadBomlessFileList = fun({Type,File},DataLen,Dir) -> 353: {ok,F} = file:open(filename:join([Dir,File]), 354: [read, 355: {encoding,Type}]), 356: R = io:get_chars(F,'',DataLen), 357: file:close(F), 358: R 359: end, 360: ReadBomlessFileListLine = fun({Type,File},Dir) -> 361: {ok,F} = file:open(filename:join([Dir,File]), 362: [read, 363: {encoding,Type}]), 364: R = io:get_line(F,''), 365: file:close(F), 366: R 367: end, 368: ?line [TestData = ReadBomFile(F,DataDir) || F <- InternalBomFiles ], 369: ?line [ExternalTestData = ReadBomFile(F,DataDir) || F <- ExternalBomFiles ], 370: ?line [TestData = ReadBomlessFile(F,length(TestData),DataDir) || F <- AllNoBom ], 371: ?line [TestData = ReadBomlessFileList(F,length(TestData),DataDir) || F <- AllNoBom ], 372: ?line [TestData = ReadBomlessFileListLine(F,DataDir) || F <- AllNoBom ], 373: 374: BomDir = filename:join([PrivDir,"BOMDATA"]), 375: BomlessDir = filename:join([PrivDir,"BOMLESSDATA"]), 376: file:make_dir(BomDir), 377: file:make_dir(BomlessDir), 378: 379: WriteBomFile = fun({Enc,File},Dir) -> 380: {ok,F} = file:open(filename:join([Dir,File]), 381: [write,binary]), 382: file:write(F,unicode:encoding_to_bom(Enc)), 383: io:setopts(F,[{encoding,Enc}]), 384: io:put_chars(F,TestData), 385: file:close(F), 386: ok 387: end, 388: ?line [ ok = WriteBomFile(F,BomDir) || F <- AllNoBom ], 389: ?line [TestData = ReadBomFile(F,BomDir) || {_,F} <- AllNoBom ], 390: WriteBomlessFile = fun({Enc,File},TData,Dir) -> 391: {ok,F} = file:open( 392: filename:join([Dir,File]), 393: [write,binary,{encoding,Enc}]), 394: io:put_chars(F,TData), 395: file:close(F), 396: ok 397: end, 398: ?line [ ok = WriteBomlessFile(F,TestData,BomlessDir) || F <- AllNoBom ], 399: ?line [TestData = ReadBomlessFile(F,length(TestData),BomlessDir) || F <- AllNoBom ], 400: ?line [TestData = ReadBomlessFileList(F,length(TestData),BomlessDir) || F <- AllNoBom ], 401: ?line [TestData = ReadBomlessFileListLine(F,BomlessDir) || F <- AllNoBom ], 402: 403: CannotReadFile = fun({Enc,File},Dir) -> 404: %io:format(standard_error,"~s\r\n",[filename:join([Dir,File])]), 405: {ok,F} = file:open( 406: filename:join([Dir,File]), 407: [read,binary,{encoding,Enc}]), 408: Enc2 = case Enc of 409: utf8 -> 410: unicode; 411: Tpl when is_tuple(Tpl) -> 412: Tpl; 413: Atom when is_atom(Atom) -> 414: {Atom, big} 415: end, 416: {error, {no_translation,Enc2,latin1}} = 417: file:read(F,10), 418: {error,terminated} = io:get_chars(F,'',10), 419: ok 420: end, 421: ?line [ ok = CannotReadFile(F,DataDir) || F <- AllNoBom ], 422: ?line [ ok = CannotReadFile(F,BomlessDir) || F <- AllNoBom ], 423: ?line [ ok = CannotReadFile(F,BomDir) || F <- AllNoBom ], 424: 425: ?line [ ok = WriteBomlessFile(F,TestData2,BomlessDir) || F <- AllNoBom ], 426: ?line [TestData2 = ReadBomlessFile(F,length(TestData2),BomlessDir) || F <- AllNoBom ], 427: ?line [TestData2 = ReadBomlessFileList(F,length(TestData2),BomlessDir) || F <- AllNoBom ], 428: ?line [TestData2 = ReadBomlessFileListLine(F,BomlessDir) || F <- AllNoBom ], 429: 430: 431: FailDir = filename:join([PrivDir,"FAIL"]), 432: file:make_dir(FailDir), 433: 434: CannotWriteFile = fun({_Enc,File},Dir) -> 435: {ok,F} = file:open( 436: filename:join([Dir,File]), 437: [write,binary]), 438: ?line {'EXIT', {no_translation,_}} = 439: (catch io:put_chars(F,TestData)), 440: ?line {'EXIT', {terminated,_}} = (catch io:put_chars(F,TestData)), 441: ok 442: end, 443: ?line [ ok = CannotWriteFile(F,FailDir) || F <- AllNoBom ], 444: 445: case proplists:get_value(default_shell,Config) of 446: old -> 447: ok; 448: new -> 449: %% OK, time for the group_leaders... 450: ?line rtnode([{putline,""}, 451: {putline, "2."}, 452: {getline, "2"}, 453: {putline, "lists:keyfind(encoding,1,io:getopts())."}, 454: {getline, "{encoding,latin1}"}, 455: {putline, "io:format(\"~ts~n\",[[1024]])."}, 456: {getline, "\\x{400}"}, 457: {putline, "io:setopts([unicode])."}, 458: {getline, "ok"}, 459: {putline, "io:format(\"~ts~n\",[[1024]])."}, 460: {getline, 461: binary_to_list(unicode:characters_to_binary( 462: [1024],unicode,utf8))} 463: ],[],"LC_CTYPE=\""++get_lc_ctype()++"\"; " 464: "export LC_CTYPE; ") 465: end, 466: ?line rtnode([{putline,""}, 467: {putline, "2."}, 468: {getline_re, ".*2$"}, 469: {putline, "lists:keyfind(encoding,1,io:getopts())."}, 470: {getline_re, ".*{encoding,latin1}"}, 471: {putline, "io:format(\"~ts~n\",[[1024]])."}, 472: {getline_re, ".*\\\\x{400\\}"}, 473: {putline, "io:setopts([{encoding,unicode}])."}, 474: {getline_re, ".*ok"}, 475: {putline, "io:format(\"~ts~n\",[[1024]])."}, 476: {getline_re, 477: ".*"++binary_to_list(unicode:characters_to_binary( 478: [1024],unicode,utf8))} 479: ],[],"LC_CTYPE=\""++get_lc_ctype()++"\"; export LC_CTYPE; ", 480: " -oldshell "), 481: 482: ok. 483: 484: unicode_options_gen(suite) -> 485: []; 486: unicode_options_gen(doc) -> 487: ["Tests various unicode options on random generated files"]; 488: unicode_options_gen(Config) when is_list(Config) -> 489: ?line random:seed(1240,900586,553728), 490: ?line PrivDir = ?config(priv_dir,Config), 491: ?line AllModes = [utf8,utf16,{utf16,big},{utf16,little},utf32,{utf32,big},{utf32,little}], 492: ?line FSize = 17*1024, 493: ?line NumItersRead = 2, 494: ?line NumItersWrite = 2, 495: ?line Dir = filename:join([PrivDir,"GENDATA1"]), 496: ?line file:make_dir(Dir), 497: 498: %dbg:tracer(process,{fun(A,_) -> erlang:display(A) end,true}), 499: %dbg:tpl(file_io_server,x), 500: %dbg:ctpl(file_io_server,cafu), 501: %dbg:tp(unicode,x), 502: 503: DoOneFile1 = fun(Encoding,N,M) -> 504: ?dbg({Encoding,M,N}), 505: io:format("Read test: Encoding ~p, Chunk size ~p, Iteration ~p~n",[Encoding,M,N]), 506: io:format(standard_error,"Read test: Encoding ~p, Chunk size ~p, Iteration ~p\r\n",[Encoding,M,N]), 507: ?line Fname = filename:join([Dir,"genfile_"++enc2str(Encoding)++"_"++integer_to_list(N)]), 508: ?dbg(?LINE), 509: ?line Ulist = random_unicode(FSize), 510: ?dbg(?LINE), 511: ?line my_write_file(Fname,Ulist,Encoding), 512: ?dbg(?LINE), 513: ?line {ok,F1} = file:open(Fname,[read,{encoding,Encoding}]), 514: 515: ?dbg(?LINE), 516: ?line Res1 = read_whole_file(fun(FD) -> io:get_line(FD,'') end,F1), 517: ?dbg(?LINE), 518: ?line Ulist = unicode:characters_to_list(Res1,unicode), 519: ?dbg(?LINE), 520: ?line file:close(F1), 521: ?line {ok,F2} = file:open(Fname, [read,binary,{encoding,Encoding}]), 522: ?line Res2 = read_whole_file(fun(FD) -> io:get_chars(FD,'',M) end,F2), 523: ?line Ulist = unicode:characters_to_list(Res2,unicode), 524: ?dbg(?LINE), 525: ?line file:close(F2), 526: ?line {ok,F3} = file:open(Fname, [read,binary,{encoding,Encoding}]), 527: ?dbg(?LINE), 528: %% case {Encoding,M,N} of 529: %% {{utf16,little},10,2} -> 530: %% dbg:p(F3,call); 531: %% _ -> 532: %% ok 533: %% end, 534: 535: ?line Res3 = read_whole_file(fun(FD) -> case io:fread(FD,'',"~ts") of {ok,D} -> D; O -> O end end, F3), 536: ?dbg(?LINE), 537: ?line Ulist2 = [ X || X <- Ulist, 538: X =/= $\n, X =/= $ ], 539: ?dbg(?LINE), 540: ?line Ulist2 = unicode:characters_to_list(Res3,unicode), 541: ?dbg(?LINE), 542: ?line file:close(F3), 543: ?line {ok,F4} = file:open(Fname, [read,{encoding,Encoding}]), 544: ?line Res4 = read_whole_file(fun(FD) -> case io:fread(FD,'',"~tc") of {ok,D} -> D; O -> O end end,F4), 545: ?line Ulist3 = [ X || X <- Ulist, 546: X =/= $\n ], 547: ?line Ulist3 = unicode:characters_to_list(Res4,unicode), 548: ?dbg(?LINE), 549: ?line file:close(F4), 550: ?line file:delete(Fname) 551: end, 552: 553: [ [ [ DoOneFile1(E,N,M) || E <- AllModes ] || M <- [10,1000,128,1024,8192,8193] ] || N <- lists:seq(1,NumItersRead)], 554: DoOneFile2 = fun(Encoding,N,M) -> 555: ?dbg({Encoding,M,N}), 556: io:format("Write test: Encoding ~p, Chunk size ~p, Iteration ~p~n",[Encoding,M,N]), 557: io:format(standard_error,"Write test: Encoding ~p, Chunk size ~p, Iteration ~p\r\n",[Encoding,M,N]), 558: ?line Fname = filename:join([Dir,"genfile_"++enc2str(Encoding)++"_"++integer_to_list(N)]), 559: ?dbg(?LINE), 560: ?line Ulist = random_unicode(FSize), 561: ?dbg(?LINE), 562: ?line {ok,F1} = file:open(Fname,[write,{encoding,Encoding}]), 563: ?line io:put_chars(F1,Ulist), 564: ?line file:close(F1), 565: ?line Ulist = my_read_file(Fname,Encoding), 566: ?line file:delete(Fname), 567: ?line {ok,F2} = file:open(Fname,[write,binary,{encoding,Encoding}]), 568: ?line io:put_chars(F2,Ulist), 569: ?line file:close(F2), 570: ?line Ulist = my_read_file(Fname,Encoding), 571: ?line file:delete(Fname), 572: ?line {ok,F3} = file:open(Fname,[write,{encoding,Encoding}]), 573: ?line LL = string:tokens(Ulist,"\n"), 574: ?line Ulist2 = lists:flatten(LL), 575: ?line [ io:format(F3,"~ts",[L]) || L <- LL ], 576: ?line file:close(F3), 577: ?line Ulist2 = my_read_file(Fname,Encoding), 578: ?line file:delete(Fname), 579: ?line {ok,F4} = file:open(Fname,[write,{encoding,Encoding}]), 580: ?line [ io:format(F4,"~tc",[C]) || C <- Ulist ], 581: ?line file:close(F4), 582: ?line Ulist = my_read_file(Fname,Encoding), 583: ?line file:delete(Fname), 584: ?line {ok,F5} = file:open(Fname,[write,{encoding,Encoding}]), 585: ?line io:put_chars(F5,unicode:characters_to_binary(Ulist)), 586: ?line file:close(F5), 587: ?line Ulist = my_read_file(Fname,Encoding), 588: ?line file:delete(Fname), 589: ok 590: end, 591: [ [ [ DoOneFile2(E,N,M) || E <- AllModes ] || M <- [10,1000,128,1024,8192,8193] ] || N <- lists:seq(1,NumItersWrite)], 592: ok. 593: 594: 595: 596: 597: read_whole_file(Fun,F) -> 598: case Fun(F) of 599: eof -> 600: []; 601: {error,Error} -> 602: ?dbg(Error), 603: receive after 10000 -> ok end, 604: exit(Error); 605: Other -> 606: %?dbg(Other), 607: [Other | read_whole_file(Fun,F)] 608: end. 609: 610: 611: enc2str(Atom) when is_atom(Atom) -> 612: atom_to_list(Atom); 613: enc2str({A1,A2}) when is_atom(A1), is_atom(A2) -> 614: atom_to_list(A1)++"_"++atom_to_list(A2). 615: 616: 617: 618: 619: my_write_file(Filename,UniList,Encoding) -> 620: Bin = unicode:characters_to_binary(UniList,utf8,Encoding), 621: file:write_file(Filename,Bin). 622: 623: my_read_file(Filename,Encoding) -> 624: {ok,Bin} = file:read_file(Filename), 625: unicode:characters_to_list(Bin,Encoding). 626: 627: random_unicode(0) -> 628: []; 629: random_unicode(N) -> 630: % Favour large unicode and make linebreaks 631: X = case random:uniform(20) of 632: A when A =< 1 -> $\n; 633: A0 when A0 =< 3 -> random:uniform(16#10FFFF); 634: A1 when A1 =< 6 -> random:uniform(16#10FFFF - 16#7F) + 16#7F; 635: A2 when A2 =< 12 -> random:uniform(16#10FFFF - 16#7FF) + 16#7FF; 636: _ -> random:uniform(16#10FFFF - 16#FFFF) + 16#FFFF 637: end, 638: case X of 639: Inv1 when Inv1 >= 16#D800, Inv1 =< 16#DFFF; 640: Inv1 =:= 16#FFFE; 641: Inv1 =:= 16#FFFF -> 642: random_unicode(N); 643: _ -> 644: [X | random_unicode(N-1)] 645: end. 646: 647: 648: binary_options(suite) -> 649: []; 650: binary_options(doc) -> 651: ["Tests variants with binary option"]; 652: binary_options(Config) when is_list(Config) -> 653: DataDir = ?config(data_dir,Config), 654: PrivDir = ?config(priv_dir,Config), 655: TestData = unicode:characters_to_binary( 656: [1090,1093,1077,32,1073,1080,1075,32, 657: 1088,1077,1076,32,1092,1086,1100,32,1093, 658: 1072,1089,32,1089,1086,1100,32,932,951,949, 659: 32,946,953,947,32,961,949,948,32, 660: 963,959,967,32,945,961,949,32,966,959,967,949,963]), 661: <<First10:10/binary,Second10:10/binary,_/binary>> = TestData, 662: First10List = binary_to_list(First10), 663: Second10List = binary_to_list(Second10), 664: TestFile = filename:join([DataDir, "testdata_utf8.dat"]), 665: ?line {ok, F} = file:open(TestFile,[read]), 666: ?line {ok, First10List} = file:read(F,10), 667: ?line io:setopts(F,[binary]), 668: ?line {ok, Second10} = file:read(F,10), 669: ?line file:close(F), 670: ?line {ok, F2} = file:open(TestFile,[read,binary]), 671: ?line {ok, First10} = file:read(F2,10), 672: ?line io:setopts(F2,[list]), 673: ?line {ok, Second10List} = file:read(F2,10), 674: ?line file:position(F2,0), 675: %dbg:tracer(),dbg:p(F2,call),dbg:tpl(file_io_server,x), 676: ?line First10List = io:get_chars(F2,'',10), 677: ?line io:setopts(F2,[binary]), 678: ?line Second10 = unicode:characters_to_binary(io:get_chars(F2,'',10),unicode,latin1), 679: ?line file:close(F2), 680: ?line LineBreakFileName = filename:join([PrivDir, "testdata.dat"]), 681: ?line LineBreakTestData = <<TestData/binary,$\n>>, 682: ?line LineBreakTestDataList = binary_to_list(LineBreakTestData), 683: ?line file:write_file(LineBreakFileName,[LineBreakTestData,LineBreakTestData,LineBreakTestData,TestData]), 684: ?line {ok, F3} = file:open(LineBreakFileName,[read]), 685: ?line LineBreakTestDataList = io:get_line(F3,''), 686: ?line io:setopts(F3,[binary]), 687: ?line LineBreakTestData = unicode:characters_to_binary(io:get_line(F3,''),unicode,latin1), 688: ?line io:setopts(F3,[list]), 689: ?line LineBreakTestDataList = io:get_line(F3,''), 690: ?line io:setopts(F3,[binary]), 691: %ok = io:format(standard_error,"TestData = ~w~n",[TestData]), 692: ?line TestData = unicode:characters_to_binary(io:get_line(F3,''),unicode,latin1), 693: ?line eof = io:get_line(F3,''), 694: ?line file:close(F3), 695: %% OK, time for the group_leaders... 696: %% io:format(standard_error,"Hmmm:~w~n",["<<\""++binary_to_list(<<"\345\344\366"/utf8>>)++"\\n\">>"]), 697: case proplists:get_value(default_shell,Config) of 698: old -> 699: ok; 700: new -> 701: ?line rtnode([{putline, "2."}, 702: {getline, "2"}, 703: {putline, "lists:keyfind(binary,1,io:getopts())."}, 704: {getline, "{binary,false}"}, 705: {putline, "io:get_line('')."}, 706: {putline, "hej"}, 707: {getline, "\"hej\\n\""}, 708: {putline, "io:setopts([{binary,true},unicode])."}, 709: {getline, "ok"}, 710: {putline, "io:get_line('')."}, 711: {putline, "hej"}, 712: {getline, "<<\"hej\\n\">>"}, 713: {putline, "io:get_line('')."}, 714: {putline, binary_to_list(<<"\345\344\366"/utf8>>)}, 715: {getline, "<<\""++binary_to_list(<<"\345\344\366"/utf8>>)++"\\n\"/utf8>>"} 716: ],[]) 717: end, 718: %% And one with oldshell 719: ?line rtnode([{putline, "2."}, 720: {getline_re, ".*2$"}, 721: {putline, "lists:keyfind(binary,1,io:getopts())."}, 722: {getline_re, ".*{binary,false}"}, 723: {putline, "io:get_line('')."}, 724: {putline, "hej"}, 725: {getline_re, ".*\"hej\\\\n\""}, 726: {putline, "io:setopts([{binary,true},unicode])."}, 727: {getline_re, ".*ok"}, 728: {putline, "io:get_line('')."}, 729: {putline, "hej"}, 730: {getline_re, ".*<<\"hej\\\\n\">>"}, 731: {putline, "io:get_line('')."}, 732: {putline, binary_to_list(<<"\345\344\366"/utf8>>)}, 733: {getline_re, ".*<<\""++binary_to_list(<<"\345\344\366"/utf8>>)++"\\\\n\"/utf8>>"} 734: ],[],[],"-oldshell"), 735: ok. 736: 737: bc_with_r12(suite) -> 738: []; 739: bc_with_r12(doc) -> 740: ["Test io protocol compatibility with R12 nodes"]; 741: bc_with_r12(Config) when is_list(Config) -> 742: case ?t:is_release_available("r12b") of 743: true -> bc_with_r12_1(Config); 744: false -> {skip,"No R12B found"} 745: end. 746: 747: bc_with_r12_1(Config) -> 748: PA = filename:dirname(code:which(?MODULE)), 749: Name1 = io_proto_r12_1, 750: ?line N1 = list_to_atom(atom_to_list(Name1) ++ "@" ++ hostname()), 751: ?line ?t:start_node(Name1, peer, [{args, "-pz \""++PA++"\""},{erl,[{release,"r12b"}]}]), 752: DataDir = ?config(data_dir,Config), 753: %PrivDir = ?config(priv_dir,Config), 754: FileName1 = filename:join([DataDir,"testdata_latin1.dat"]), 755: TestDataLine1 = [229,228,246], 756: TestDataLine2 = [197,196,214], 757: ?line SPid1 = rpc:call(N1,erlang,spawn,[?MODULE,hold_the_line,[self(),FileName1,[read]]]), 758: ?line {ok,F1} = receive 759: {SPid1,Res1} -> 760: Res1 761: after 5000 -> 762: exit(timeout) 763: end, 764: ?line TestDataLine1 = chomp(io:get_line(F1,'')), 765: ?line SPid1 ! die, 766: receive after 1000 -> ok end, 767: ?line SPid2 = rpc:call(N1,erlang,spawn,[?MODULE,hold_the_line,[self(),FileName1,[read,binary]]]), 768: ?line {ok,F2} = receive 769: {SPid2,Res2} -> 770: Res2 771: after 5000 -> 772: exit(timeout) 773: end, 774: TestDataLine1BinUtf = unicode:characters_to_binary(TestDataLine1), 775: TestDataLine1BinLatin = list_to_binary(TestDataLine1), 776: TestDataLine2BinUtf = unicode:characters_to_binary(TestDataLine2), 777: TestDataLine2BinLatin = list_to_binary(TestDataLine2), 778: ?line TestDataLine1BinUtf = chomp(io:get_line(F2,'')), 779: ?line TestDataLine2BinUtf = chomp(io:get_line(F2,'')), 780: %io:format(standard_error,"Exec:~s\r\n",[rpc:call(N1,os,find_executable,["erl"])]), 781: %io:format(standard_error,"Io:~s\r\n",[rpc:call(N1,code,which,[io])]), 782: %io:format(standard_error,"File_io_server:~s\r\n",[rpc:call(N1,code,which,[file_io_server])]), 783: ?line file:position(F2,0), 784: ?line TestDataLine1BinLatin = chomp(rpc:call(N1,io,get_line,[F2,''])), 785: ?line TestDataLine2BinUtf = chomp(io:get_line(F2,'')), 786: ?line file:position(F2,0), 787: ?line TestDataLine1BinUtf = chomp(io:get_line(F2,'')), 788: ?line TestDataLine2BinLatin = chomp(rpc:call(N1,io,get_line,[F2,''])), 789: ?line eof = chomp(rpc:call(N1,io,get_line,[F2,''])), 790: ?line file:position(F2,0), 791: ?line TestDataLine1BinLatin = rpc:call(N1,io,get_chars,[F2,'',3]), 792: io:get_chars(F2,'',1), 793: ?line TestDataLine2BinLatin = chomp(rpc:call(N1,io,get_line,[F2,''])), 794: ?line file:position(F2,0), 795: ?line {ok,[TestDataLine1]} = io:fread(F2,'',"~s"), 796: ?line {ok,[TestDataLine2]} = rpc:call(N1,io,fread,[F2,'',"~s"]), 797: 798: ?line DataLen1 = length(TestDataLine1), 799: ?line DataLen2 = length(TestDataLine2), 800: 801: ?line file:position(F2,0), 802: ?line {ok,TestDataLine1BinLatin} = file:read(F2,DataLen1), 803: ?line {ok,_} = file:read(F2,1), 804: ?line {ok,TestDataLine2BinLatin} = rpc:call(N1,file,read,[F2,DataLen2]), 805: ?line {ok,_} = file:read(F2,1), 806: ?line eof = rpc:call(N1,file,read,[F2,1]), 807: %% As r12 has a bug when setting options with setopts, we need 808: %% to reopen the file... 809: ?line SPid2 ! die, 810: receive after 1000 -> ok end, 811: ?line SPid3 = rpc:call(N1,erlang,spawn,[?MODULE,hold_the_line,[self(),FileName1,[read]]]), 812: ?line {ok,F3} = receive 813: {SPid3,Res3} -> 814: Res3 815: after 5000 -> 816: exit(timeout) 817: end, 818: 819: ?line file:position(F3,0), 820: ?line {ok,[TestDataLine1]} = io:fread(F3,'',"~s"), 821: ?line {ok,[TestDataLine2]} = rpc:call(N1,io,fread,[F3,'',"~s"]), 822: 823: 824: ?line file:position(F3,0), 825: ?line {ok,TestDataLine1} = file:read(F3,DataLen1), 826: ?line {ok,_} = file:read(F3,1), 827: ?line {ok,TestDataLine2} = rpc:call(N1,file,read,[F3,DataLen2]), 828: ?line {ok,_} = file:read(F3,1), 829: ?line eof = rpc:call(N1,file,read,[F3,1]), 830: 831: 832: %% So, lets do it all again, but the other way around 833: {ok,F4} = file:open(FileName1,[read]), 834: ?line TestDataLine1 = chomp(io:get_line(F4,'')), 835: ?line file:position(F4,0), 836: ?line io:setopts(F4,[binary]), 837: ?line TestDataLine1BinUtf = chomp(io:get_line(F4,'')), 838: ?line TestDataLine2BinUtf = chomp(io:get_line(F4,'')), 839: ?line file:position(F4,0), 840: ?line TestDataLine1BinUtf = chomp(io:get_line(F4,'')), 841: ?line TestDataLine2BinUtf = chomp(io:get_line(F4,'')), 842: ?line file:position(F4,0), 843: %dbg:tracer(),dbg:p(F4,[call,m]),dbg:tpl(file_io_server,x),dbg:tpl(io_lib,x), 844: ?line TestDataLine1BinUtf = chomp(io:get_line(F4,'')), 845: ?line TestDataLine2BinLatin = chomp(rpc:call(N1,io,get_line,[F4,''])), 846: ?line file:position(F4,0), 847: ?line TestDataLine1BinLatin = chomp(rpc:call(N1,io,get_line,[F4,''])), 848: ?line TestDataLine2BinUtf = chomp(io:get_line(F4,'')), 849: ?line eof = chomp(rpc:call(N1,io,get_line,[F4,''])), 850: ?line file:position(F4,0), 851: ?line TestDataLine1BinLatin = rpc:call(N1,io,get_chars,[F4,'',3]), 852: io:get_chars(F4,'',1), 853: ?line TestDataLine2BinLatin = chomp(rpc:call(N1,io,get_line,[F4,''])), 854: ?line file:position(F4,0), 855: ?line {ok,[TestDataLine1]} = io:fread(F4,'',"~s"), 856: ?line {ok,[TestDataLine2]} = rpc:call(N1,io,fread,[F4,'',"~s"]), 857: ?line file:position(F4,0), 858: ?line {ok,TestDataLine1BinLatin} = file:read(F4,DataLen1), 859: ?line {ok,_} = file:read(F4,1), 860: ?line {ok,TestDataLine2BinLatin} = rpc:call(N1,file,read,[F4,DataLen2]), 861: ?line {ok,_} = file:read(F4,1), 862: ?line eof = rpc:call(N1,file,read,[F4,1]), 863: ?line io:setopts(F4,[list]), 864: 865: ?line file:position(F4,0), 866: ?line {ok,[TestDataLine1]} = io:fread(F4,'',"~s"), 867: ?line {ok,[TestDataLine2]} = rpc:call(N1,io,fread,[F4,'',"~s"]), 868: 869: 870: ?line file:position(F4,0), 871: ?line {ok,TestDataLine1} = file:read(F4,DataLen1), 872: ?line {ok,_} = file:read(F4,1), 873: ?line {ok,TestDataLine2} = rpc:call(N1,file,read,[F4,DataLen2]), 874: ?line {ok,_} = file:read(F4,1), 875: ?line eof = rpc:call(N1,file,read,[F4,1]), 876: 877: file:close(F4), 878: ?t:stop_node(N1), 879: ok. 880: 881: hold_the_line(Parent,Filename,Options) -> 882: Parent ! {self(), file:open(Filename,Options)}, 883: receive 884: die -> 885: ok 886: end. 887: 888: 889: bc_with_r12_gl(suite) -> 890: []; 891: bc_with_r12_gl(doc) -> 892: ["Test io protocol compatibility with R12 nodes (terminals)"]; 893: bc_with_r12_gl(Config) when is_list(Config) -> 894: case ?t:is_release_available("r12b") of 895: true -> 896: case get_progs() of 897: {error,Reason} -> 898: {skip, Reason}; 899: _ -> 900: bc_with_r12_gl_1(Config,answering_machine1) 901: end; 902: false -> 903: {skip,"No R12B found"} 904: end. 905: 906: bc_with_r12_ogl(suite) -> 907: []; 908: bc_with_r12_ogl(doc) -> 909: ["Test io protocol compatibility with R12 nodes (oldshell)"]; 910: bc_with_r12_ogl(Config) when is_list(Config) -> 911: case ?t:is_release_available("r12b") of 912: true -> 913: case get_progs() of 914: {error,Reason} -> 915: {skip, Reason}; 916: _ -> 917: bc_with_r12_gl_1(Config,answering_machine2) 918: end; 919: false -> 920: {skip,"No R12B found"} 921: end. 922: 923: bc_with_r12_gl_1(_Config,Machine) -> 924: PA = filename:dirname(code:which(?MODULE)), 925: Name1 = io_proto_r12_gl_1, 926: ?line N1 = list_to_atom(atom_to_list(Name1) ++ "@" ++ hostname()), 927: ?line ?t:start_node(Name1, peer, [{args, "-pz \""++PA++"\""},{erl,[{release,"r12b"}]}]), 928: TestDataLine1 = [229,228,246], 929: TestDataLine1BinUtf = unicode:characters_to_binary(TestDataLine1), 930: TestDataLine1BinLatin = list_to_binary(TestDataLine1), 931: 932: {ok,N2List} = create_nodename(), 933: MyNodeList = atom2list(node()), 934: register(io_proto_suite,self()), 935: AM1 = spawn(?MODULE,Machine, 936: [MyNodeList, "io_proto_suite", N2List]), 937: 938: ?line GL = receive X when is_pid(X) -> X end, 939: %% get_line 940: ?line "Hej\n" = rpc:call(N1,io,get_line,[GL,"Prompt\n"]), 941: ?line io:setopts(GL,[binary]), 942: ?line io:format(GL,"Okej~n",[]), 943: ?line <<"Hej\n">> = rpc:call(N1,io,get_line,[GL,"Prompt\n"]), 944: ?line io:setopts(GL,[{encoding,latin1}]), 945: ?line io:format(GL,"Okej~n",[]), 946: ?line TestDataLine1BinLatin = chomp(rpc:call(N1,io,get_line,[GL,"Prompt\n"])), 947: ?line io:format(GL,"Okej~n",[]), 948: ?line TestDataLine1BinUtf = chomp(io:get_line(GL,"Prompt\n")), 949: ?line io:setopts(GL,[{encoding,unicode}]), 950: 951: ?line io:format(GL,"Okej~n",[]), 952: ?line TestDataLine1BinLatin = chomp(rpc:call(N1,io,get_line,[GL,"Prompt\n"])), 953: ?line io:format(GL,"Okej~n",[]), 954: ?line TestDataLine1BinUtf = chomp(io:get_line(GL,"Prompt\n")), 955: ?line io:setopts(GL,[list]), 956: ?line io:format(GL,"Okej~n",[]), 957: 958: %%get_chars 959: ?line "Hej" = rpc:call(N1,io,get_chars,[GL,"Prompt\n",3]), 960: ?line io:setopts(GL,[binary]), 961: ?line io:format(GL,"Okej~n",[]), 962: ?line <<"Hej">> = rpc:call(N1,io,get_chars,[GL,"Prompt\n",3]), 963: ?line io:setopts(GL,[{encoding,latin1}]), 964: ?line io:format(GL,"Okej~n",[]), 965: ?line TestDataLine1BinLatin = rpc:call(N1,io,get_chars,[GL,"Prompt\n",3]), 966: ?line io:format(GL,"Okej~n",[]), 967: ?line TestDataLine1BinUtf = io:get_chars(GL,"Prompt\n",3), 968: ?line io:setopts(GL,[{encoding,unicode}]), 969: 970: ?line io:format(GL,"Okej~n",[]), 971: ?line TestDataLine1BinLatin = rpc:call(N1,io,get_chars,[GL,"Prompt\n",3]), 972: ?line io:format(GL,"Okej~n",[]), 973: ?line TestDataLine1BinUtf = io:get_chars(GL,"Prompt\n",3), 974: ?line io:setopts(GL,[list]), 975: ?line io:format(GL,"Okej~n",[]), 976: %%fread 977: ?line {ok,["Hej"]} = rpc:call(N1,io,fread,[GL,"Prompt\n","~s"]), 978: ?line io:setopts(GL,[binary]), 979: ?line io:format(GL,"Okej~n",[]), 980: ?line {ok,["Hej"]} = rpc:call(N1,io,fread,[GL,"Prompt\n","~s"]), 981: ?line io:setopts(GL,[{encoding,latin1}]), 982: ?line io:format(GL,"Okej~n",[]), 983: ?line {ok,[TestDataLine1]} = rpc:call(N1,io,fread,[GL,"Prompt\n","~s"]), 984: ?line io:format(GL,"Okej~n",[]), 985: ?line {ok,[TestDataLine1]} = io:fread(GL,"Prompt\n","~s"), 986: ?line io:setopts(GL,[{encoding,unicode}]), 987: ?line io:format(GL,"Okej~n",[]), 988: ?line {ok,[TestDataLine1]} = rpc:call(N1,io,fread,[GL,"Prompt\n","~s"]), 989: ?line io:format(GL,"Okej~n",[]), 990: ?line {ok,[TestDataLine1]} = io:fread(GL,"Prompt\n","~s"), 991: ?line io:setopts(GL,[list]), 992: ?line io:format(GL,"Okej~n",[]), 993: 994: 995: ?line receive 996: {AM1,done} -> 997: ok 998: after 5000 -> 999: exit(timeout) 1000: end, 1001: ?t:stop_node(N1), 1002: ok. 1003: 1004: 1005: answering_machine1(OthNode,OthReg,Me) -> 1006: TestDataLine1 = [229,228,246], 1007: TestDataUtf = binary_to_list(unicode:characters_to_binary(TestDataLine1)), 1008: ?line rtnode([{putline,""}, 1009: {putline, "2."}, 1010: {getline, "2"}, 1011: {putline, "{"++OthReg++","++OthNode++"} ! group_leader()."}, 1012: {getline, "<"}, 1013: % get_line 1014: {getline_re, ".*Prompt"}, 1015: {putline, "Hej"}, 1016: {getline_re, ".*Okej"}, 1017: {getline_re, ".*Prompt"}, 1018: {putline, "Hej"}, 1019: {getline_re, ".*Okej"}, 1020: {getline_re, ".*Prompt"}, 1021: {putline, TestDataLine1}, 1022: {getline_re, ".*Okej"}, 1023: {getline_re, ".*Prompt"}, 1024: {putline, TestDataLine1}, 1025: {getline_re, ".*Okej"}, 1026: {getline_re, ".*Prompt"}, 1027: {putline, TestDataUtf}, 1028: {getline_re, ".*Okej"}, 1029: {getline_re, ".*Prompt"}, 1030: {putline, TestDataUtf}, 1031: {getline_re, ".*Okej"}, 1032: % get_chars 1033: {getline_re, ".*Prompt"}, 1034: {putline, "Hej"}, 1035: {getline_re, ".*Okej"}, 1036: {getline_re, ".*Prompt"}, 1037: {putline, "Hej"}, 1038: {getline_re, ".*Okej"}, 1039: {getline_re, ".*Prompt"}, 1040: {putline, TestDataLine1}, 1041: {getline_re, ".*Okej"}, 1042: {getline_re, ".*Prompt"}, 1043: {putline, TestDataLine1}, 1044: {getline_re, ".*Okej"}, 1045: {getline_re, ".*Prompt"}, 1046: {putline, TestDataUtf}, 1047: {getline_re, ".*Okej"}, 1048: {getline_re, ".*Prompt"}, 1049: {putline, TestDataUtf}, 1050: {getline_re, ".*Okej"}, 1051: % fread 1052: {getline_re, ".*Prompt"}, 1053: {putline, "Hej"}, 1054: {getline_re, ".*Okej"}, 1055: {getline_re, ".*Prompt"}, 1056: {putline, "Hej"}, 1057: {getline_re, ".*Okej"}, 1058: {getline_re, ".*Prompt"}, 1059: {putline, TestDataLine1}, 1060: {getline_re, ".*Okej"}, 1061: {getline_re, ".*Prompt"}, 1062: {putline, TestDataLine1}, 1063: {getline_re, ".*Okej"}, 1064: {getline_re, ".*Prompt"}, 1065: {putline, TestDataUtf}, 1066: {getline_re, ".*Okej"}, 1067: {getline_re, ".*Prompt"}, 1068: {putline, TestDataUtf}, 1069: {getline_re, ".*Okej"} 1070: 1071: ],Me,"LC_CTYPE=\""++get_lc_ctype()++"\"; export LC_CTYPE; "), 1072: O = list_to_atom(OthReg), 1073: O ! {self(),done}, 1074: ok. 1075: 1076: answering_machine2(OthNode,OthReg,Me) -> 1077: TestDataLine1 = [229,228,246], 1078: TestDataUtf = binary_to_list(unicode:characters_to_binary(TestDataLine1)), 1079: ?line rtnode([{putline,""}, 1080: {putline, "2."}, 1081: {getline, "2"}, 1082: {putline, "{"++OthReg++","++OthNode++"} ! group_leader()."}, 1083: {getline_re, ".*<[0-9].*"}, 1084: % get_line 1085: {getline_re, ".*Prompt"}, 1086: {putline, "Hej"}, 1087: {getline_re, ".*Okej"}, 1088: {getline_re, ".*Prompt"}, 1089: {putline, "Hej"}, 1090: {getline_re, ".*Okej"}, 1091: {getline_re, ".*Prompt"}, 1092: {putline, TestDataLine1}, 1093: {getline_re, ".*Okej"}, 1094: {getline_re, ".*Prompt"}, 1095: {putline, TestDataLine1}, 1096: {getline_re, ".*Okej"}, 1097: {getline_re, ".*Prompt"}, 1098: {putline, TestDataUtf}, 1099: {getline_re, ".*Okej"}, 1100: {getline_re, ".*Prompt"}, 1101: {putline, TestDataUtf}, 1102: {getline_re, ".*Okej"}, 1103: % get_chars 1104: {getline_re, ".*Prompt"}, 1105: {putline, "Hej"}, 1106: {getline_re, ".*Okej"}, 1107: {getline_re, ".*Prompt"}, 1108: {putline, "Hej"}, 1109: {getline_re, ".*Okej"}, 1110: {getline_re, ".*Prompt"}, 1111: {putline, TestDataLine1}, 1112: {getline_re, ".*Okej"}, 1113: {getline_re, ".*Prompt"}, 1114: {putline, TestDataLine1}, 1115: {getline_re, ".*Okej"}, 1116: {getline_re, ".*Prompt"}, 1117: {putline, TestDataUtf}, 1118: {getline_re, ".*Okej"}, 1119: {getline_re, ".*Prompt"}, 1120: {putline, TestDataUtf}, 1121: {getline_re, ".*Okej"}, 1122: % fread 1123: {getline_re, ".*Prompt"}, 1124: {putline, "Hej"}, 1125: {getline_re, ".*Okej"}, 1126: {getline_re, ".*Prompt"}, 1127: {putline, "Hej"}, 1128: {getline_re, ".*Okej"}, 1129: {getline_re, ".*Prompt"}, 1130: {putline, TestDataLine1}, 1131: {getline_re, ".*Okej"}, 1132: {getline_re, ".*Prompt"}, 1133: {putline, TestDataLine1}, 1134: {getline_re, ".*Okej"}, 1135: {getline_re, ".*Prompt"}, 1136: {putline, TestDataUtf}, 1137: {getline_re, ".*Okej"}, 1138: {getline_re, ".*Prompt"}, 1139: {putline, TestDataUtf}, 1140: {getline_re, ".*Okej"} 1141: 1142: ],Me,"LC_CTYPE=\""++get_lc_ctype()++"\"; export LC_CTYPE; "," -oldshell "), 1143: O = list_to_atom(OthReg), 1144: O ! {self(),done}, 1145: ok. 1146: 1147: 1148: read_modes_ogl(suite) -> 1149: []; 1150: read_modes_ogl(doc) -> 1151: ["Test various modes when reading from the group leade from another machine"]; 1152: read_modes_ogl(Config) when is_list(Config) -> 1153: case get_progs() of 1154: {error,Reason} -> 1155: {skipped,Reason}; 1156: _ -> 1157: read_modes_gl_1(Config,answering_machine2) 1158: end. 1159: 1160: read_modes_gl(suite) -> 1161: []; 1162: read_modes_gl(doc) -> 1163: ["Test various modes when reading from the group leade from another machine"]; 1164: read_modes_gl(Config) when is_list(Config) -> 1165: case {get_progs(),proplists:get_value(default_shell,Config)} of 1166: {{error,Reason},_} -> 1167: {skipped,Reason}; 1168: {_,old} -> 1169: {skipper,"No new shell"}; 1170: _ -> 1171: read_modes_gl_1(Config,answering_machine1) 1172: end. 1173: 1174: read_modes_gl_1(_Config,Machine) -> 1175: TestDataLine1 = [229,228,246], 1176: TestDataLine1BinUtf = unicode:characters_to_binary(TestDataLine1), 1177: TestDataLine1BinLatin = list_to_binary(TestDataLine1), 1178: 1179: {ok,N2List} = create_nodename(), 1180: MyNodeList = atom2list(node()), 1181: register(io_proto_suite,self()), 1182: AM1 = spawn(?MODULE,Machine, 1183: [MyNodeList, "io_proto_suite", N2List]), 1184: 1185: ?line GL = receive X when is_pid(X) -> X end, 1186: ?dbg({group_leader,X}), 1187: %% get_line 1188: ?line receive after 500 -> ok end, % Dont clash with the new shell... 1189: ?line "Hej\n" = io:get_line(GL,"Prompt\n"), 1190: ?line io:setopts(GL,[binary]), 1191: ?line io:format(GL,"Okej~n",[]), 1192: ?line <<"Hej\n">> = io:get_line(GL,"Prompt\n"), 1193: ?line io:setopts(GL,[{encoding,latin1}]), 1194: ?line io:format(GL,"Okej~n",[]), 1195: ?line TestDataLine1BinLatin = chomp(io:request(GL,{get_line,latin1,"Prompt\n"})), 1196: ?line io:format(GL,"Okej~n",[]), 1197: ?line TestDataLine1BinUtf = chomp(io:get_line(GL,"Prompt\n")), 1198: ?line io:setopts(GL,[{encoding,unicode}]), 1199: 1200: ?line io:format(GL,"Okej~n",[]), 1201: ?line TestDataLine1BinLatin = chomp(io:request(GL,{get_line,latin1,"Prompt\n"})), 1202: ?line io:format(GL,"Okej~n",[]), 1203: ?line TestDataLine1BinUtf = chomp(io:get_line(GL,"Prompt\n")), 1204: ?line io:setopts(GL,[list]), 1205: ?line io:format(GL,"Okej~n",[]), 1206: 1207: %%get_chars 1208: ?line "Hej" = io:get_chars(GL,"Prompt\n",3), 1209: ?line io:setopts(GL,[binary]), 1210: ?line io:format(GL,"Okej~n",[]), 1211: ?line <<"Hej">> = io:get_chars(GL,"Prompt\n",3), 1212: ?line io:setopts(GL,[{encoding,latin1}]), 1213: ?line io:format(GL,"Okej~n",[]), 1214: ?line TestDataLine1BinLatin = io:request(GL,{get_chars,latin1,"Prompt\n",3}), 1215: ?line io:format(GL,"Okej~n",[]), 1216: ?line TestDataLine1BinUtf = io:get_chars(GL,"Prompt\n",3), 1217: ?line io:setopts(GL,[{encoding,unicode}]), 1218: 1219: ?line io:format(GL,"Okej~n",[]), 1220: ?line TestDataLine1BinLatin = io:request(GL,{get_chars,latin1,"Prompt\n",3}), 1221: ?line io:format(GL,"Okej~n",[]), 1222: ?line TestDataLine1BinUtf = io:get_chars(GL,"Prompt\n",3), 1223: ?line io:setopts(GL,[list]), 1224: ?line io:format(GL,"Okej~n",[]), 1225: %%fread 1226: ?line {ok,["Hej"]} = io:fread(GL,"Prompt\n","~s"), 1227: ?line io:setopts(GL,[binary]), 1228: ?line io:format(GL,"Okej~n",[]), 1229: ?line {ok,["Hej"]} = io:fread(GL,"Prompt\n","~s"), 1230: ?line io:setopts(GL,[{encoding,latin1}]), 1231: ?line io:format(GL,"Okej~n",[]), 1232: ?line {ok,[TestDataLine1]} = io:fread(GL,"Prompt\n","~s"), 1233: ?line io:format(GL,"Okej~n",[]), 1234: ?line {ok,[TestDataLine1]} = io:fread(GL,"Prompt\n","~s"), 1235: ?line io:setopts(GL,[{encoding,unicode}]), 1236: ?line io:format(GL,"Okej~n",[]), 1237: ?line {ok,[TestDataLine1]} = io:fread(GL,"Prompt\n","~s"), 1238: ?line io:format(GL,"Okej~n",[]), 1239: ?line {ok,[TestDataLine1]} = io:fread(GL,"Prompt\n","~s"), 1240: ?line io:setopts(GL,[list]), 1241: ?line io:format(GL,"Okej~n",[]), 1242: 1243: 1244: ?line receive 1245: {AM1,done} -> 1246: ok 1247: after 5000 -> 1248: exit(timeout) 1249: end, 1250: ok. 1251: 1252: 1253: broken_unicode(suite) -> 1254: []; 1255: broken_unicode(doc) -> 1256: ["Test behaviour when reading broken Unicode files"]; 1257: broken_unicode(Config) when is_list(Config) -> 1258: Dir = ?config(priv_dir,Config), 1259: Latin1Name = filename:join([Dir,"latin1_data_file.dat"]), 1260: Utf8Name = filename:join([Dir,"utf8_data_file.dat"]), 1261: Latin1Data = iolist_to_binary(lists:duplicate(10,lists:seq(0,255)++[255,255,255])), 1262: Utf8Data = unicode:characters_to_binary( 1263: lists:duplicate(10,lists:seq(0,255))), 1264: file:write_file(Latin1Name,Latin1Data), 1265: file:write_file(Utf8Name,Utf8Data), 1266: ?line [ latin1 = heuristic_encoding_file2(Latin1Name,N,utf8) || N <- lists:seq(1,100)++[1024,2048,10000]], 1267: ?line [ utf8 = heuristic_encoding_file2(Utf8Name,N,utf8) || N <- lists:seq(1,100)++[1024,2048,10000]], 1268: ?line [ latin1 = heuristic_encoding_file2(Latin1Name,N,utf16) || N <- lists:seq(1,100)++[1024,2048,10000]], 1269: ?line [ latin1 = heuristic_encoding_file2(Latin1Name,N,utf32) || N <- lists:seq(1,100)++[1024,2048,10000]], 1270: ok. 1271: 1272: 1273: %% 1274: %% From the cookbook, more or less 1275: heuristic_encoding_file2(FileName,Chunk,Enc) -> 1276: {ok,F} = file:open(FileName,[read,binary,{encoding,Enc}]), 1277: loop_through_file2(F,io:get_chars(F,'',Chunk),Chunk,Enc). 1278: 1279: loop_through_file2(_,eof,_,Enc) -> 1280: Enc; 1281: loop_through_file2(_,{error,_Err},_,_) -> 1282: latin1; 1283: loop_through_file2(F,Bin,Chunk,Enc) when is_binary(Bin) -> 1284: loop_through_file2(F,io:get_chars(F,'',Chunk),Chunk,Enc). 1285: 1286: 1287: 1288: eof_on_pipe(suite) -> 1289: []; 1290: eof_on_pipe(doc) -> 1291: ["tests eof before newline on stdin when erlang is in pipe"]; 1292: eof_on_pipe(Config) when is_list(Config) -> 1293: case {get_progs(),os:type()} of 1294: {{error,Reason},_} -> 1295: {skipped,Reason}; 1296: {{_,_,Erl},{unix,linux}} -> 1297: %% Not even Linux is reliable - echo can be both styles 1298: try 1299: EchoLine = case os:cmd("echo -ne \"test\\ntest\"") of 1300: "test\ntest" -> 1301: "echo -ne \"a\\nbu\" | "; 1302: _ -> 1303: case os:cmd("echo \"test\\ntest\\c\"") of 1304: "test\ntest" -> 1305: "echo \"a\\nbu\\c\" | "; 1306: _ -> 1307: throw(skip) 1308: end 1309: end, 1310: CommandLine1 = EchoLine ++ 1311: "\""++Erl++"\" -noshell -eval " 1312: "'io:format(\"~p\",[io:get_line(\"\")])," 1313: "io:format(\"~p\",[io:get_line(\"\")])," 1314: "io:format(\"~p\",[io:get_line(\"\")]).' -run init stop", 1315: case os:cmd(CommandLine1) of 1316: "\"a\\n\"\"bu\"eof" -> 1317: ok; 1318: Other1 -> 1319: exit({unexpected1,Other1}) 1320: end, 1321: CommandLine2 = EchoLine ++ 1322: "\""++Erl++"\" -noshell -eval " 1323: "'io:setopts([binary]),io:format(\"~p\",[io:get_line(\"\")])," 1324: "io:format(\"~p\",[io:get_line(\"\")])," 1325: "io:format(\"~p\",[io:get_line(\"\")]).' -run init stop", 1326: case os:cmd(CommandLine2) of 1327: "<<\"a\\n\">><<\"bu\">>eof" -> 1328: ok; 1329: Other2 -> 1330: exit({unexpected2,Other2}) 1331: end 1332: catch 1333: throw:skip -> 1334: {skipped,"unsupported echo program"} 1335: end; 1336: {_,_} -> 1337: {skipped,"Only on linux"} 1338: end. 1339: 1340: 1341: %% 1342: %% Tool for running interactive shell (stolen from the kernel 1343: %% test suite interactive_shell_SUITE) 1344: %% 1345: -undef(line). 1346: -define(line,). 1347: rtnode(C,N) -> 1348: rtnode(C,N,[]). 1349: rtnode(Commands,Nodename,ErlPrefix) -> 1350: rtnode(Commands,Nodename,ErlPrefix,[]). 1351: rtnode(Commands,Nodename,ErlPrefix,Extra) -> 1352: ?line case get_progs() of 1353: {error,_Reason} -> 1354: ?line {skip,"No runerl present"}; 1355: {RunErl,ToErl,Erl} -> 1356: ?line case create_tempdir() of 1357: {error, Reason2} -> 1358: ?line {skip, Reason2}; 1359: Tempdir -> 1360: ?line SPid = 1361: start_runerl_node(RunErl,ErlPrefix++ 1362: "\\\""++Erl++"\\\"", 1363: Tempdir,Nodename, Extra), 1364: ?line CPid = start_toerl_server(ToErl,Tempdir), 1365: ?line erase(getline_skipped), 1366: ?line Res = 1367: (catch get_and_put(CPid, Commands,1)), 1368: ?line case stop_runerl_node(CPid) of 1369: {error,_} -> 1370: ?line CPid2 = 1371: start_toerl_server 1372: (ToErl,Tempdir), 1373: ?line erase(getline_skipped), 1374: ?line ok = get_and_put 1375: (CPid2, 1376: [{putline,[7]}, 1377: {sleep, 1378: timeout(short)}, 1379: {putline,""}, 1380: {getline," -->"}, 1381: {putline,"s"}, 1382: {putline,"c"}, 1383: {putline,""}],1), 1384: ?line stop_runerl_node(CPid2); 1385: _ -> 1386: ?line ok 1387: end, 1388: ?line wait_for_runerl_server(SPid), 1389: ?line ok = ?RM_RF(Tempdir), 1390: ?line ok = Res 1391: end 1392: end. 1393: 1394: timeout(long) -> 1395: 2 * timeout(normal); 1396: timeout(short) -> 1397: timeout(normal) div 10; 1398: timeout(normal) -> 1399: 10000 * test_server:timetrap_scale_factor(). 1400: 1401: 1402: %% start_noshell_node(Name) -> 1403: %% PADir = filename:dirname(code:which(?MODULE)), 1404: %% {ok, Node} = test_server:start_node(Name,slave,[{args," -noshell -pa "++ 1405: %% PADir++" "}]), 1406: %% Node. 1407: %% stop_noshell_node(Node) -> 1408: %% test_server:stop_node(Node). 1409: 1410: -ifndef(debug). 1411: rm_rf(Dir) -> 1412: try 1413: {ok,List} = file:list_dir(Dir), 1414: Files = [filename:join([Dir,X]) || X <- List], 1415: [case file:list_dir(Y) of 1416: {error, enotdir} -> 1417: ok = file:delete(Y); 1418: _ -> 1419: ok = rm_rf(Y) 1420: end || Y <- Files], 1421: ok = file:del_dir(Dir), 1422: ok 1423: catch 1424: _:Exception -> {error, {Exception,Dir}} 1425: end. 1426: -endif. 1427: 1428: get_and_put(_CPid,[],_) -> 1429: ok; 1430: get_and_put(CPid, [{sleep, X}|T],N) -> 1431: ?dbg({sleep, X}), 1432: receive 1433: after X -> 1434: get_and_put(CPid,T,N+1) 1435: end; 1436: get_and_put(CPid, [{getline, Match}|T],N) -> 1437: ?dbg({getline, Match}), 1438: CPid ! {self(), {get_line, timeout(normal)}}, 1439: receive 1440: {get_line, timeout} -> 1441: error_logger:error_msg("~p: getline timeout waiting for \"~s\" " 1442: "(command number ~p, skipped: ~p)~n", 1443: [?MODULE, Match,N,get(getline_skipped)]), 1444: {error, timeout}; 1445: {get_line, Data} -> 1446: ?dbg({data,Data}), 1447: case lists:prefix(Match, Data) of 1448: true -> 1449: erase(getline_skipped), 1450: get_and_put(CPid, T,N+1); 1451: false -> 1452: case get(getline_skipped) of 1453: undefined -> 1454: put(getline_skipped,[Data]); 1455: List -> 1456: put(getline_skipped,List ++ [Data]) 1457: end, 1458: get_and_put(CPid, [{getline, Match}|T],N) 1459: end 1460: end; 1461: get_and_put(CPid, [{getline_re, Match}|T],N) -> 1462: ?dbg({getline_re, Match}), 1463: CPid ! {self(), {get_line, timeout(normal)}}, 1464: receive 1465: {get_line, timeout} -> 1466: error_logger:error_msg("~p: getline_re timeout waiting for \"~s\" " 1467: "(command number ~p, skipped: ~p)~n", 1468: [?MODULE, Match,N,get(getline_skipped)]), 1469: {error, timeout}; 1470: {get_line, Data} -> 1471: ?dbg({data,Data}), 1472: case re:run(Data, Match,[{capture,none}]) of 1473: match -> 1474: erase(getline_skipped), 1475: get_and_put(CPid, T,N+1); 1476: _ -> 1477: case get(getline_skipped) of 1478: undefined -> 1479: put(getline_skipped,[Data]); 1480: List -> 1481: put(getline_skipped,List ++ [Data]) 1482: end, 1483: get_and_put(CPid, [{getline_re, Match}|T],N) 1484: end 1485: end; 1486: 1487: get_and_put(CPid, [{putline_raw, Line}|T],N) -> 1488: ?dbg({putline_raw, Line}), 1489: CPid ! {self(), {send_line, Line}}, 1490: Timeout = timeout(normal), 1491: receive 1492: {send_line, ok} -> 1493: get_and_put(CPid, T,N+1) 1494: after Timeout -> 1495: error_logger:error_msg("~p: putline_raw timeout (~p) sending " 1496: "\"~s\" (command number ~p)~n", 1497: [?MODULE, Timeout, Line, N]), 1498: {error, timeout} 1499: end; 1500: 1501: get_and_put(CPid, [{putline, Line}|T],N) -> 1502: ?dbg({putline, Line}), 1503: CPid ! {self(), {send_line, Line}}, 1504: Timeout = timeout(normal), 1505: receive 1506: {send_line, ok} -> 1507: get_and_put(CPid, [{getline, []}|T],N) 1508: after Timeout -> 1509: error_logger:error_msg("~p: putline timeout (~p) sending " 1510: "\"~s\" (command number ~p)~n[~p]~n", 1511: [?MODULE, Timeout, Line, N,get()]), 1512: {error, timeout} 1513: end. 1514: 1515: wait_for_runerl_server(SPid) -> 1516: Ref = erlang:monitor(process, SPid), 1517: Timeout = timeout(long), 1518: receive 1519: {'DOWN', Ref, process, SPid, _} -> 1520: ok 1521: after Timeout -> 1522: {error, timeout} 1523: end. 1524: 1525: 1526: 1527: stop_runerl_node(CPid) -> 1528: Ref = erlang:monitor(process, CPid), 1529: CPid ! {self(), kill_emulator}, 1530: Timeout = timeout(long), 1531: receive 1532: {'DOWN', Ref, process, CPid, noproc} -> 1533: ok; 1534: {'DOWN', Ref, process, CPid, normal} -> 1535: ok; 1536: {'DOWN', Ref, process, CPid, {error, Reason}} -> 1537: {error, Reason} 1538: after Timeout -> 1539: {error, timeout} 1540: end. 1541: 1542: get_progs() -> 1543: case os:type() of 1544: {unix,freebsd} -> 1545: {error,"cant use run_erl on freebsd"}; 1546: {unix,openbsd} -> 1547: {error,"cant use run_erl on openbsd"}; 1548: {unix,_} -> 1549: case os:find_executable("run_erl") of 1550: RE when is_list(RE) -> 1551: case os:find_executable("to_erl") of 1552: TE when is_list(TE) -> 1553: case os:find_executable("erl") of 1554: E when is_list(E) -> 1555: {RE,TE,E}; 1556: _ -> 1557: {error, "Could not find erl command"} 1558: end; 1559: _ -> 1560: {error, "Could not find to_erl command"} 1561: end; 1562: _ -> 1563: {error, "Could not find run_erl command"} 1564: end; 1565: _ -> 1566: {error, "Not a unix OS"} 1567: end. 1568: 1569: create_tempdir() -> 1570: create_tempdir(filename:join(["/tmp","rtnode"++os:getpid()]),$A). 1571: 1572: create_tempdir(Dir,X) when X > $Z, X < $a -> 1573: create_tempdir(Dir,$a); 1574: create_tempdir(Dir,X) when X > $z -> 1575: Estr = lists:flatten( 1576: io_lib:format("Unable to create ~s, reason eexist", 1577: [Dir++[$z]])), 1578: {error, Estr}; 1579: create_tempdir(Dir0, Ch) -> 1580: % Expect fairly standard unix. 1581: Dir = Dir0++[Ch], 1582: case file:make_dir(Dir) of 1583: {error, eexist} -> 1584: create_tempdir(Dir0, Ch+1); 1585: {error, Reason} -> 1586: Estr = lists:flatten( 1587: io_lib:format("Unable to create ~s, reason ~p", 1588: [Dir,Reason])), 1589: {error,Estr}; 1590: ok -> 1591: Dir 1592: end. 1593: 1594: create_nodename() -> 1595: create_nodename($A). 1596: 1597: create_nodename(X) when X > $Z, X < $a -> 1598: create_nodename($a); 1599: create_nodename(X) when X > $z -> 1600: {error,out_of_nodenames}; 1601: create_nodename(X) -> 1602: NN = "rtnode"++os:getpid()++[X], 1603: case file:read_file_info(filename:join(["/tmp",NN])) of 1604: {error,enoent} -> 1605: Host = lists:nth(2,string:tokens(atom_to_list(node()),"@")), 1606: {ok,NN++"@"++Host}; 1607: _ -> 1608: create_nodename(X+1) 1609: end. 1610: 1611: 1612: start_runerl_node(RunErl,Erl,Tempdir,Nodename,Extra) -> 1613: XArg = case Nodename of 1614: [] -> 1615: []; 1616: _ -> 1617: " -sname "++(if is_atom(Nodename) -> atom_to_list(Nodename); 1618: true -> Nodename 1619: end)++ 1620: " -setcookie "++atom_to_list(erlang:get_cookie()) 1621: end, 1622: XXArg = case Extra of 1623: [] -> 1624: []; 1625: _ -> 1626: " "++Extra 1627: end, 1628: spawn(fun() -> 1629: ?dbg("\""++RunErl++"\" "++Tempdir++"/ "++Tempdir++ 1630: " \""++Erl++XArg++XXArg++"\""), 1631: os:cmd("\""++RunErl++"\" "++Tempdir++"/ "++Tempdir++ 1632: " \""++Erl++XArg++XXArg++"\"") 1633: end). 1634: 1635: start_toerl_server(ToErl,Tempdir) -> 1636: Pid = spawn(?MODULE,toerl_server,[self(),ToErl,Tempdir]), 1637: receive 1638: {Pid,started} -> 1639: Pid; 1640: {Pid,error,Reason} -> 1641: {error,Reason} 1642: end. 1643: 1644: try_to_erl(_Command, 0) -> 1645: {error, cannot_to_erl}; 1646: try_to_erl(Command, N) -> 1647: ?dbg({?LINE,N}), 1648: Port = open_port({spawn, Command},[eof,{line,1000}]), 1649: Timeout = timeout(normal) div 2, 1650: receive 1651: {Port, eof} -> 1652: receive after Timeout -> 1653: ok 1654: end, 1655: try_to_erl(Command, N-1) 1656: after Timeout -> 1657: ?dbg(Port), 1658: Port 1659: end. 1660: 1661: toerl_server(Parent,ToErl,Tempdir) -> 1662: Port = try_to_erl("\""++ToErl++"\" "++Tempdir++"/ 2>/dev/null",8), 1663: case Port of 1664: P when is_port(P) -> 1665: Parent ! {self(),started}; 1666: {error,Other} -> 1667: Parent ! {self(),error,Other}, 1668: exit(Other) 1669: end, 1670: case toerl_loop(Port,[]) of 1671: normal -> 1672: ok; 1673: {error, Reason} -> 1674: error_logger:error_msg("toerl_server exit with reason ~p~n", 1675: [Reason]), 1676: exit(Reason) 1677: end. 1678: 1679: toerl_loop(Port,Acc) -> 1680: ?dbg({toerl_loop, Port, Acc}), 1681: receive 1682: {Port,{data,{Tag0,Data}}} when is_port(Port) -> 1683: ?dbg({?LINE,Port,{data,{Tag0,Data}}}), 1684: case Acc of 1685: [{noeol,Data0}|T0] -> 1686: toerl_loop(Port,[{Tag0, Data0++Data}|T0]); 1687: _ -> 1688: toerl_loop(Port,[{Tag0,Data}|Acc]) 1689: end; 1690: {Pid,{get_line,Timeout}} -> 1691: case Acc of 1692: [] -> 1693: case get_data_within(Port,Timeout,[]) of 1694: timeout -> 1695: Pid ! {get_line, timeout}, 1696: toerl_loop(Port,[]); 1697: {noeol,Data1} -> 1698: Pid ! {get_line, timeout}, 1699: toerl_loop(Port,[{noeol,Data1}]); 1700: {eol,Data2} -> 1701: Pid ! {get_line, Data2}, 1702: toerl_loop(Port,[]) 1703: end; 1704: [{noeol,Data3}] -> 1705: case get_data_within(Port,Timeout,Data3) of 1706: timeout -> 1707: Pid ! {get_line, timeout}, 1708: toerl_loop(Port,Acc); 1709: {noeol,Data4} -> 1710: Pid ! {get_line, timeout}, 1711: toerl_loop(Port,[{noeol,Data4}]); 1712: {eol,Data5} -> 1713: Pid ! {get_line, Data5}, 1714: toerl_loop(Port,[]) 1715: end; 1716: List -> 1717: {NewAcc,[{eol,Data6}]} = lists:split(length(List)-1,List), 1718: Pid ! {get_line,Data6}, 1719: toerl_loop(Port,NewAcc) 1720: end; 1721: {Pid, {send_line, Data7}} -> 1722: Port ! {self(),{command, Data7++"\n"}}, 1723: Pid ! {send_line, ok}, 1724: toerl_loop(Port,Acc); 1725: {_Pid, kill_emulator} -> 1726: Port ! {self(),{command, "init:stop().\n"}}, 1727: Timeout1 = timeout(long), 1728: receive 1729: {Port,eof} -> 1730: normal 1731: after Timeout1 -> 1732: {error, kill_timeout} 1733: end; 1734: {Port, eof} -> 1735: {error, unexpected_eof}; 1736: Other -> 1737: {error, {unexpected, Other}} 1738: end. 1739: 1740: millistamp() -> 1741: {Mega, Secs, Micros} = erlang:now(), 1742: (Micros div 1000) + Secs * 1000 + Mega * 1000000000. 1743: 1744: get_data_within(Port, X, Acc) when X =< 0 -> 1745: ?dbg({get_data_within, X, Acc, ?LINE}), 1746: receive 1747: {Port,{data,{Tag0,Data}}} -> 1748: ?dbg({?LINE,Port,{data,{Tag0,Data}}}), 1749: {Tag0, Acc++Data} 1750: after 0 -> 1751: case Acc of 1752: [] -> 1753: timeout; 1754: Noeol -> 1755: {noeol,Noeol} 1756: end 1757: end; 1758: 1759: 1760: get_data_within(Port, Timeout, Acc) -> 1761: ?dbg({get_data_within, Timeout, Acc, ?LINE}), 1762: T1 = millistamp(), 1763: receive 1764: {Port,{data,{noeol,Data}}} -> 1765: ?dbg({?LINE,Port,{data,{noeol,Data}}}), 1766: Elapsed = millistamp() - T1 + 1, 1767: get_data_within(Port, Timeout - Elapsed, Acc ++ Data); 1768: {Port,{data,{eol,Data1}}} -> 1769: ?dbg({?LINE,Port,{data,{eol,Data1}}}), 1770: {eol, Acc ++ Data1} 1771: after Timeout -> 1772: timeout 1773: end. 1774: 1775: get_default_shell() -> 1776: try 1777: rtnode([{putline,""}, 1778: {putline, "whereis(user_drv)."}, 1779: {getline, "undefined"}],[]), 1780: old 1781: catch _E:_R -> 1782: ?dbg({_E,_R}), 1783: new 1784: end. 1785: 1786: %% 1787: %% Test I/O-server 1788: %% 1789: 1790: start_io_server_proxy() -> 1791: spawn_link(?MODULE,io_server_proxy,[#state{}]). 1792: 1793: proxy_getall(Pid) -> 1794: req(Pid,{self(),getall}). 1795: proxy_setnext(Pid,Data) when is_list(Data) -> 1796: req(Pid,{self(),next,Data}). 1797: proxy_quit(Pid) -> 1798: req(Pid,{self(),quit}). 1799: 1800: req(Pid,Mess) -> 1801: Pid ! Mess, 1802: receive 1803: {Pid, Answer} -> 1804: Answer 1805: after 5000 -> 1806: exit(timeout) 1807: end. 1808: 1809: io_server_proxy(State) -> 1810: receive 1811: {io_request, From, ReplyAs, Request} -> 1812: case request(Request,State) of 1813: {Tag, Reply, NewState} when Tag =:= ok; Tag =:= error -> 1814: reply(From, ReplyAs, Reply), 1815: io_server_proxy(NewState); 1816: {stop, Reply, _NewState} -> 1817: reply(From, ReplyAs, Reply), 1818: exit(Reply) 1819: end; 1820: %% Private message 1821: {From, next, Data} -> 1822: From ! {self(), ok}, 1823: io_server_proxy(State#state{nxt = Data}); 1824: {From, getall} -> 1825: From ! {self(), lists:reverse(State#state.q)}, 1826: io_server_proxy(State#state{q=[]}); 1827: {From, quit} -> 1828: From ! {self(), lists:reverse(State#state.q)}, 1829: ok; 1830: _Unknown -> 1831: io_server_proxy(State) 1832: end. 1833: 1834: reply(From, ReplyAs, Reply) -> 1835: From ! {io_reply, ReplyAs, Reply}. 1836: 1837: request({put_chars, Encoding, Chars}, State) -> 1838: {ok, ok, State#state{q=[{put_chars, Encoding, Chars} | State#state.q ]}}; 1839: request({put_chars, Encoding, Module, Function, Args}, State) -> 1840: {ok, ok, State#state{q=[{put_chars, Encoding, Module, Function, Args} | 1841: State#state.q ]}}; 1842: request({put_chars,Chars}, State) -> 1843: {ok, ok, State#state{q=[{put_chars, Chars} | State#state.q ]}}; 1844: request({put_chars,M,F,As}, State) -> 1845: {ok, ok, State#state{q=[{put_chars, M,F,As} | State#state.q ]}}; 1846: request({get_until, Encoding, Prompt, M, F, As}, State) -> 1847: {ok, convert(State#state.nxt, Encoding, State#state.mode), State#state{nxt = eof, q = [{get_until, Encoding, Prompt, M, F, As} | State#state.q]}}; 1848: request({get_chars, Encoding, Prompt, N}, State) -> 1849: {ok, convert(State#state.nxt, Encoding, State#state.mode), State#state{nxt = eof, 1850: q = [{get_chars, Encoding, Prompt, N} | 1851: State#state.q]}}; 1852: request({get_line, Encoding, Prompt}, State) -> 1853: {ok, convert(State#state.nxt, Encoding, State#state.mode), 1854: State#state{nxt = eof, 1855: q = [{get_line, Encoding, Prompt} | 1856: State#state.q]}}; 1857: request({get_until, Prompt, M, F, As}, State) -> 1858: {ok, convert(State#state.nxt, latin1, State#state.mode), 1859: State#state{nxt = eof, 1860: q = [{get_until, Prompt, M, F, As} | State#state.q]}}; 1861: request({get_chars, Prompt, N}, State) -> 1862: {ok, convert(State#state.nxt, latin1, State#state.mode), 1863: State#state{nxt = eof, 1864: q = [{get_chars, Prompt, N} | 1865: State#state.q]}}; 1866: request({get_line, Prompt}, State) -> 1867: {ok, convert(State#state.nxt, latin1, State#state.mode), 1868: State#state{nxt = eof, 1869: q = [{get_line, Prompt} | 1870: State#state.q]}}; 1871: request({get_geomentry,_}, State) -> 1872: {error, {error,enotsup}, State}; 1873: request({setopts, Opts}, State) when Opts =:= [{binary, false}]; Opts =:= [list] -> 1874: {ok, ok, State#state{q=[{setopts, Opts} | State#state.q ], mode = list}}; 1875: request({setopts, Opts}, State) when Opts =:= [{binary, true}]; Opts =:= [binary] -> 1876: {ok, ok, State#state{q=[{setopts, Opts} | State#state.q ], mode = binary}}; 1877: request(getopts, State) -> 1878: {ok, case State#state.mode of 1879: list -> [{binary,false}]; 1880: binary -> [{binary, true}] 1881: end, State#state{q=[getopts | State#state.q ]}}; 1882: request({requests, Reqs}, State) -> 1883: multi_request(Reqs, {ok, ok, State}). 1884: 1885: multi_request([R|Rs], {ok, _Res, State}) -> 1886: multi_request(Rs, request(R, State)); 1887: multi_request([_|_], Error) -> 1888: Error; 1889: multi_request([], State) -> 1890: State. 1891: 1892: convert(Atom,_,_) when is_atom(Atom) -> 1893: Atom; 1894: convert(Data, unicode, list) -> 1895: unicode:characters_to_list(Data,unicode); 1896: convert(Data, latin1, list) -> 1897: try 1898: L = unicode:characters_to_list(Data, unicode), 1899: [ true = Ch =< 255 || Ch <- L ], 1900: L 1901: catch 1902: _:_ -> 1903: {error, {cannot_convert, unicode, latin1}} 1904: end; 1905: convert(Data, unicode, binary) -> 1906: unicode:characters_to_binary(Data,unicode,unicode); 1907: convert(Data, latin1, binary) -> 1908: case unicode:characters_to_binary(Data, unicode, latin1) of 1909: Bin when is_binary(Bin) -> 1910: Bin; 1911: _ -> 1912: {error, {cannot_convert, unicode, latin1}} 1913: end. 1914: 1915: hostname() -> 1916: from($@, atom_to_list(node())). 1917: 1918: from(H, [H | T]) -> T; 1919: from(H, [_ | T]) -> from(H, T); 1920: from(_, []) -> []. 1921: 1922: atom2list(A) -> 1923: lists:flatten(io_lib:format("~w", [A])). 1924: 1925: chomp([]) -> 1926: []; 1927: chomp([$\n]) -> 1928: []; 1929: chomp([H|T]) -> 1930: [H|chomp(T)]; 1931: chomp(<<>>) -> 1932: <<>>; 1933: chomp(<<$\n>>) -> 1934: <<>>; 1935: chomp(<<Ch,Rest/binary>>) -> 1936: X = chomp(Rest), 1937: <<Ch,X/binary>>; 1938: chomp(Atom) -> 1939: Atom.