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