1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 2004-2019. 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(shell_SUITE). 21-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 22 init_per_group/2,end_per_group/2]). 23 24-export([forget/1, records/1, known_bugs/1, otp_5226/1, otp_5327/1, 25 otp_5435/1, otp_5195/1, otp_5915/1, otp_5916/1, 26 bs_match_misc_SUITE/1, bs_match_int_SUITE/1, 27 bs_match_tail_SUITE/1, bs_match_bin_SUITE/1, 28 bs_construct_SUITE/1, 29 refman_bit_syntax/1, 30 progex_bit_syntax/1, progex_records/1, 31 progex_lc/1, progex_funs/1, 32 otp_5990/1, otp_6166/1, otp_6554/1, 33 otp_7184/1, otp_7232/1, otp_8393/1, otp_10302/1, otp_13719/1, 34 otp_14285/1, otp_14296/1, typed_records/1]). 35 36-export([ start_restricted_from_shell/1, 37 start_restricted_on_command_line/1,restricted_local/1]). 38 39%% Internal export. 40-export([otp_5435_2/0, prompt1/1, prompt2/1, prompt3/1, prompt4/1, 41 prompt5/1]). 42 43%% 44%% Define to run outside of test server 45%% 46%% -define(STANDALONE,1). 47 48-ifdef(STANDALONE). 49-define(config(A,B),config(A,B)). 50-define(t,test_server). 51-export([config/2]). 52-define(line, noop, ). 53config(priv_dir,_) -> 54 ".". 55-else. 56-include_lib("common_test/include/ct.hrl"). 57-export([init_per_testcase/2, end_per_testcase/2]). 58init_per_testcase(_Case, Config) -> 59 OrigPath = code:get_path(), 60 code:add_patha(proplists:get_value(priv_dir,Config)), 61 [{orig_path,OrigPath} | Config]. 62 63end_per_testcase(_Case, Config) -> 64 OrigPath = proplists:get_value(orig_path,Config), 65 code:set_path(OrigPath), 66 application:unset_env(stdlib, restricted_shell), 67 purge_and_delete(user_default), 68 %% used by `records' test case 69 purge_and_delete(test), 70 ok. 71-endif. 72 73suite() -> 74 [{ct_hooks,[ts_install_cth]}, 75 {timetrap,{minutes,10}}]. 76 77all() -> 78 [forget, known_bugs, otp_5226, otp_5327, 79 otp_5435, otp_5195, otp_5915, otp_5916, {group, bits}, 80 {group, refman}, {group, progex}, {group, tickets}, 81 {group, restricted}, {group, records}]. 82 83groups() -> 84 [{restricted, [], 85 [start_restricted_from_shell, 86 start_restricted_on_command_line, restricted_local]}, 87 {bits, [], 88 [bs_match_misc_SUITE, bs_match_tail_SUITE, 89 bs_match_bin_SUITE, bs_construct_SUITE]}, 90 {records, [], 91 [records, typed_records]}, 92 {refman, [], [refman_bit_syntax]}, 93 {progex, [], 94 [progex_bit_syntax, progex_records, progex_lc, 95 progex_funs]}, 96 {tickets, [], 97 [otp_5990, otp_6166, otp_6554, otp_7184, 98 otp_7232, otp_8393, otp_10302, otp_13719, otp_14285, otp_14296]}]. 99 100init_per_suite(Config) -> 101 Config. 102 103end_per_suite(_Config) -> 104 ok. 105 106init_per_group(_GroupName, Config) -> 107 Config. 108 109end_per_group(_GroupName, Config) -> 110 Config. 111 112 113-record(state, {bin, reply, leader, unic = latin1}). 114 115 116%% Test that a restricted shell can be started from the normal shell. 117start_restricted_from_shell(Config) when is_list(Config) -> 118 [{error,nofile}] = scan(<<"begin shell:start_restricted(" 119 "nonexisting_module) end.">>), 120 Test = filename:join(proplists:get_value(priv_dir, Config), 121 "test_restricted.erl"), 122 Contents = <<"-module(test_restricted). 123 -export([local_allowed/3, non_local_allowed/3]). 124local_allowed(m,[],State) -> 125 {true,State}; 126local_allowed(ugly,[],_State) -> 127 non_conforming_reply; 128local_allowed(_,_,State) -> 129 {false,State}. 130 131non_local_allowed({shell,stop_restricted},[],State) -> 132 {true,State}; 133non_local_allowed({erlang,'+'},[_],State) -> 134 {true,State}; 135non_local_allowed({erlang,'-'},[_,_],_State) -> 136 non_conforming_reply; 137non_local_allowed({h, d}, [Arg], S) -> 138 {{redirect, {erlang,hd}, [Arg]}, S}; 139non_local_allowed(_,_,State) -> 140 {false,State}. 141">>, 142 ok = compile_file(Config, Test, Contents, []), 143"exception exit: restricted shell starts now" = 144comm_err(<<"begin shell:start_restricted(" 145 "test_restricted) end.">>), 146{ok, test_restricted} = 147application:get_env(stdlib, restricted_shell), 148"Module" ++ _ = t({<<"begin m() end.">>, utf8}), 149"exception exit: restricted shell does not allow c(foo)" = 150comm_err(<<"begin c(foo) end.">>), 151"exception exit: restricted shell does not allow init:stop()" = 152comm_err(<<"begin init:stop() end.">>), 153"exception exit: restricted shell does not allow init:stop()" = 154comm_err(<<"begin F = fun() -> init:stop() end, F() end.">>), 155"exception error: an error occurred when evaluating an arithmetic expression" = 156comm_err(<<"begin +a end.">>), 157"exception exit: restricted shell does not allow a + b" = 158comm_err(<<"begin a+b end.">>), 159"exception exit: restricted shell does not allow - b" = 160comm_err(<<"begin -b end.">>), 161"exception exit: restricted shell does not allow 1 + 2" = 162comm_err(<<"begin if atom(1 + 2> 0) -> 1; true -> 2 end end.">>), 163"exception exit: restricted shell does not allow 1 + 2" = 164comm_err(<<"begin if is_atom(1 + 2> 0) -> 1; true -> 2 end end.">>), 165"exception exit: restricted shell does not allow - 2" = 166comm_err(<<"begin if - 2 -> 1; true -> 2 end end.">>), 167"exception exit: restricted shell does not allow - 2" = 168comm_err(<<"begin if (- 2 > 0) andalso true -> 1; true -> 2 end end.">>), 169"exception exit: restricted shell does not allow - 2" = 170comm_err(<<"begin if (- 2 > 0) orelse true -> 1; true -> 2 end end.">>), 171"exception exit: restricted shell does not allow 1 + 2" = 172comm_err(<<"begin if 1 + 2 > 0 -> 1; true -> 2 end end.">>), 173"exception exit: restricted shell does not allow 1 + 2" = 174comm_err(<<"begin if erlang:is_atom(1 + 2> 0) -> 1; true -> 2 end end.">>), 175"exception exit: restricted shell does not allow is_integer(1)" = 176comm_err(<<"begin if is_integer(1) -> 1; true -> 2 end end.">>), 177"exception exit: restricted shell does not allow is_integer(1)" = 178comm_err(<<"begin if integer(1) -> 1; true -> 2 end end.">>), 179"exception exit: " 180"restricted shell module returned bad value non_conforming_reply" = 181comm_err(<<"ugly().">>), 182[one] = scan(<<"h:d([one,two]).">>), 183"exception exit: " 184"restricted shell module returned bad value non_conforming_reply" = 185comm_err(<<"1 - 2.">>), 186"exception exit: restricted shell stopped"= 187comm_err(<<"begin shell:stop_restricted() end.">>), 188undefined = 189application:get_env(stdlib, restricted_shell), 190ok. 191 192%% Check restricted shell when started from the command line. 193start_restricted_on_command_line(Config) when is_list(Config) -> 194 {ok,Node} = start_node(shell_suite_helper_1, 195 "-pa "++proplists:get_value(priv_dir,Config)++ 196 " -stdlib restricted_shell foo"), 197 "Warning! Restricted shell module foo not found: nofile"++_ = 198 t({Node, <<"begin m() end.">>}), 199 "exception exit: restricted shell does not allow m()" = 200 comm_err({Node, <<"begin m() end.">>}), 201 [ok] = 202 (catch scan({Node, <<"begin q() end.">>})), 203 test_server:stop_node(Node), 204 Test = filename:join(proplists:get_value(priv_dir, Config), 205 "test_restricted2.erl"), 206 Contents = <<"-module(test_restricted2). 207 -export([local_allowed/3, non_local_allowed/3]). 208 local_allowed(m,[],State) -> 209 {true,State}; 210 local_allowed(_,_,State) -> 211 {false,State}. 212 213 non_local_allowed({shell,stop_restricted},[],State) -> 214 {true,State}; 215 non_local_allowed({erlang,node},[],State) -> 216 {true,State}; 217 non_local_allowed(_,_,State) -> 218 {false,State}. 219 ">>, 220 ok = compile_file(Config, Test, Contents, []), 221 {ok,Node2} = start_node(shell_suite_helper_2, 222 "-pa "++proplists:get_value(priv_dir,Config)++ 223 " -stdlib restricted_shell test_restricted2"), 224 "Module" ++ _ = t({Node2,<<"begin m() end.">>, utf8}), 225 "exception exit: restricted shell does not allow c(foo)" = 226 comm_err({Node2,<<"begin c(foo) end.">>}), 227 "exception exit: restricted shell does not allow init:stop()" = 228 comm_err({Node2,<<"begin init:stop() end.">>}), 229 "exception exit: restricted shell does not allow init:stop()" = 230 comm_err({Node2,<<"begin F = fun() -> init:stop() end, F() end.">>}), 231 [Node2] = 232 scan({Node2, <<"begin erlang:node() end.">>}), 233 [Node2] = 234 scan({Node2, <<"begin node() end.">>}), 235 "exception exit: restricted shell stopped"= 236 comm_err({Node2,<<"begin shell:stop_restricted() end.">>}), 237 [ok] = 238 scan({Node2, <<"begin q() end.">>}), 239 test_server:stop_node(Node2), 240 ok. 241 242%% Tests calling local shell functions with spectacular arguments in 243%% restricted shell. 244restricted_local(Config) when is_list(Config) -> 245 [{error,nofile}] = scan(<<"begin shell:start_restricted(" 246 "nonexisting_module) end.">>), 247 Test = filename:join(proplists:get_value(priv_dir, Config), 248 "test_restricted_local.erl"), 249 Contents = <<"-module(test_restricted_local). 250 -export([local_allowed/3, non_local_allowed/3]). 251 local_allowed(m,[],State) -> 252 {true,State}; 253 local_allowed(banan,_,State) -> 254 {true,State}; 255 local_allowed(funkis,_,State) -> 256 {true,State}; 257 local_allowed(c,_,State) -> 258 {true,State}; 259 local_allowed(_,_,State) -> 260 {false,State}. 261 262 non_local_allowed({shell,stop_restricted},[],State) -> 263 {true,State}; 264 non_local_allowed(_,_,State) -> 265 {false,State}. 266 ">>, 267 ok = compile_file(Config, Test, Contents, []), 268 Test2 = filename:join(proplists:get_value(priv_dir, Config), 269 "user_default.erl"), 270 Contents2 = <<"-module(user_default). 271 -export([funkis/1,apple/1]). 272 funkis(F) when is_function(F) -> 273 funkis; 274 funkis(_) -> 275 nofunkis. 276 apple(_) -> 277 apple. 278 ">>, 279 ok = compile_file(Config, Test2, Contents2, []), 280 "exception exit: restricted shell starts now" = 281 comm_err(<<"begin shell:start_restricted(" 282 "test_restricted_local) end.">>), 283 {ok, test_restricted_local} = 284 application:get_env(stdlib, restricted_shell), 285 "exception exit: restricted shell does not allow foo(" ++ _ = 286 comm_err(<<"begin F=fun() -> hello end, foo(F) end.">>), 287 "exception error: undefined shell command banan/1" = 288 comm_err(<<"begin F=fun() -> hello end, banan(F) end.">>), 289 "Recompiling "++_ = t(<<"c(shell_SUITE).">>), 290 "exception exit: restricted shell does not allow l(" ++ _ = 291 comm_err(<<"begin F=fun() -> hello end, l(F) end.">>), 292 "exception error: variable 'F' is unbound" = 293 comm_err(<<"begin F=fun() -> hello end, f(F), F end.">>), 294 [funkis] = 295 scan(<<"begin F=fun() -> hello end, funkis(F) end.">>), 296 "exception exit: restricted shell does not allow apple(" ++ _ = 297 comm_err(<<"begin F=fun() -> hello end, apple(F) end.">>), 298 "exception exit: restricted shell stopped"= 299 comm_err(<<"begin shell:stop_restricted() end.">>), 300 undefined = 301 application:get_env(stdlib, restricted_shell), 302 true = purge_and_delete(user_default), 303 ok. 304 305 306%% f/0 and f/1. 307forget(Config) when is_list(Config) -> 308 %% f/0 309 [ok] = scan(<<"begin f() end.">>), 310 "1: variable 'A' is unbound" = 311 comm_err(<<"A = 3, f(), A.">>), 312 [ok] = scan(<<"A = 3, A = f(), A.">>), 313 314 %% f/1 315 [ok] = scan(<<"begin f(A) end.">>), 316 "1: variable 'A' is unbound" = 317 comm_err(<<"A = 3, f(A), A.">>), 318 [ok] = scan(<<"A = 3, A = f(A), A.">>), 319 "exception error: no function clause matching call to f/1" = 320 comm_err(<<"f(a).">>), 321 ok. 322 323%% Test of the record support. OTP-5063. 324records(Config) when is_list(Config) -> 325 %% rd/2 326 [{attribute,_,record,{bar,_}},ok] = 327 scan(<<"rd(foo,{bar}), 328 rd(bar,{foo = (#foo{})#foo.bar}), 329 rl(bar).">>), 330 "variable 'R' is unbound" = % used to work (before OTP-5878, R11B) 331 exit_string(<<"rd(foo,{bar}), 332 R = #foo{}, 333 rd(bar,{foo = R#foo.bar}).">>), 334 "exception error: no function clause matching call to rd/2" = 335 comm_err(<<"rd({foo},{bar}).">>), 336 "bad record declaration" = exit_string(<<"A = bar, rd(foo,A).">>), 337 [foo] = scan(<<"begin rd(foo,{bar}) end.">>), 338 "1: record foo undefined" = 339 comm_err(<<"begin rd(foo,{bar}), #foo{} end.">>), 340 ['f o o'] = scan(<<"rd('f o o', {bar}).">>), 341 [foo] = scan(<<"rd(foo,{bar}), rd(foo,{foo = #foo{}}).">>), 342 343 %% rf/0,1 344 [_, {attribute,_,record,{foo,_}},ok] = 345 scan(<<"rf('_'). rd(foo,{bar}),rl().">>), 346 "1: record foo undefined" = 347 comm_err(<<"rd(foo,{bar}), #foo{}, rf(foo), #foo{}.">>), 348 [ok,{foo,undefined}] = 349 scan(<<"rd(foo,{bar}), A = #foo{}, rf(foo). A.">>), 350 [_] = scan(<<"begin rf() end.">>), 351 [ok] = scan(<<"begin rf(foo) end.">>), 352 353 %% rp/1 354 "#foo{bar = undefined}.\nok.\n" = 355 t(<<"rd(foo,{bar}), rp(#foo{}).">>), 356 [{foo,3,4,3},ok] = scan(<<"rd(foo,{a = 3, b}), rp({foo,3,4,3}).">>), 357 "#foo{a = 12}.\nok.\n" = t(<<"rd(foo,{a = 3}), rp({foo,12}).">>), 358 [{[{foo}],12},ok] = scan(<<"rd(foo,{a = 3}), rp({[{foo}],12}).">>), 359 360 %% rr/1,2,3 361 MS = ?MODULE_STRING, 362 RR1 = "rr(" ++ MS ++ "). #state{}.", 363 "[state]\n" 364 "#state{bin = undefined,reply = undefined,leader = undefined,\n" 365 " unic = latin1}.\n" = 366 t(RR1), 367 RR2 = "rr(" ++ MS ++ ",[state]). #state{}.", 368 "[state]\n" 369 "#state{bin = undefined,reply = undefined,leader = undefined,\n" 370 " unic = latin1}.\n" = 371 t(RR2), 372 RR3 = "rr(" ++ MS ++ ",'_'). #state{}.", 373 "[state]\n" 374 "#state{bin = undefined,reply = undefined,leader = undefined,\n" 375 " unic = latin1}.\n" = 376 t(RR3), 377 RR4 = "rr(" ++ MS ++ ", '_', {d,test1}).", 378 [[state]] = scan(RR4), 379 380 Test = filename:join(proplists:get_value(priv_dir, Config), "test.erl"), 381 BeamDir = filename:join(proplists:get_value(priv_dir, Config), "beam"), 382 BeamFile = filename:join(BeamDir, "test"), 383 ok = file:make_dir(BeamDir), 384 Contents = <<"-module(test). 385 -record(state, {bin :: binary(), 386 reply = no, 387 leader = some :: atom()}). 388 389 -ifdef(test1). 390 -record(test1, {f}). 391 -endif. 392 393 -ifdef(test2). 394 -record(test2, {g}). 395 -endif. 396 ">>, 397 ok = file:write_file(Test, Contents), 398 {ok, test} = compile:file(Test, [{outdir, BeamDir}]), 399 400 RR5 = "rr(\"" ++ Test ++ "\", '_', {d,test1}), rl([test1,test2]).", 401 A1 = erl_anno:new(1), 402 [{attribute,A1,record,{test1,_}},ok] = scan(RR5), 403 RR6 = "rr(\"" ++ Test ++ "\", '_', {d,test2}), rl([test1,test2]).", 404 [{attribute,A1,record,{test2,_}},ok] = scan(RR6), 405 RR7 = "rr(\"" ++ Test ++ 406 "\", '_', [{d,test1},{d,test2,17}]), rl([test1,test2]).", 407 [{attribute,A1,record,{test1,_}},{attribute,A1,record,{test2,_}},ok] = 408 scan(RR7), 409 PreReply = scan(<<"rr(prim_file).">>), % preloaded... 410 true = is_list(PreReply), 411 Dir = filename:join(proplists:get_value(priv_dir, Config), "*.erl"), 412 RR8 = "rp(rr(\"" ++ Dir ++ "\")).", 413 [_,ok] = scan(RR8), 414 415 {module, test} = code:load_abs(BeamFile), 416 [[state]] = scan(<<"rr(test).">>), 417 file:delete(Test), 418 file:delete(BeamFile++".beam"), 419 420 RR1000 = "begin rr(" ++ MS ++ ") end.", 421 [_] = scan(RR1000), 422 RR1001 = "begin rr(" ++ MS ++ ", state) end.", 423 [_] = scan(RR1001), 424 RR1002 = "begin rr(" ++ MS ++ ", state,{i,'.'}) end.", 425 [_] = scan(RR1002), 426 427 [{error,nofile}] = scan(<<"rr(not_a_module).">>), 428 [{error,invalid_filename}] = scan(<<"rr({foo}).">>), 429 [[]] = scan(<<"rr(\"not_a_file\").">>), 430 431 %% load record from archive 432 true = purge_and_delete(test), 433 434 PrivDir = proplists:get_value(priv_dir, Config), 435 AppDir = filename:join(PrivDir, "test_app"), 436 ok = file:make_dir(AppDir), 437 AppEbinDir = filename:join(AppDir, "ebin"), 438 ok = file:make_dir(AppEbinDir), 439 440 ok = file:write_file(Test, Contents), 441 {ok, test} = compile:file(Test, [{outdir, AppEbinDir}]), 442 443 Ext = init:archive_extension(), 444 Archive = filename:join(PrivDir, "test_app" ++ Ext), 445 {ok, _} = zip:create(Archive, ["test_app"], [{compress, []}, {cwd, PrivDir}]), 446 447 ArchiveEbinDir = filename:join(Archive, "test_app/ebin"), 448 true = code:add_path(ArchiveEbinDir), 449 {module, test} = code:load_file(test), 450 BeamInArchive = filename:join(ArchiveEbinDir, "test.beam"), 451 BeamInArchive = code:which(test), 452 453 [[state]] = scan(<<"rr(test).">>), 454 455 %% using records 456 [2] = scan(<<"rd(foo,{bar}), record_info(size, foo).">>), 457 [true] = scan(<<"rd(foo,{bar}), is_record(#foo{}, foo).">>), 458 [true] = scan(<<"rd(foo,{bar}), erlang:is_record(#foo{}, foo).">>), 459 [true] = scan(<<"rd(foo,{bar}), 460 fun() when record(#foo{},foo) -> true end().">>), 461 [2] = scan(<<"rd(foo,{bar}), #foo.bar.">>), 462 "#foo{bar = 17}.\n" = 463 t(<<"rd(foo,{bar}), A = #foo{}, A#foo{bar = 17}.">>), 464 465 %% test of is_record/2 in lc 466 "[#foo{bar = 3}].\n" = 467 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 468 "is_record(X, foo)].">>), 469 "[x,[],{a,b}].\n" = 470 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 471 "not is_record(X, foo)].">>), 472 "[#foo{bar = 3}].\n" = 473 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 474 "begin is_record(X, foo) end].">>), 475 "[x,[],{a,b}].\n" = 476 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 477 "begin not is_record(X, foo) end].">>), 478 479 "[#foo{bar = 3},x,[],{a,b}].\n" = 480 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 481 "is_record(X, foo) or not is_binary(X)].">>), 482 "[#foo{bar = 3},x,[],{a,b}].\n" = 483 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 484 "not is_record(X, foo) or not is_binary(X)].">>), 485 "[#foo{bar = 3}].\n" = 486 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 487 "is_record(X, foo) or is_reference(X)].">>), 488 "[x,[],{a,b}].\n" = 489 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 490 "not is_record(X, foo) or is_reference(X)].">>), 491 492 "[#foo{bar = 3},x,[],{a,b}].\n" = 493 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 494 "begin is_record(X, foo) or not is_binary(X) end].">>), 495 "[#foo{bar = 3},x,[],{a,b}].\n" = 496 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 497 "begin not is_record(X, foo) or not is_binary(X) end].">>), 498 "[#foo{bar = 3}].\n" = 499 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 500 "begin is_record(X, foo) or is_reference(X) end].">>), 501 "[x,[],{a,b}].\n" = 502 t(<<"rd(foo,{bar}), [X || X <- [#foo{bar=3},x,[],{a,b}]," 503 "begin not is_record(X, foo) or is_reference(X) end].">>), 504 505 [ok] = 506 scan(<<"rd(a,{}), is_record({a},a) andalso true, b().">>), 507 508 %% nested record defs 509 "#b{a = #a{}}.\n" = t(<<"rd(a,{}), rd(b, {a = #a{}}), #b{}.">>), 510 511 [ok,ok,ok] = scan(<<"rf('_'), rp(rp(rl(rf(rf(rf(rl())))))).">>), 512 513 ok. 514 515%% Test of typed record support. 516typed_records(Config) when is_list(Config) -> 517 Test = filename:join(proplists:get_value(priv_dir, Config), "test.hrl"), 518 Contents = <<"-module(test). 519 -record(r0,{f :: any()}). 520 -record(r1,{f1 :: #r1{} | undefined, f2 :: #r0{} | atom()}). 521 -record(r2,{f :: #r2{} | undefined}). 522 ">>, 523 ok = file:write_file(Test, Contents), 524 525 RR1 = "rr(\"" ++ Test ++ "\"), 526 #r1{} = (#r1{f1=#r1{f1=undefined, f2=x}, f2 = #r0{}})#r1.f1, 527 ok.", 528 RR2 = "rr(\"" ++ Test ++ "\"), 529 #r0{} = (#r1{f1=#r1{f1=undefined, f2=x}, f2 = #r0{}})#r1.f2, 530 ok. ", 531 RR3 = "rr(\"" ++ Test ++ "\"), 532 #r1{f2=#r0{}} = (#r1{f1=#r1{f1=undefined, f2=#r0{}}, f2 = x})#r1.f1, 533 ok.", 534 RR4 = "rr(\"" ++ Test ++ "\"), 535 (#r1{f2 = #r0{}})#r1{f2 = x}, 536 ok. ", 537 RR5 = "rr(\"" ++ Test ++ "\"), 538 (#r1{f2 = #r0{}})#r1{f1 = #r1{}}, 539 ok. ", 540 RR6 = "rr(\"" ++ Test ++ "\"), 541 (#r2{f=#r2{f=undefined}})#r2.f, 542 ok.", 543 RR7 = "rr(\"" ++ Test ++ "\"), 544 #r2{} = (#r2{f=#r2{f=undefined}})#r2.f, 545 ok.", 546 [ok] = scan(RR1), 547 [ok] = scan(RR2), 548 [ok] = scan(RR3), 549 [ok] = scan(RR4), 550 [ok] = scan(RR5), 551 [ok] = scan(RR6), 552 [ok] = scan(RR7), 553 554 file:delete(Test), 555 ok. 556 557%% Known bugs. 558known_bugs(Config) when is_list(Config) -> 559 %% erl_eval:merge_bindings/2 cannot handle _removal_ of bindings. 560 [3] = scan(<<"A = 3, length(begin f(A), [3] end), A.">>), 561 ok. 562 563%% OTP-5226. Wildcards accepted when reading BEAM files using rr/1,2,3. 564otp_5226(Config) when is_list(Config) -> 565 Test1 = <<"-module(test1). 566 -record('_test1', {a,b}).">>, 567 Test2 = <<"-module(test2). 568 -record('_test2', {c,d}).">>, 569 File1 = filename("test1.erl", Config), 570 File2 = filename("test2.erl", Config), 571 Beam = filename("*.beam", Config), 572 ok = compile_file(Config, File1, Test1, [no_debug_info]), 573 ok = compile_file(Config, File2, Test2, [no_debug_info]), 574 RR = "rr(\"" ++ Beam ++ "\").", 575 [Recs] = scan(RR), 576 true = lists:member('_test1', Recs), 577 true = lists:member('_test2', Recs), 578 file:delete(filename("test1.beam", Config)), 579 file:delete(filename("test2.beam", Config)), 580 file:delete(File1), 581 file:delete(File2), 582 ok. 583 584%% OTP-5226. Test of eval_bits, mostly. 585otp_5327(Config) when is_list(Config) -> 586 "exception error: bad argument" = 587 comm_err(<<"<<\"hej\":default>>.">>), 588 L1 = erl_anno:new(1), 589 <<"abc">> = 590 erl_parse:normalise({bin,L1,[{bin_element,L1,{string,L1,"abc"}, 591 default,default}]}), 592 [<<"abc">>] = scan(<<"<<(<<\"abc\">>):3/binary>>.">>), 593 [<<"abc">>] = scan(<<"<<(<<\"abc\">>)/binary>>.">>), 594 "exception error: bad argument" = 595 comm_err(<<"<<(<<\"abc\">>):4/binary>>.">>), 596 true = byte_size(hd(scan("<<3.14:64/float>>."))) =:= 8, 597 true = byte_size(hd(scan("<<3.14:32/float>>."))) =:= 4, 598 "exception error: bad argument" = 599 comm_err(<<"<<3.14:128/float>>.">>), 600 "exception error: bad argument" = 601 comm_err(<<"<<10:default>>.">>), 602 [<<98,1:1>>] = scan(<<"<<3:3,5:6>>.">>), 603 {'EXIT',{badarg,_}} = 604 (catch erl_parse:normalise({bin,L1,[{bin_element,L1,{integer,L1,17}, 605 {atom,L1,all}, 606 default}]})), 607 [<<-20/signed>>] = scan(<<"<<-20/signed>> = <<-20>>.">>), 608 [<<-300:16/signed>>] = 609 scan(<<"<<-300:16/signed>> = <<-300:16>>.">>), 610 [<<-1000:24/signed>>] = 611 scan(<<"<<-1000:24/signed>> = <<-1000:24>>.">>), 612 [<<-(1 bsl 29):32/signed>>] = 613 scan(<<"<<-(1 bsl 29):32/signed>> = <<-(1 bsl 29):32>>.">>), 614 615 "exception error: no match of right hand side value <<0,0,0>>" = 616 comm_err(<<"<<B:3/unit:7-binary,_/binary>> = <<0:24>>.">>), 617 true = [<<103133:64/float>>] =:= 618 scan(<<"<<103133:64/float>> = <<103133:64/float>>.">>), 619 true = [<<103133.0:64/float>>] =:= 620 scan(<<"<<103133.0:64/float>> = <<103133:64/float>>.">>), 621 true = [<<103133:64/float>>] =:= scan(<<"<<103133:64/float>>.">>), 622 Int = 17, 623 true = [<<Int:64/float>>] =:= scan(<<"Int = 17, <<Int:64/float>>.">>), 624 "exception error: no match of right hand side value" ++ _ = 625 comm_err(<<"<<103133:64/binary>> = <<103133:64/float>>.">>), 626 "exception error: interpreted function with arity 1 called with two arguments" = 627 comm_err(<<"(fun(X) -> X end)(a,b).">>), 628 {'EXIT', {{badmatch,<<17:32>>}, _}} = 629 (catch evaluate("<<A:a>> = <<17:32>>.", [])), 630 C = <<" 631 <<A:4,B:4,C:4,D:4,E:4,F:4>> = <<\"hej\">>, 632 case <<7:4,A:4,B:4,C:4,D:4,E:4,F:4,3:4>> of 633 <<_:4,\"hej\",3:4>> -> 1; 634 _ -> 2 635 end. 636 ">>, 637 1 = evaluate(C, []), 638 %% unbound_var would be nicer... 639 {'EXIT',{{illegal_pattern,_},_}} = 640 (catch evaluate(<<"<<A:B>> = <<17:32>>.">>, [])), 641 %% A badarith exception is turned into badmatch. 642 {'EXIT', {{badmatch,<<1777:32>>}, _}} = 643 (catch evaluate(<<"<<A:(1/0)>> = <<1777:32>>.">>, [])), 644 %% undefined_bittype is turned into badmatch: 645 {'EXIT',{{badmatch,<<17:32>>},_}} = 646 (catch evaluate(<<"<<A/apa>> = <<17:32>>.">>, [])), 647 {'EXIT',_} = 648 (catch evaluate(<<"<<17/binary-unit:8-unit:16>>.">>, [])), 649 {'EXIT',_} = 650 (catch evaluate(<<"<<17:32/unsigned-signed>> = <<17:32>>.">>, [])), 651 {'EXIT',_} = 652 (catch evaluate(<<"<<17:32/unsigned-signed>>.">>, [])), 653 <<17:32>> = evaluate(<<"<<17:32/signed-signed>>.">>, []), 654 {'EXIT',_} = 655 (catch evaluate(<<"<<32/unit:8>>.">>, [])), 656 ok. 657 658%% OTP-5435. compiler application not in the path. 659otp_5435(Config) when is_list(Config) -> 660 true = <<103133:64/float>> =:= 661 evaluate(<<"<<103133:64/float>> = <<103133:64/float>>.">>, []), 662 true = <<103133.0:64/float>> =:= 663 evaluate(<<"<<103133.0:64/float>> = <<103133:64/float>>.">>, []), 664 true = is_alive(), 665 {ok, Node} = start_node(shell_SUITE_otp_5435), 666 ok = rpc:call(Node, ?MODULE, otp_5435_2, []), 667 test_server:stop_node(Node), 668 ok. 669 670start_node(Name) -> 671 PA = filename:dirname(code:which(?MODULE)), 672 test_server:start_node(Name, slave, [{args, "-pa " ++ PA}]). 673 674otp_5435_2() -> 675 true = code:del_path(compiler), 676 %% Make sure record evaluation is not dependent on the compiler 677 %% application being in the path. 678 %% OTP-5876. 679 [{attribute,_,record,{bar,_}},ok] = 680 scan(<<"rd(foo,{bar}), 681 rd(bar,{foo = (#foo{})#foo.bar}), 682 rl(bar).">>), 683 ok. 684 685%% OTP-5195. QLC, mostly. 686otp_5195(Config) when is_list(Config) -> 687 %% QLC. It was easier to put these cases here than in qlc_SUITE. 688 "[#a{b = undefined}].\n" = 689 t(<<"rd(a,{b}), qlc:e(qlc:q([X || X <- [#a{}],is_record(X, a)])).">>), 690 691 %% An experimental shell used to translate error tuples: 692 %% "(qlc) \"1: generated variable 'X' must not be used in " 693 %% "list expression\".\n" = 694 %% t(<<"qlc:q([X || X <- [{a}], Y <- [X]]).">>), 695 %% Same as last one (if the shell does not translate error tuples): 696 [{error,qlc,{1,qlc,{used_generator_variable,'X'}}}] = 697 scan(<<"qlc:q([X || X <- [{a}], Y <- [X]]).">>), 698 {error,qlc,{1,qlc,{used_generator_variable,'X'}}} = 699 evaluate(<<"qlc:q([X || X <- [{a}], Y <- [X]]).">>, []), 700 Ugly = <<"qlc:e(qlc:q([X || X <- qlc:append([[1,2,3],ugly()])])).">>, 701 "undefined shell command ugly/0" = error_string(Ugly), 702 {'EXIT',{undef,_}} = (catch evaluate(Ugly, [])), 703 704 V_1 = <<"qlc:e(qlc:q([X || X <- qlc:append([[1,2,3],v(-1)])])).">>, 705 "- 1: command not found" = comm_err(V_1), 706 {'EXIT', {undef,_}} = (catch evaluate(V_1, [])), 707 708 "1\n2\n3\n3.\n" = 709 t(<<"1. 2. 3. 3 = fun(A) when A =:= 2 -> v(3) end(v(2)).">>), 710 711 List4 = t(<<"[a,list]. A = [1,2]. " 712 "qlc:q([X || X <- qlc:append(A, v(1))]). " 713 "[1,2,a,list] = qlc:e(v(-1)).">>), 714 "[1,2,a,list].\n" = string:substr(List4, string:len(List4)-13), 715 716 ok. 717 718%% OTP-5915. Strict record tests in guards. 719otp_5915(Config) when is_list(Config) -> 720 C = <<" 721 rd(r, {a = 4,b}), 722 rd(r1, {a,b}), 723 rd(r2, {a = #r1{},b,c=length([1,2,3])}), 724 rd(r3, {a = fun(_) -> #r1{} end(1), b}), 725 726 foo = fun(A) when A#r1.a > A#r1.b -> foo end(#r1{b = 2}), 727 0 = fun(A) when A#r2.a -> 0 end(#r2{a = true}), 728 1 = fun(A) when (#r1{a = A})#r1.a > 2 -> 1 end(3), 729 2 = fun(N) when ((#r2{a = #r{a = 4}, b = length([a,b,c])})#r2.a)#r.a > N -> 730 2 end(2), 731 3 = fun(A) when (A#r2.a)#r1.a =:= 3 -> 3 end(#r2{a = #r1{a = 3}}), 732 ok = fun() -> 733 F = fun(A) when record(A#r.a, r1) -> 4; 734 (A) when record(A#r1.a, r1) -> 5 735 end, 736 5 = F(#r1{a = #r1{}}), 737 4 = F(#r{a = #r1{}}), 738 ok 739 end(), 740 3 = fun(A) when record(A#r1.a, r), 741 (A#r1.a)#r.a > 3 -> 3 742 end(#r1{a = #r{a = 4}}), 743 7 = fun(A) when record(A#r3.a, r1) -> 7 end(#r3{}), 744 [#r1{a = 2,b = 1}] = 745 fun() -> 746 [A || A <- [#r1{a = 1, b = 3}, 747 #r2{a = 2,b = 1}, 748 #r1{a = 2, b = 1}], 749 A#r1.a > 750 A#r1.b] 751 end(), 752 {[_],b} = 753 fun(L) -> 754 %% A is checked only once: 755 R1 = [{A,B} || A <- L, A#r1.a, B <- L, A#r1.b], 756 A = #r2{a = true}, 757 %% A is checked again: 758 B = if A#r1.a -> a; true -> b end, 759 {R1,B} 760 end([#r1{a = true, b = true}]), 761 762 p = fun(A) when (A#r1.a =:= 2) or (A#r2.a =:= 1) -> o; 763 (_) -> p 764 end(#r1{a = 2}), 765 766 o = fun(A) when (A#r1.a =:= 2) orelse (A#r2.a =:= 1) -> o; 767 (_) -> p 768 end(#r1{a = 2}), 769 770 3 = fun(A) when A#r1.a > 3, 771 record(A, r1) -> 3 772 end(#r1{a = 5}), 773 774 ok = fun() -> 775 F = fun(A) when (A#r2.a =:= 1) orelse (A#r2.a) -> 2; 776 (A) when (A#r1.a =:= 1) orelse (A#r1.a) -> 1; 777 (A) when (A#r2.a =:= 2) andalso (A#r2.b) -> 3 778 end, 779 1 = F(#r1{a = 1}), 780 2 = F(#r2{a = true}), 781 3 = F(#r2{a = 2, b = true}), 782 ok 783 end(), 784 785 b = fun(A) when false or not (A#r.a =:= 1) -> a; 786 (_) -> b 787 end(#r1{a = 1}), 788 b = fun(A) when not (A#r.a =:= 1) or false -> a; 789 (_) -> b 790 end(#r1{a = 1}), 791 792 ok = fun() -> 793 F = fun(A) when not (A#r.a =:= 1) -> yes; 794 (_) -> no 795 end, 796 no = F(#r1{a = 2}), 797 yes = F(#r{a = 2}), 798 no = F(#r{a = 1}), 799 ok 800 end(), 801 802 a = fun(A) when record(A, r), 803 A#r.a =:= 1, 804 A#r.b =:= 2 ->a 805 end(#r{a = 1, b = 2}), 806 a = fun(A) when erlang:is_record(A, r), 807 A#r.a =:= 1, 808 A#r.b =:= 2 -> a 809 end(#r{a = 1, b = 2}), 810 a = fun(A) when is_record(A, r), 811 A#r.a =:= 1, 812 A#r.b =:= 2 -> a 813 end(#r{a = 1, b = 2}), 814 815 nop = fun(A) when (is_record(A, r1) and (A#r1.a > 3)) or (A#r2.a < 1) -> 816 japp; 817 (_) -> 818 nop 819 end(#r2{a = 0}), 820 nop = fun(A) when (A#r1.a > 3) or (A#r2.a < 1) -> japp; 821 (_) -> 822 nop 823 end(#r2{a = 0}), 824 825 ok = fun() -> 826 F = fun(A) when (A#r1.a =:= 2) or (A#r2.a =:= 1) -> o; 827 (_) -> p 828 end, 829 p = F(#r2{a = 1}), 830 p = F(#r1{a = 2}), 831 ok 832 end(), 833 834 ok = fun() -> 835 F = fun(A) when fail, A#r1.a; A#r1.a -> ab; 836 (_) -> bu 837 end, 838 ab = F(#r1{a = true}), 839 bu = F(#r2{a = true}), 840 ok 841 end(), 842 843 both = fun(A) when A#r.a, A#r.b -> both 844 end(#r{a = true, b = true}), 845 846 ok = fun() -> 847 F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) 848 or (B#r2.b) or (A#r1.b) -> true; 849 (_, _) -> false 850 end, 851 true = F(#r1{a = false, b = false}, #r2{a = false, b = true}), 852 false = F(#r1{a = true, b = true}, #r1{a = false, b = true}), 853 ok 854 end(), 855 856 ok.">>, 857 [ok] = scan(C), 858 ok. 859 860%% OTP-5916. erlang:is_record/3 allowed in guards. 861otp_5916(Config) when is_list(Config) -> 862 C = <<" 863 rd(r1, {a,b}), 864 rd(r2, {a,b}), 865 866 true = if erlang:is_record(#r1{},r1,3) -> true; true -> false end, 867 false = if erlang:is_record(#r2{},r1,3) -> true; true -> false end, 868 869 true = if is_record(#r1{},r1,3) -> true; true -> false end, 870 false = if is_record(#r2{},r1,3) -> true; true -> false end, 871 872 ok.">>, 873 [ok] = scan(C), 874 ok. 875 876 877%% OTP-5327. Adopted from parts of emulator/test/bs_match_misc_SUITE.erl. 878bs_match_misc_SUITE(Config) when is_list(Config) -> 879 C = <<" 880 F1 = fun() -> 3.1415 end, 881 882 FOne = fun() -> 1.0 end, 883 884 Fcmp = fun(F1, F2) when (F1 - F2) / F2 < 0.0000001 -> ok end, 885 886 MakeSubBin = fun(Bin0) -> 887 Sz = size(Bin0), 888 Bin1 = <<37,Bin0/binary,38,39>>, 889 <<_:8,Bin:Sz/binary,_:8,_:8>> = Bin1, 890 Bin 891 end, 892 893 MatchFloat = 894 fun(Bin0, Fsz, I) -> 895 Bin = MakeSubBin(Bin0), 896 Bsz = size(Bin) * 8, 897 Tsz = Bsz - Fsz - I, 898 <<_:I,F:Fsz/float,_:Tsz>> = Bin, 899 F 900 end, 901 902 TFloat = fun() -> 903 F = F1(), 904 G = FOne(), 905 906 G = MatchFloat(<<63,128,0,0>>, 32, 0), 907 G = MatchFloat(<<63,240,0,0,0,0,0,0>>, 64, 0), 908 909 Fcmp(F, MatchFloat(<<F:32/float>>, 32, 0)), 910 Fcmp(F, MatchFloat(<<F:64/float>>, 64, 0)), 911 Fcmp(F, MatchFloat(<<1:1,F:32/float,127:7>>, 32, 1)), 912 Fcmp(F, MatchFloat(<<1:1,F:64/float,127:7>>, 64, 1)), 913 Fcmp(F, MatchFloat(<<1:13,F:32/float,127:3>>, 32, 13)), 914 Fcmp(F, MatchFloat(<<1:13,F:64/float,127:3>>, 64, 13)) 915 end, 916 TFloat(), 917 918 F2 = fun() -> 2.7133 end, 919 920 MatchFloatLittle = fun(Bin0, Fsz, I) -> 921 Bin = MakeSubBin(Bin0), 922 Bsz = size(Bin) * 8, 923 Tsz = Bsz - Fsz - I, 924 <<_:I,F:Fsz/float-little,_:Tsz>> = Bin, 925 F 926 end, 927 928 LittleFloat = fun() -> 929 F = F2(), 930 G = FOne(), 931 932 G = MatchFloatLittle(<<0,0,0,0,0,0,240,63>>, 64, 0), 933 G = MatchFloatLittle(<<0,0,128,63>>, 32, 0), 934 935 Fcmp(F, MatchFloatLittle(<<F:32/float-little>>, 32, 0)), 936 Fcmp(F, MatchFloatLittle(<<F:64/float-little>>, 64, 0)), 937 Fcmp(F, MatchFloatLittle(<<1:1,F:32/float-little,127:7>>, 32, 1)), 938 Fcmp(F, MatchFloatLittle(<<1:1,F:64/float-little,127:7>>, 64, 1)), 939 Fcmp(F, MatchFloatLittle(<<1:13,F:32/float-little,127:3>>, 32, 13)), 940 Fcmp(F, MatchFloatLittle(<<1:13,F:64/float-little,127:3>>, 64, 13)) 941 end, 942 LittleFloat(), 943 944 Sean1 = fun(<<B/binary>>) when size(B) < 4 -> small; 945 (<<1, _B/binary>>) -> large 946 end, 947 948 Sean = fun() -> 949 small = Sean1(<<>>), 950 small = Sean1(<<1>>), 951 small = Sean1(<<1,2>>), 952 small = Sean1(<<1,2,3>>), 953 large = Sean1(<<1,2,3,4>>), 954 955 small = Sean1(<<4>>), 956 small = Sean1(<<4,5>>), 957 small = Sean1(<<4,5,6>>), 958 {'EXIT',{function_clause,_}} = (catch Sean1(<<4,5,6,7>>)) 959 end, 960 Sean(), 961 962 NativeBig = fun() -> 963 <<37.33:64/native-float>> = <<37.33:64/big-float>>, 964 <<3974:16/native-integer>> = <<3974:16/big-integer>> 965 end, 966 967 NativeLittle = fun() -> 968 <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>, 969 <<7974:16/native-integer>> = <<7974:16/little-integer>> 970 end, 971 972 Native = fun() -> 973 <<3.14:64/native-float>> = <<3.14:64/native-float>>, 974 <<333:16/native>> = <<333:16/native>>, 975 <<38658345:32/native>> = <<38658345:32/native>>, 976 case <<1:16/native>> of 977 <<0,1>> -> NativeBig(); 978 <<1,0>> -> NativeLittle() 979 end 980 end, 981 Native(), 982 983 Split = fun(<<N:16,B:N/binary,T/binary>>) -> {B,T} end, 984 985 Split2 = fun(N, <<N:16,B:N/binary,T/binary>>) -> {B,T} end, 986 987 Split_2 = fun(<<N0:8,N:N0,B:N/binary,T/binary>>) -> {B,T} end, 988 989 Skip = fun(<<N:8,_:N/binary,T/binary>>) -> T end, 990 991 SizeVar = fun() -> 992 {<<45>>,<<>>} = Split(<<1:16,45>>), 993 {<<45>>,<<46,47>>} = Split(<<1:16,45,46,47>>), 994 {<<45,46>>,<<47>>} = Split(<<2:16,45,46,47>>), 995 996 {<<45,46,47>>,<<48>>} = Split_2(<<16:8,3:16,45,46,47,48>>), 997 998 {<<45,46>>,<<47>>} = Split2(2, <<2:16,45,46,47>>), 999 {'EXIT',{function_clause,_}} = 1000 (catch Split2(42, <<2:16,45,46,47>>)), 1001 1002 <<\"cdef\">> = Skip(<<2:8,\"abcdef\">>) 1003 end, 1004 SizeVar(), 1005 1006 Wcheck = fun(<<A>>) when A==3-> ok1; 1007 (<<_,_:2/binary>>) -> ok2; 1008 (<<_>>) -> ok3; 1009 (Other) -> {error,Other} 1010 end, 1011 1012 Wiger = fun() -> 1013 ok1 = Wcheck(<<3>>), 1014 ok2 = Wcheck(<<1,2,3>>), 1015 ok3 = Wcheck(<<4>>), 1016 {error,<<1,2,3,4>>} = Wcheck(<<1,2,3,4>>), 1017 {error,<<>>} = Wcheck(<<>>) 1018 end, 1019 Wiger(), 1020 1021 ok. 1022">>, 1023 [ok] = scan(C), 1024ok = evaluate(C, []). 1025 1026%% This one is not run during night builds since it takes several minutes. 1027 1028%% OTP-5327. Adopted from emulator/test/bs_match_int_SUITE.erl. 1029bs_match_int_SUITE(Config) when is_list(Config) -> 1030 C = <<" 1031 FunClause = fun({'EXIT',{function_clause,_}}) -> ok end, 1032 1033 Mkbin = fun(L) when list(L) -> list_to_binary(L) end, 1034 1035 GetInt1 = fun(<<I:0>>) -> I; 1036 (<<I:8>>) -> I; 1037 (<<I:16>>) -> I; 1038 (<<I:24>>) -> I; 1039 (<<I:32>>) -> I 1040 end, 1041 1042 GetInt2 = fun(Bin0, I, F) when size(Bin0) < 4 -> 1043 Bin = <<0,Bin0/binary>>, 1044 I = GetInt1(Bin), 1045 F(Bin, I, F); 1046 (_, I, _F) -> I 1047 end, 1048 1049 GetInt = fun(Bin) -> 1050 I = GetInt1(Bin), 1051 GetInt2(Bin, I, GetInt2) 1052 end, 1053 1054 1055 Cmp128 = fun(<<I:128>>, I) -> equal; 1056 (_, _) -> not_equal 1057 end, 1058 1059 Uint2 = fun([H|T], Acc, F) -> F(T, Acc bsl 8 bor H, F); 1060 ([], Acc, _F) -> Acc 1061 end, 1062 1063 Uint = fun(L) -> Uint2(L, 0, Uint2) end, 1064 1065 Integer = fun() -> 1066 0 = GetInt(Mkbin([])), 1067 0 = GetInt(Mkbin([0])), 1068 42 = GetInt(Mkbin([42])), 1069 255 = GetInt(Mkbin([255])), 1070 256 = GetInt(Mkbin([1,0])), 1071 257 = GetInt(Mkbin([1,1])), 1072 258 = GetInt(Mkbin([1,2])), 1073 258 = GetInt(Mkbin([1,2])), 1074 65534 = GetInt(Mkbin([255,254])), 1075 16776455 = GetInt(Mkbin([255,253,7])), 1076 4245492555 = GetInt(Mkbin([253,13,19,75])), 1077 4294967294 = GetInt(Mkbin([255,255,255,254])), 1078 4294967295 = GetInt(Mkbin([255,255,255,255])), 1079 Eight = [200,1,19,128,222,42,97,111], 1080 Cmp128(Eight, Uint(Eight)), 1081 FunClause(catch GetInt(Mkbin(lists:seq(1,5)))) 1082 end, 1083 Integer(), 1084 1085 Sint = fun(Bin) -> 1086 case Bin of 1087 <<I:8/signed>> -> I; 1088 <<I:8/signed,_:3,_:5>> -> I; 1089 Other -> {no_match,Other} 1090 end 1091 end, 1092 1093 SignedInteger = fun() -> 1094 {no_match,_} = Sint(Mkbin([])), 1095 {no_match,_} = Sint(Mkbin([1,2,3])), 1096 127 = Sint(Mkbin([127])), 1097 -1 = Sint(Mkbin([255])), 1098 -128 = Sint(Mkbin([128])), 1099 42 = Sint(Mkbin([42,255])), 1100 127 = Sint(Mkbin([127,255])) 1101 end, 1102 SignedInteger(), 1103 1104 Dynamic5 = fun(Bin, S1, S2, A, B) -> 1105 case Bin of 1106 <<A:S1,B:S2>> -> 1107 %% io:format(\"~p ~p ~p ~p~n\", [S1,S2,A,B]), 1108 ok; 1109 _Other -> erlang:error(badmatch, [Bin,S1,S2,A,B]) 1110 end 1111 end, 1112 1113 Dynamic2 = fun(Bin, S1, F) when S1 >= 0 -> 1114 S2 = size(Bin) * 8 - S1, 1115 Dynamic5(Bin, S1, S2, (1 bsl S1) - 1, (1 bsl S2) - 1), 1116 F(Bin, S1-1, F); 1117 (_, _, _) -> ok 1118 end, 1119 1120 Dynamic = fun(Bin, S1) -> 1121 Dynamic2(Bin, S1, Dynamic2) 1122 end, 1123 1124 Dynamic(Mkbin([255]), 8), 1125 Dynamic(Mkbin([255,255]), 16), 1126 Dynamic(Mkbin([255,255,255]), 24), 1127 Dynamic(Mkbin([255,255,255,255]), 32), 1128 1129 BigToLittle4 = 1130 fun([B0,B1,B2,B3,B4,B5,B6,B7|T], N, Acc, F) when N >= 8 -> 1131 F(T, N-8, [B0,B1,B2,B3,B4,B5,B6,B7|Acc], F); 1132 (List, N, Acc, _F) -> lists:sublist(List, 1, N) ++ Acc 1133 end, 1134 1135 BigToLittle = 1136 fun(List, N) -> BigToLittle4(List, N, [], BigToLittle4) end, 1137 1138 ReversedSublist = 1139 fun(_List, 0, Acc, _F) -> Acc; 1140 ([H|T], N, Acc, F) -> F(T, N-1, [H|Acc], F) 1141 end, 1142 1143 TwoComplementAndReverse = 1144 fun([H|T], Carry, Acc, F) -> 1145 Sum = 1-H+Carry, 1146 F(T, Sum div 2, [Sum rem 2|Acc], F); 1147 ([], Carry, Acc, _F) -> [Carry|Acc] 1148 end, 1149 1150 MakeInt = fun(_List, 0, Acc, _F) -> Acc; 1151 ([H|T], N, Acc, F) -> F(T, N-1, Acc bsl 1 bor H, F) 1152 end, 1153 1154 MakeSignedInt = 1155 fun(_List, 0) -> 0; 1156 ([0|_]=List, N) -> MakeInt(List, N, 0, MakeInt); 1157 ([1|_]=List0, N) -> 1158 List1 = ReversedSublist(List0, N, [], ReversedSublist), 1159 List2 = TwoComplementAndReverse(List1, 1, [], 1160 TwoComplementAndReverse), 1161 -MakeInt(List2, length(List2), 0, MakeInt) 1162 end, 1163 1164 BitsToList = 1165 fun([H|T], 0, F) -> F(T, 16#80, F); 1166 ([H|_]=List, Mask, F) -> 1167 [case H band Mask of 1168 0 -> 0; 1169 _ -> 1 1170 end | F(List, Mask bsr 1, F)]; 1171 ([], _, _F) -> [] 1172 end, 1173 1174 MoreDynamic3 = 1175 fun(Action, Bin, List, Bef, Aft, F) when Bef =< Aft -> 1176 Action(Bin, List, Bef, Aft-Bef), 1177 F(Action, Bin, List, Bef, Aft-1, F); 1178 (_, _, _, _, _, _) -> ok 1179 end, 1180 1181 MoreDynamic2 = 1182 fun(Action, Bin, [_|T]=List, Bef, F) -> 1183 MoreDynamic3(Action, Bin, List, Bef, size(Bin)*8, 1184 MoreDynamic3), 1185 F(Action, Bin, T, Bef+1, F); 1186 (_, _, [], _, _F) -> ok 1187 end, 1188 1189 MoreDynamic1 = 1190 fun(Action, Bin) -> 1191 BitList = BitsToList(binary_to_list(Bin),16#80,BitsToList), 1192 MoreDynamic2(Action, Bin, BitList, 0, MoreDynamic2) 1193 end, 1194 1195 MoreDynamic = fun() -> 1196 %% Unsigned big-endian numbers. 1197 Unsigned = fun(Bin, List, SkipBef, N) -> 1198 SkipAft = 8*size(Bin) - N - SkipBef, 1199 <<_:SkipBef,Int:N,_:SkipAft>> = Bin, 1200 Int = MakeInt(List, N, 0, MakeInt) 1201 end, 1202 MoreDynamic1(Unsigned, erlang:md5(Mkbin([42]))), 1203 1204 %% Signed big-endian numbers. 1205 Signed = fun(Bin, List, SkipBef, N) -> 1206 SkipAft = 8*size(Bin) - N - SkipBef, 1207 <<_:SkipBef,Int:N/signed,_:SkipAft>> = Bin, 1208 case MakeSignedInt(List, N) of 1209 Int -> ok; 1210 Other -> 1211 io:format(\"Bin = ~p,\", [Bin]), 1212 io:format(\"SkipBef = ~p, N = ~p\", 1213 [SkipBef,N]), 1214 io:format(\"Expected ~p, got ~p\", 1215 [Int,Other]) 1216 end 1217 end, 1218 MoreDynamic1(Signed, erlang:md5(Mkbin([43]))), 1219 1220 %% Unsigned little-endian numbers. 1221 UnsLittle = fun(Bin, List, SkipBef, N) -> 1222 SkipAft = 8*size(Bin) - N - SkipBef, 1223 <<_:SkipBef,Int:N/little,_:SkipAft>> = Bin, 1224 Int = MakeInt(BigToLittle(List, N), N, 0, 1225 MakeInt) 1226 end, 1227 MoreDynamic1(UnsLittle, erlang:md5(Mkbin([44]))), 1228 1229 %% Signed little-endian numbers. 1230 SignLittle = fun(Bin, List, SkipBef, N) -> 1231 SkipAft = 8*size(Bin) - N - SkipBef, 1232 <<_:SkipBef,Int:N/signed-little,_:SkipAft>> = Bin, 1233 Little = BigToLittle(List, N), 1234 Int = MakeSignedInt(Little, N) 1235 end, 1236 MoreDynamic1(SignLittle, erlang:md5(Mkbin([45]))) 1237 end, 1238 MoreDynamic(), 1239 1240 ok. 1241">>, 1242 [ok] = scan(C), 1243ok = evaluate(C, []). 1244 1245%% OTP-5327. Adopted from emulator/test/bs_match_tail_SUITE.erl. 1246bs_match_tail_SUITE(Config) when is_list(Config) -> 1247 C = <<" 1248 GetTailUsed = fun(<<A:1,T/binary>>) -> {A,T} end, 1249 1250 GetTailUnused = fun(<<A:15,_/binary>>) -> A end, 1251 1252 GetDynTailUsed = fun(Bin, Sz) -> 1253 <<A:Sz,T/binary>> = Bin, 1254 {A,T} 1255 end, 1256 1257 GetDynTailUnused = fun(Bin, Sz) -> 1258 <<A:Sz,_/binary>> = Bin, 1259 A 1260 end, 1261 1262 Mkbin = fun(L) when list(L) -> list_to_binary(L) end, 1263 1264 TestZeroTail = fun(<<A:8>>) -> A end, 1265 1266 TestZeroTail2 = fun(<<_A:4,_B:4>>) -> ok end, 1267 1268 ZeroTail = fun() -> 1269 7 = (catch TestZeroTail(Mkbin([7]))), 1270 {'EXIT',{function_clause,_}} = 1271 (catch TestZeroTail(Mkbin([1,2]))), 1272 {'EXIT',{function_clause,_}} = 1273 (catch TestZeroTail2(Mkbin([1,2,3]))) 1274 end, 1275 ZeroTail(), 1276 1277 AlGetTailUsed = fun(<<A:16,T/binary>>) -> {A,T} end, 1278 1279 AlGetTailUnused = fun(<<A:16,_/binary>>) -> A end, 1280 1281 Aligned = fun() -> 1282 Tail1 = Mkbin([]), 1283 {258,Tail1} = AlGetTailUsed(Mkbin([1,2])), 1284 Tail2 = Mkbin(lists:seq(1, 127)), 1285 {35091,Tail2} = AlGetTailUsed(Mkbin([137,19|Tail2])), 1286 1287 64896 = AlGetTailUnused(Mkbin([253,128])), 1288 64895 = AlGetTailUnused(Mkbin([253,127|lists:seq(42, 255)])), 1289 1290 Tail3 = Mkbin(lists:seq(0, 19)), 1291 {0,Tail1} = GetDynTailUsed(Tail1, 0), 1292 {0,Tail3} = GetDynTailUsed(Mkbin([Tail3]), 0), 1293 {73,Tail3} = GetDynTailUsed(Mkbin([73|Tail3]), 8), 1294 1295 0 = GetDynTailUnused(Mkbin([]), 0), 1296 233 = GetDynTailUnused(Mkbin([233]), 8), 1297 23 = GetDynTailUnused(Mkbin([23,22,2]), 8) 1298 end, 1299 Aligned(), 1300 1301 UnAligned = fun() -> 1302 {'EXIT',{function_clause,_}} = 1303 (catch GetTailUsed(Mkbin([42]))), 1304 {'EXIT',{{badmatch,_},_}} = 1305 (catch GetDynTailUsed(Mkbin([137]), 3)), 1306 {'EXIT',{function_clause,_}} = 1307 (catch GetTailUnused(Mkbin([42,33]))), 1308 {'EXIT',{{badmatch,_},_}} = 1309 (catch GetDynTailUnused(Mkbin([44]), 7)) 1310 end, 1311 UnAligned(), 1312 ok. 1313">>, 1314 [ok] = scan(C), 1315ok = evaluate(C, []). 1316 1317%% OTP-5327. Adopted from emulator/test/bs_match_bin_SUITE.erl. 1318bs_match_bin_SUITE(Config) when is_list(Config) -> 1319 ByteSplitBinary = 1320 <<"ByteSplit = 1321 fun(L, B, Pos, Fun) when Pos >= 0 -> 1322 Sz1 = Pos, 1323 Sz2 = size(B) - Pos, 1324 <<B1:Sz1/binary,B2:Sz2/binary>> = B, 1325 B1 = list_to_binary(lists:sublist(L, 1, Pos)), 1326 B2 = list_to_binary(lists:nthtail(Pos, L)), 1327 Fun(L, B, Pos-1, Fun); 1328 (L, B, _, _Fun) -> ok 1329 end, 1330 Mkbin = fun(L) when list(L) -> list_to_binary(L) end, 1331 L = lists:seq(0, 57), 1332 B = Mkbin(L), 1333 ByteSplit(L, B, size(B), ByteSplit), 1334 Id = fun(I) -> I end, 1335 MakeUnalignedSubBinary = 1336 fun(Bin0) -> 1337 Bin1 = <<0:3,Bin0/binary,31:5>>, 1338 Sz = size(Bin0), 1339 <<0:3,Bin:Sz/binary,31:5>> = Id(Bin1), 1340 Bin 1341 end, 1342 Unaligned = MakeUnalignedSubBinary(B), 1343 ByteSplit(L, Unaligned, size(Unaligned), ByteSplit), 1344 ok. 1345">>, 1346 [ok] = scan(ByteSplitBinary), 1347ok = evaluate(ByteSplitBinary, []), 1348BitSplitBinary = 1349<<"Mkbin = fun(L) when list(L) -> list_to_binary(L) end, 1350 1351 MakeInt = 1352 fun(List, 0, Acc, _F) -> Acc; 1353 ([H|T], N, Acc, F) -> F(T, N-1, Acc bsl 1 bor H, F) 1354 end, 1355 1356 MakeBinFromList = 1357 fun(List, 0, _F) -> Mkbin([]); 1358 (List, N, F) -> 1359 list_to_binary([MakeInt(List, 8, 0, MakeInt), 1360 F(lists:nthtail(8, List), N-8, F)]) 1361 end, 1362 1363 BitSplitBinary3 = 1364 fun(Action, Bin, List, Bef, Aft, F) when Bef =< Aft -> 1365 Action(Bin, List, Bef, (Aft-Bef) div 8 * 8), 1366 F(Action, Bin, List, Bef, Aft-8, F); 1367 (_, _, _, _, _, _) -> ok 1368 end, 1369 1370 BitSplitBinary2 = 1371 fun(Action, Bin, [_|T]=List, Bef, F) -> 1372 BitSplitBinary3(Action, Bin, List, Bef, size(Bin)*8, 1373 BitSplitBinary3), 1374 F(Action, Bin, T, Bef+1, F); 1375 (Action, Bin, [], Bef, F) -> ok 1376 end, 1377 1378 BitsToList = 1379 fun([H|T], 0, F) -> F(T, 16#80, F); 1380 ([H|_]=List, Mask, F) -> 1381 [case H band Mask of 1382 0 -> 0; 1383 _ -> 1 1384 end | F(List, Mask bsr 1, F)]; 1385 ([], _, _F) -> [] 1386 end, 1387 1388 BitSplitBinary1 = 1389 fun(Action, Bin) -> 1390 BitList = BitsToList(binary_to_list(Bin), 16#80, 1391 BitsToList), 1392 BitSplitBinary2(Action, Bin, BitList, 0, BitSplitBinary2) 1393 end, 1394 1395 Fun = fun(Bin, List, SkipBef, N) -> 1396 SkipAft = 8*size(Bin) - N - SkipBef, 1397 <<I1:SkipBef,OutBin:N/binary-unit:1,I2:SkipAft>> = Bin, 1398 OutBin = MakeBinFromList(List, N, MakeBinFromList) 1399 end, 1400 1401 BitSplitBinary1(Fun, erlang:md5(<<1,2,3>>)), 1402 Id = fun(I) -> I end, 1403 MakeUnalignedSubBinary = 1404 fun(Bin0) -> 1405 Bin1 = <<0:3,Bin0/binary,31:5>>, 1406 Sz = size(Bin0), 1407 <<0:3,Bin:Sz/binary,31:5>> = Id(Bin1), 1408 Bin 1409 end, 1410 BitSplitBinary1(Fun, MakeUnalignedSubBinary(erlang:md5(<<1,2,3>>))), 1411 ok. 1412">>, 1413 [ok] = scan(BitSplitBinary), 1414ok = evaluate(BitSplitBinary, []). 1415 1416-define(FAIL(Expr), "{'EXIT',{badarg,_}} = (catch " ??Expr ")"). 1417 1418-define(COF(Int0), 1419 "(fun(Int) -> 1420 true = <<Int:32/float>> =:= <<(float(Int)):32/float>>, 1421 true = <<Int:64/float>> =:= <<(float(Int)):64/float>> 1422 end)(Nonliteral(" ??Int0 ")), 1423true = <<" ??Int0 ":32/float>> =:= <<(float("??Int0")):32/float>>, 1424true = <<" ??Int0 ":64/float>> =:= <<(float("??Int0")):64/float>>"). 1425 1426-define(COF64(Int0), 1427 "(fun(Int) -> 1428 true = <<Int:64/float>> =:= <<(float(Int)):64/float>> 1429 end)(Nonliteral(" ??Int0 ")), 1430true = <<" ??Int0 ":64/float>> =:= <<(float("??Int0")):64/float>>"). 1431 1432%% OTP-5327. Adopted from parts of emulator/test/bs_construct_SUITE.erl. 1433bs_construct_SUITE(Config) when is_list(Config) -> 1434 C1 = <<" 1435 1436 Testf_1 = fun(W, B) -> " 1437 ?FAIL(<<42:W>>) "," 1438 ?FAIL(<<3.14:W/float>>) "," 1439 ?FAIL(<<B:W/binary>>) " 1440 end, 1441 1442 TestF = fun() -> " 1443 ?FAIL(<<3.14>>) "," 1444 ?FAIL(<<<<1,2>>>>) "," 1445 1446 ?FAIL(<<2.71/binary>>) "," 1447 ?FAIL(<<24334/binary>>) "," 1448 ?FAIL(<<24334344294788947129487129487219847/binary>>) "," 1449 1450 ?FAIL(<<<<1,2,3>>/float>>) ", 1451 1452 %% Negative field widths. 1453 Testf_1(-8, <<1,2,3,4,5>>)," 1454 1455 ?FAIL(<<42:(-16)>>) "," 1456 ?FAIL(<<3.14:(-8)/float>>) "," 1457 ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>) "," 1458 ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>) "," 1459 ?FAIL(<<<<23,56,0,2>>:(anka)>>) " 1460 end, 1461 TestF(), 1462 1463 NotUsed1 = fun(I, BinString) -> <<I:32,BinString/binary>>, ok end, 1464 1465 NotUsed2 = fun(I, Sz) -> <<I:Sz>>, ok end, 1466 1467 NotUsed3 = fun(I) -><<I:(-8)>>, ok end, 1468 1469 NotUsed = fun() -> 1470 ok = NotUsed1(3, <<\"dum\">>), 1471 {'EXIT',{badarg,_}} = (catch NotUsed1(3, \"dum\")), " 1472 ?FAIL(NotUsed2(444, -2)) "," 1473 ?FAIL(NotUsed2(444, anka)) "," 1474 ?FAIL(NotUsed3(444)) " 1475 end, 1476 NotUsed(), 1477 1478 InGuard3 = fun(Bin, A, B) when <<A:13,B:3>> == Bin -> 1; 1479 (Bin, A, B) when <<A:16,B/binary>> == Bin -> 2; 1480 (Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3; 1481 (Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> 1482 cant_happen; 1483 (_, _, _) -> nope 1484 end, 1485 1486 InGuard = fun() -> 1487 1 = InGuard3(<<16#74ad:16>>, 16#e95, 5), 1488 2 = InGuard3(<<16#3A,16#F7,\"hello\">>, 16#3AF7, <<\"hello\">>), 1489 3 = InGuard3(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), 1490 nope = InGuard3(<<1>>, 42, b), 1491 nope = InGuard3(<<1>>, a, b), 1492 nope = InGuard3(<<1,2>>, 1, 1), 1493 nope = InGuard3(<<4,5>>, 1, 2.71), 1494 nope = InGuard3(<<4,5>>, 1, <<12,13>>) 1495 end, 1496 InGuard(), 1497 1498 Nonliteral = fun(X) -> X end, 1499 1500 CoerceToFloat = fun() -> " 1501 ?COF(0) "," 1502 ?COF(-1) "," 1503 ?COF(1) "," 1504 ?COF(42) "," 1505 ?COF(255) "," 1506 ?COF(-255) "," 1507 ?COF64(298748888888888888888888888883478264866528467367364766666666666666663) "," 1508 ?COF64(-367546729879999999999947826486652846736736476555566666663) " 1509 end, 1510 CoerceToFloat(), 1511 ok. 1512">>, 1513 [ok] = scan(C1), 1514ok = evaluate(C1, []), 1515 1516%% There is another one, lib/compiler/test/bs_construct_SUITE.erl... 1517C2 = <<" 1518 I = fun(X) -> X end, 1519 1520 Fail = fun() -> 1521 1522 I_minus_777 = I(-777), 1523 I_minus_2047 = I(-2047), 1524 1525 %% One negative field size, but the sum of field sizes will be 1 byte. 1526 %% Make sure that we reject that properly. 1527 1528 {'EXIT',{badarg,_}} = (catch <<I_minus_777:2048/unit:8, 1529 57:I_minus_2047/unit:8>>), 1530 1531 %% Same thing, but use literals. 1532 {'EXIT',{badarg,_}} = (catch <<I_minus_777:2048/unit:8, 1533 57:(-2047)/unit:8>>), 1534 1535 %% Bad alignment. 1536 I_one = I(1), 1537 <<1:1>> = <<2375:I_one>>, 1538 <<3:2>> = <<45:1,2375:I_one>>, 1539 <<14:4>> = <<45:1,2375:I_one,918:2>>, 1540 <<118:7>> = <<45:1,2375:I_one,918:5>>, 1541 1542 %% Not numbers. 1543 {'EXIT',{badarg,_}} = (catch <<45:(I(not_a_number))>>), 1544 {'EXIT',{badarg,_}} = (catch <<13:8,45:(I(not_a_number))>>), 1545 1546 %% Unaligned sizes. 1547 BadSz = I(7), 1548 <<2:4>> = <<34:4>>, 1549 <<34:7>> = <<34:BadSz>>, 1550 1551 [] = [X || {X} <- [], X == <<3:BadSz>>], 1552 [] = [X || {X} <- [], X == <<3:4>>] 1553 end, 1554 Fail(), 1555 1556 FloatBin1 = fun(F) -> 1557 {<<1,2,3>>,F+3.0} 1558 end, 1559 1560 FloatBin = fun() -> 1561 %% Some more coverage. 1562 {<<1,2,3>>,7.0} = FloatBin1(4) 1563 end, 1564 FloatBin(), 1565 1566 ok. 1567">>, 1568 [ok] = scan(C2), 1569ok = evaluate(C2, []). 1570 1571evaluate(B, Vars) when is_binary(B) -> 1572 evaluate(binary_to_list(B), Vars); 1573evaluate(Str, Vars) -> 1574 {ok,Tokens,_} = 1575 erl_scan:string(Str), 1576 {ok, Exprs} = erl_parse:parse_exprs(Tokens), 1577 case erl_eval:exprs(Exprs, Vars, none) of 1578 {value, Result, _} -> 1579 Result 1580 end. 1581 1582 1583%% Bit syntax examples from the Reference Manual. OTP-5237. 1584refman_bit_syntax(Config) when is_list(Config) -> 1585 %% Reference Manual "Bit Syntax Expressions" 1586 Bin1 = <<1,17,42>>, 1587 true = [1,17,42] =:= binary_to_list(Bin1), 1588 Bin2 = <<"abc">>, 1589 true = "abc" =:= binary_to_list(Bin2), 1590 Bin3 = <<1,17,42:16>>, 1591 true = [1,17,0,42] =:= binary_to_list(Bin3), 1592 <<_A,_B,C:16>> = <<1,17,42:16>>, 1593 true = C =:= 42, 1594 <<D:16,_E,F>> = <<1,17,42:16>>, 1595 true = D =:= 273, 1596 true = F =:= 42, 1597 <<_G,H/binary>> = <<1,17,42:16>>, 1598 true = H =:= <<17,0,42>>, 1599 1600 [ok] = 1601 scan(<<"Bin1 = <<1,17,42>>, 1602 true = [1,17,42] =:= binary_to_list(Bin1), 1603 Bin2 = <<\"abc\">>, 1604 true = \"abc\" =:= binary_to_list(Bin2), 1605 Bin3 = <<1,17,42:16>>, 1606 true = 1607 [1,17,0,42] =:= binary_to_list(Bin3), 1608 <<A,B,C:16>> = <<1,17,42:16>>, 1609 true = C =:= 42, 1610 <<D:16,E,F>> = <<1,17,42:16>>, 1611 true = D =:= 273, 1612 true = F =:= 42, 1613 <<G,H/binary>> = <<1,17,42:16>>, 1614 true = H =:= <<17,0,42>>, 1615 ok.">>), 1616 1617 %% Binary comprehensions. 1618 <<2,4,6>> = << << (X*2) >> || <<X>> <= << 1,2,3 >> >>, 1619 ok. 1620 1621 1622-define(IP_VERSION, 4). 1623-define(IP_MIN_HDR_LEN, 5). 1624 1625%% Bit syntax examples from Programming Examples. OTP-5237. 1626progex_bit_syntax(Config) when is_list(Config) -> 1627 Bin11 = <<1, 17, 42>>, 1628 true = [1, 17, 42] =:= binary_to_list(Bin11), 1629 Bin12 = <<"abc">>, 1630 true = [97, 98, 99] =:= binary_to_list(Bin12), 1631 1632 A = 1, B = 17, C = 42, 1633 Bin2 = <<A, B, C:16>>, 1634 true = [1, 17, 00, 42] =:= binary_to_list(Bin2), 1635 <<D:16, E, F/binary>> = Bin2, 1636 true = D =:= 273, 1637 true = E =:= 00, 1638 true = [42] =:= binary_to_list(F), 1639 1640 Fun4 = fun(Dgram) -> 1641 DgramSize = byte_size(Dgram), 1642 case Dgram of 1643 <<?IP_VERSION:4, HLen:4, SrvcType:8, TotLen:16, 1644 ID:16, Flgs:3, FragOff:13, 1645 TTL:8, Proto:8, HdrChkSum:16, 1646 SrcIP:32, DestIP:32, 1647 RestDgram/binary>> when HLen>=5, 4*HLen=<DgramSize -> 1648 OptsLen = 4*(HLen - ?IP_MIN_HDR_LEN), 1649 <<Opts:OptsLen/binary,Data/binary>> = RestDgram, 1650 {SrvcType, TotLen, Flgs, FragOff, ID, HdrChkSum, 1651 Proto, TTL, SrcIP, DestIP, Data, Opts}; 1652 _ -> 1653 not_ok 1654 end 1655 end, 1656 true = Fun4(<<>>) =:= not_ok, 1657 true = is_tuple(Fun4(list_to_binary([<<?IP_VERSION:4,5:4>>, 1658 list_to_binary(lists:seq(1,255))]))), 1659 1660 X = 23432324, Y = 24324234, 1661 <<10:7>> = <<X:1, Y:6>>, 1662 Z = 234324324, 1663 XYZ = <<X:1, Y:6, Z:1>>, 1664 true = [20] =:= binary_to_list(XYZ), 1665 Hello1 = <<"hello">>, 1666 Hello2 = <<$h,$e,$l,$l,$o>>, 1667 true = "hello" =:= binary_to_list(Hello1), 1668 true = "hello" =:= binary_to_list(Hello2), 1669 1670 FunM1 = fun(<<X1:7/binary, Y1:1/binary>>) -> {X1,Y1} end, 1671 true = {<<"1234567">>,<<"8">>} =:= FunM1(<<"12345678">>), 1672 1673 FunM2 = fun(<<_X1:7/binary-unit:7, _Y1:1/binary-unit:1>>) -> ok; 1674 (_) -> not_ok end, 1675 true = not_ok =:= FunM2(<<"1">>), 1676 1677 BL = [{3,4,5},{6,7,8}], 1678 Lst = [0,0,0,3,0,0,0,4,0,0,0,5,0,0,0,6,0,0,0,7,0,0,0,8], 1679 B1 = triples_to_bin1(BL), 1680 true = Lst =:= binary_to_list(B1), 1681 B2 = triples_to_bin2(BL), 1682 true = Lst =:= binary_to_list(B2), 1683 1684 [ok] = scan( 1685 <<"Bin11 = <<1, 17, 42>>, 1686 true = [1, 17, 42] =:= binary_to_list(Bin11), 1687 Bin12 = <<\"abc\">>, 1688 true = [97, 98, 99] =:= binary_to_list(Bin12), 1689 1690 A = 1, B = 17, C = 42, 1691 Bin2 = <<A, B, C:16>>, 1692 true = [1, 17, 00, 42] =:= binary_to_list(Bin2), 1693 <<D:16, E, F/binary>> = Bin2, 1694 true = D =:= 273, 1695 true = E =:= 00, 1696 true = [42] =:= binary_to_list(F), 1697 1698 Fun4 = fun(Dgram) -> 1699 DgramSize = byte_size(Dgram), 1700 case Dgram of 1701 <<4:4, HLen:4, SrvcType:8, TotLen:16, 1702 ID:16, Flgs:3, FragOff:13, 1703 TTL:8, Proto:8, HdrChkSum:16, 1704 SrcIP:32, DestIP:32, 1705 RestDgram/binary>> when HLen>=5, 1706 4*HLen=<DgramSize -> 1707 OptsLen = 4*(HLen - 5), 1708 <<Opts:OptsLen/binary,Data/binary>> = RestDgram, 1709 {SrvcType, TotLen, Flgs, FragOff, ID, HdrChkSum, 1710 Proto, TTL, SrcIP, DestIP, Data, Opts}; 1711 _ -> 1712 not_ok 1713 end 1714 end, 1715 true = Fun4(<<>>) =:= not_ok, 1716 true = is_tuple(Fun4(list_to_binary 1717 ([<<4:4,5:4>>,list_to_binary(lists:seq(1,255))]))), 1718 1719 X = 23432324, Y = 24324234, 1720 <<10:7>> = <<X:1, Y:6>>, 1721 Z = 234324324, 1722 XYZ = <<X:1, Y:6, Z:1>>, 1723 true = [20] =:= binary_to_list(XYZ), 1724 Hello1 = <<\"hello\">>, 1725 Hello2 = <<$h,$e,$l,$l,$o>>, 1726 true = \"hello\" =:= binary_to_list(Hello1), 1727 true = \"hello\" =:= binary_to_list(Hello2), 1728 1729 FunM1 = fun(<<X1:7/binary, Y1:1/binary>>) -> {X1,Y1} end, 1730 true = {<<\"1234567\">>,<<\"8\">>} =:= FunM1(<<\"12345678\">>), 1731 1732 FunM2 = fun(<<_X1:7/binary-unit:7, _Y1:1/binary-unit:1>>) -> ok; 1733 (_) -> not_ok end, 1734 true = not_ok =:= FunM2(<<\"1\">>), 1735 ok.">>), 1736 1737 ok. 1738 1739triples_to_bin1(T) -> 1740 triples_to_bin1(T, <<>>). 1741 1742triples_to_bin1([{X,Y,Z} | T], Acc) -> 1743 triples_to_bin1(T, <<Acc/binary, X:32, Y:32, Z:32>>); % inefficient 1744triples_to_bin1([], Acc) -> 1745 Acc. 1746 1747triples_to_bin2(T) -> 1748 triples_to_bin2(T, []). 1749 1750triples_to_bin2([{X,Y,Z} | T], Acc) -> 1751 triples_to_bin2(T, [<<X:32, Y:32, Z:32>> | Acc]); 1752triples_to_bin2([], Acc) -> 1753 list_to_binary(lists:reverse(Acc)). 1754 1755%% Record examples from Programming Examples. OTP-5237. 1756progex_records(Config) when is_list(Config) -> 1757 Test1 = 1758 <<"-module(recs). 1759 -record(person, {name = \"\", phone = [], address}). 1760 -record(name, {first = \"Robert\", last = \"Ericsson\"}). 1761 -record(person2, {name = #name{}, phone}). 1762-export([t/0]). 1763 1764t() -> 1765 _P1 = #person{phone=[0,8,2,3,4,3,1,2], name=\"Robert\"}, 1766 \"Robert\" = _P1#person.name, 1767 [0,8,2,3,4,3,1,2] = _P1#person.phone, 1768 undefined = _P1#person.address, 1769 1770 _P2 = #person{name = \"Jakob\", _ = '_'}, 1771 \"Jakob\" = _P2#person.name, 1772 '_' = _P2#person.phone, 1773 '_' = _P2#person.address, 1774 1775 P = #person{name = \"Joe\", phone = [0,8,2,3,4,3,1,2]}, 1776 \"Joe\" = P#person.name, 1777 [0,8,2,3,4,3,1,2] = P#person.phone, 1778 undefined = P#person.address, 1779 1780 P1 = #person{name=\"Joe\", phone=[1,2,3], address=\"A street\"}, 1781 P2 = P1#person{name=\"Robert\"}, 1782 \"Robert\" = P2#person.name, 1783 [1,2,3] = P2#person.phone, 1784 \"A street\" = P2#person.address, 1785 a_person = foo(P1), 1786 1787 {found, [1,2,3]} = 1788 find_phone([#person{name = a}, 1789 #person{name = b, phone = [3,2,1]}, 1790 #person{name = c, phone = [1,2,3]}], 1791 c), 1792 1793 P3 = #person{name=\"Joe\", phone=[0,0,7], address=\"A street\"}, 1794 #person{name = Name} = P3, 1795 \"Joe\" = Name, 1796 1797 \"Robert\" = demo(), 1798 ok. 1799 1800foo(P) when is_record(P, person) -> a_person; 1801foo(_) -> not_a_person. 1802 1803find_phone([#person{name=Name, phone=Phone} | _], Name) -> 1804 {found, Phone}; 1805find_phone([_| T], Name) -> 1806 find_phone(T, Name); 1807find_phone([], _Name) -> 1808 not_found. 1809 1810demo() -> 1811 P = #person2{name= #name{first=\"Robert\",last=\"Virding\"}, 1812 phone=123}, 1813 _First = (P#person2.name)#name.first. 1814">>, 1815 ok = run_file(Config, recs, Test1), 1816 1817Test1_shell = 1818<<"rd(person, {name = \"\", phone = [], address}), 1819 rd(name, {first = \"Robert\", last = \"Ericsson\"}), 1820 rd(person2, {name = #name{}, phone}), 1821 1822 _P1 = #person{phone=[0,8,2,3,4,3,1,2], name=\"Robert\"}, 1823 \"Robert\" = _P1#person.name, 1824 [0,8,2,3,4,3,1,2] = _P1#person.phone, 1825 undefined = _P1#person.address, 1826 1827 _P2 = #person{name = \"Jakob\", _ = '_'}, 1828 \"Jakob\" = _P2#person.name, 1829 '_' = _P2#person.phone, 1830 '_' = _P2#person.address, 1831 1832 P = #person{name = \"Joe\", phone = [0,8,2,3,4,3,1,2]}, 1833 \"Joe\" = P#person.name, 1834 [0,8,2,3,4,3,1,2] = P#person.phone, 1835 undefined = P#person.address, 1836 1837 P1 = #person{name=\"Joe\", phone=[1,2,3], address=\"A street\"}, 1838 P2 = P1#person{name=\"Robert\"}, 1839 \"Robert\" = P2#person.name, 1840 [1,2,3] = P2#person.phone, 1841 \"A street\" = P2#person.address, 1842 Foo = fun(P) when is_record(P, person) -> a_person; 1843 (_) -> not_a_person 1844 end, 1845 a_person = Foo(P1), 1846 1847 Find = fun([#person{name=Name, phone=Phone} | _], Name, Fn) -> 1848 {found, Phone}; 1849 ([_| T], Name, Fn) -> 1850 Fn(T, Name, Fn); 1851 ([], _Name, _Fn) -> 1852 not_found 1853 end, 1854 1855 {found, [1,2,3]} = Find([#person{name = a}, 1856 #person{name = b, phone = [3,2,1]}, 1857 #person{name = c, phone = [1,2,3]}], 1858 c, 1859 Find), 1860 1861 P3 = #person{name=\"Joe\", phone=[0,0,7], address=\"A street\"}, 1862 #person{name = Name} = P3, 1863 \"Joe\" = Name, 1864 1865 Demo = fun() -> 1866 P17 = #person2{name= #name{first=\"Robert\",last=\"Virding\"}, 1867 phone=123}, 1868 _First = (P17#person2.name)#name.first 1869 end, 1870 1871 \"Robert\" = Demo(), 1872 ok. 1873">>, 1874 [ok] = scan(Test1_shell), 1875 1876Test2 = 1877<<"-module(recs). 1878 -record(person, {name, age, phone = [], dict = []}). 1879-export([t/0]). 1880 1881t() -> ok. 1882 1883make_hacker_without_phone(Name, Age) -> 1884 #person{name = Name, age = Age, 1885 dict = [{computer_knowledge, excellent}, 1886 {drinks, coke}]}. 1887print(#person{name = Name, age = Age, 1888 phone = Phone, dict = Dict}) -> 1889 io:format(\"Name: ~s, Age: ~w, Phone: ~w ~n\" 1890 \"Dictionary: ~w.~n\", [Name, Age, Phone, Dict]). 1891 1892 birthday(P) when record(P, person) -> 1893 P#person{age = P#person.age + 1}. 1894 1895register_two_hackers() -> 1896 Hacker1 = make_hacker_without_phone(\"Joe\", 29), 1897 OldHacker = birthday(Hacker1), 1898 %% The central_register_server should have 1899 %% an interface function for this. 1900 central_register_server ! {register_person, Hacker1}, 1901 central_register_server ! {register_person, 1902 OldHacker#person{name = \"Robert\", 1903 phone = [0,8,3,2,4,5,3,1]}}. 1904">>, 1905 ok = run_file(Config, recs, Test2), 1906ok. 1907 1908%% List comprehension examples from Programming Examples. OTP-5237. 1909progex_lc(Config) when is_list(Config) -> 1910 Test1 = 1911 <<"-module(lc). 1912 -export([t/0]). 1913 1914t() -> 1915 [a,4,b,5,6] = [X || X <- [1,2,a,3,4,b,5,6], X > 3], 1916 [4,5,6] = [X || X <- [1,2,a,3,4,b,5,6], integer(X), X > 3], 1917 [{1,a},{1,b},{2,a},{2,b},{3,a},{3,b}] = 1918 [{X, Y} || X <- [1,2,3], Y <- [a,b]], 1919 1920 [1,2,3,4,5,6,7,8] = sort([4,5,1,8,3,6,7,2]), 1921 [[b,u,g],[b,g,u],[u,b,g],[u,g,b],[g,b,u],[g,u,b]] = 1922 perms([b,u,g]), 1923 [] = pyth(11), 1924 [{3,4,5},{4,3,5}] = pyth(12), 1925 [{3,4,5},{4,3,5},{5,12,13},{6,8,10},{8,6,10},{8,15,17}, 1926 {9,12,15},{12,5,13},{12,9,15},{12,16,20},{15,8,17}, 1927 {16,12,20}] = pyth(50), 1928 [] = pyth1(11), 1929 [{3,4,5},{4,3,5}] = pyth1(12), 1930 [{3,4,5},{4,3,5},{5,12,13},{6,8,10},{8,6,10},{8,15,17}, 1931 {9,12,15},{12,5,13},{12,9,15},{12,16,20},{15,8,17}, 1932 {16,12,20}] = pyth1(50), 1933 [1,2,3,4,5] = append([[1,2,3],[4,5]]), 1934 [2,3,4] = map(fun(X) -> X + 1 end, [1,2,3]), 1935 [2,4] = filter(fun(X) -> X > 1 end, [0,2,4]), 1936 [1,2,3,7] = select(b,[{a,1},{b,2},{c,3},{b,7}]), 1937 [2,7] = select2(b,[{a,1},{b,2},{c,3},{b,7}]), 1938 ok. 1939 1940sort([Pivot|T]) -> 1941 sort([ X || X <- T, X < Pivot]) ++ 1942 [Pivot] ++ 1943 sort([ X || X <- T, X >= Pivot]); 1944sort([]) -> []. 1945 1946perms([]) -> [[]]; 1947perms(L) -> [[H|T] || H <- L, T <- perms(L--[H])]. 1948 1949pyth(N) -> 1950 [ {A,B,C} || 1951 A <- lists:seq(1,N), 1952 B <- lists:seq(1,N), 1953 C <- lists:seq(1,N), 1954 A+B+C =< N, 1955 A*A+B*B == C*C 1956 ]. 1957 1958pyth1(N) -> 1959 [{A,B,C} || 1960 A <- lists:seq(1,N), 1961 B <- lists:seq(1,N-A+1), 1962 C <- lists:seq(1,N-A-B+2), 1963 A+B+C =< N, 1964 A*A+B*B == C*C ]. 1965 1966append(L) -> [X || L1 <- L, X <- L1]. 1967map(Fun, L) -> [Fun(X) || X <- L]. 1968filter(Pred, L) -> [X || X <- L, Pred(X)]. 1969 1970select(X, L) -> [Y || {X, Y} <- L]. 1971select2(X, L) -> [Y || {X1, Y} <- L, X == X1]. 1972">>, 1973 ok = run_file(Config, lc, Test1), 1974 1975Test1_shell = 1976<<"[a,4,b,5,6] = [X || X <- [1,2,a,3,4,b,5,6], X > 3], 1977 [4,5,6] = [X || X <- [1,2,a,3,4,b,5,6], integer(X), X > 3], 1978 [{1,a},{1,b},{2,a},{2,b},{3,a},{3,b}] = 1979 [{X, Y} || X <- [1,2,3], Y <- [a,b]], 1980 1981 Sort = fun([Pivot|T], Fn) -> 1982 Fn([ X || X <- T, X < Pivot], Fn) ++ 1983 [Pivot] ++ 1984 Fn([ X || X <- T, X >= Pivot], Fn); 1985 ([], _Fn) -> [] 1986 end, 1987 1988 [1,2,3,4,5,6,7,8] = Sort([4,5,1,8,3,6,7,2], Sort), 1989 Perms = fun([], _Fn) -> [[]]; 1990 (L, Fn) -> [[H|T] || H <- L, T <- Fn(L--[H], Fn)] 1991 end, 1992 [[b,u,g],[b,g,u],[u,b,g],[u,g,b],[g,b,u],[g,u,b]] = 1993 Perms([b,u,g], Perms), 1994 1995 Pyth = fun(N) -> 1996 [ {A,B,C} || 1997 A <- lists:seq(1,N), 1998 B <- lists:seq(1,N), 1999 C <- lists:seq(1,N), 2000 A+B+C =< N, 2001 A*A+B*B == C*C 2002 ] 2003 end, 2004 2005 [] = Pyth(11), 2006 [{3,4,5},{4,3,5}] = Pyth(12), 2007%%[{3,4,5},{4,3,5},{5,12,13},{6,8,10},{8,6,10},{8,15,17}, 2008%% {9,12,15},{12,5,13},{12,9,15},{12,16,20},{15,8,17}, 2009%% {16,12,20}] = Pyth(50), 2010 2011 Pyth1 = fun(N) -> 2012 [{A,B,C} || 2013 A <- lists:seq(1,N), 2014 B <- lists:seq(1,N-A+1), 2015 C <- lists:seq(1,N-A-B+2), 2016 A+B+C =< N, 2017 A*A+B*B == C*C ] 2018 end, 2019 2020 [] = Pyth1(11), 2021 [{3,4,5},{4,3,5}] = Pyth1(12), 2022 [{3,4,5},{4,3,5},{5,12,13},{6,8,10},{8,6,10},{8,15,17}, 2023 {9,12,15},{12,5,13},{12,9,15},{12,16,20},{15,8,17}, 2024 {16,12,20}] = Pyth1(50), 2025 2026 Append = fun(L) -> [X || L1 <- L, X <- L1] end, 2027 [1,2,3,4,5] = Append([[1,2,3],[4,5]]), 2028 Map = fun(Fun, L) -> [Fun(X) || X <- L] end, 2029 [2,3,4] = Map(fun(X) -> X + 1 end, [1,2,3]), 2030 Filter = fun(Pred, L) -> [X || X <- L, Pred(X)] end, 2031 [2,4] = Filter(fun(X) -> X > 1 end, [0,2,4]), 2032 2033 Select = fun(X, L) -> [Y || {X, Y} <- L] end, 2034 [1,2,3,7] = Select(b,[{a,1},{b,2},{c,3},{b,7}]), 2035 Select2 = fun(X, L) -> [Y || {X1, Y} <- L, X == X1] end, 2036 [2,7] = Select2(b,[{a,1},{b,2},{c,3},{b,7}]), 2037 ok. 2038">>, 2039 [ok] = scan(Test1_shell), 2040ok. 2041 2042%% Funs examples from Programming Examples. OTP-5237. 2043progex_funs(Config) when is_list(Config) -> 2044 Test1 = 2045 <<"-module(funs). 2046 -export([t/0]). 2047 2048double([H|T]) -> [2*H|double(T)]; 2049double([]) -> []. 2050 2051add_one([H|T]) -> [H+1|add_one(T)]; 2052add_one([]) -> []. 2053 2054map(F, [H|T]) -> [F(H)|map(F, T)]; 2055map(F, []) -> []. 2056 2057double2(L) -> map(fun(X) -> 2*X end, L). 2058add_one2(L) -> map(fun(X) -> 1 + X end, L). 2059 2060print_list(Stream, [H|T]) -> 2061 io:format(Stream, \"~p~n\", [H]), 2062 print_list(Stream, T); 2063 print_list(Stream, []) -> 2064 true. 2065 2066broadcast(Msg, [Pid|Pids]) -> 2067 Pid ! Msg, 2068 broadcast(Msg, Pids); 2069broadcast(_, []) -> 2070 true. 2071 2072foreach(F, [H|T]) -> 2073 F(H), 2074 foreach(F, T); 2075foreach(F, []) -> 2076 ok. 2077 2078print_list2(S, L) -> 2079 foreach(fun(H) -> io:format(S, \"~p~n\",[H]) end, L). 2080 2081 broadcast2(M, L) -> foreach(fun(Pid) -> Pid ! M end, L). 2082 2083t1() -> map(fun(X) -> 2 * X end, [1,2,3,4,5]). 2084 2085t2() -> map(fun double/1, [1,2,3,4,5]). 2086 2087t3() -> map({?MODULE, double3}, [1,2,3,4,5]). 2088 2089double3(X) -> X * 2. 2090 2091f(F, Args) when function(F) -> 2092 apply(F, Args); 2093f(N, _) when integer(N) -> 2094 N. 2095 2096print_list3(File, List) -> 2097 {ok, Stream} = file:open(File, write), 2098 foreach(fun(X) -> io:format(Stream,\"~p~n\",[X]) end, List), 2099 file:close(Stream). 2100 2101print_list4(File, List) -> 2102 {ok, Stream} = file:open(File, write), 2103 foreach(fun(File) -> 2104 io:format(Stream,\"~p~n\",[File]) 2105 end, List), 2106 file:close(Stream). 2107 2108any(Pred, [H|T]) -> 2109 case Pred(H) of 2110 true -> true; 2111 false -> any(Pred, T) 2112 end; 2113any(Pred, []) -> 2114 false. 2115 2116all(Pred, [H|T]) -> 2117 case Pred(H) of 2118 true -> all(Pred, T); 2119 false -> false 2120 end; 2121all(Pred, []) -> 2122 true. 2123 2124foldl(F, Accu, [Hd|Tail]) -> 2125 foldl(F, F(Hd, Accu), Tail); 2126foldl(F, Accu, []) -> Accu. 2127 2128mapfoldl(F, Accu0, [Hd|Tail]) -> 2129 {R,Accu1} = F(Hd, Accu0), 2130 {Rs,Accu2} = mapfoldl(F, Accu1, Tail), 2131 {[R|Rs], Accu2}; 2132mapfoldl(F, Accu, []) -> {[], Accu}. 2133 2134filter(F, [H|T]) -> 2135 case F(H) of 2136 true -> [H|filter(F, T)]; 2137 false -> filter(F, T) 2138 end; 2139filter(F, []) -> []. 2140 2141diff(L1, L2) -> 2142 filter(fun(X) -> not lists:member(X, L2) end, L1). 2143 2144intersection(L1,L2) -> filter(fun(X) -> lists:member(X,L1) end, L2). 2145 2146takewhile(Pred, [H|T]) -> 2147 case Pred(H) of 2148 true -> [H|takewhile(Pred, T)]; 2149 false -> [] 2150 end; 2151takewhile(Pred, []) -> 2152 []. 2153 2154dropwhile(Pred, [H|T]) -> 2155 case Pred(H) of 2156 true -> dropwhile(Pred, T); 2157 false -> [H|T] 2158 end; 2159dropwhile(Pred, []) -> 2160 []. 2161 2162splitlist(Pred, L) -> 2163 splitlist(Pred, L, []). 2164 2165splitlist(Pred, [H|T], L) -> 2166 case Pred(H) of 2167 true -> splitlist(Pred, T, [H|L]); 2168 false -> {lists:reverse(L), [H|T]} 2169 end; 2170splitlist(Pred, [], L) -> 2171 {lists:reverse(L), []}. 2172 2173first(Pred, [H|T]) -> 2174 case Pred(H) of 2175 true -> 2176 {true, H}; 2177 false -> 2178 first(Pred, T) 2179 end; 2180first(Pred, []) -> 2181 false. 2182 2183ints_from(N) -> 2184 fun() -> 2185 [N|ints_from(N+1)] 2186 end. 2187 2188pconst(X) -> 2189 fun (T) -> 2190 case T of 2191 [X|T1] -> {ok, {const, X}, T1}; 2192 _ -> fail 2193 end 2194 end. 2195 2196pand(P1, P2) -> 2197 fun (T) -> 2198 case P1(T) of 2199 {ok, R1, T1} -> 2200 case P2(T1) of 2201 {ok, R2, T2} -> 2202 {ok, {'and', R1, R2}}; 2203 fail -> 2204 fail 2205 end; 2206 fail -> 2207 fail 2208 end 2209 end. 2210 2211por(P1, P2) -> 2212 fun (T) -> 2213 case P1(T) of 2214 {ok, R, T1} -> 2215 {ok, {'or',1,R}, T1}; 2216 fail -> 2217 case P2(T) of 2218 {ok, R1, T1} -> 2219 {ok, {'or',2,R1}, T1}; 2220 fail -> 2221 fail 2222 end 2223 end 2224 end. 2225 2226grammar() -> 2227 pand( 2228 por(pconst(a), pconst(b)), 2229 por(pconst(c), pconst(d))). 2230 2231parse(List) -> 2232 (grammar())(List). 2233 2234 2235t() -> 2236 [2,4,6,8] = double([1,2,3,4]), 2237 [2,3,4,5] = add_one([1,2,3,4]), 2238 [2,4,6,8] = double2([1,2,3,4]), 2239 [2,3,4,5] = add_one2([1,2,3,4]), 2240 XX = ints_from(1), 2241 [1 | _] = XX(), 2242 1 = hd(XX()), 2243 Y = tl(XX()), 2244 2 = hd(Y()), 2245 2246 P1 = pconst(a), 2247 {ok,{const,a},[b,c]} = P1([a,b,c]), 2248 fail = P1([x,y,z]), 2249 2250 {ok,{'and',{'or',1,{const,a}},{'or',1,{const,c}}}} = 2251 parse([a,c]), 2252 {ok,{'and',{'or',1,{const,a}},{'or',2,{const,d}}}} = 2253 parse([a,d]), 2254 {ok,{'and',{'or',2,{const,b}},{'or',1,{const,c}}}} = 2255 parse([b,c]), 2256 {ok,{'and',{'or',2,{const,b}},{'or',2,{const,d}}}} = 2257 parse([b,d]), 2258 fail = parse([a,b]), 2259 ok. 2260">>, 2261 ok = run_file(Config, funs, Test1), 2262 2263Test2_shell = 2264<<"Double = fun(X) -> 2 * X end, 2265 [2,4,6,8,10] = lists:map(Double, [1,2,3,4,5]), 2266 2267 Big = fun(X) -> if X > 10 -> true; true -> false end end, 2268 false = lists:any(Big, [1,2,3,4]), 2269 true = lists:any(Big, [1,2,3,12,5]), 2270 false = lists:all(Big, [1,2,3,4,12,6]), 2271 true = lists:all(Big, [12,13,14,15]), 2272 L = [\"I\",\"like\",\"Erlang\"], 2273 11 = lists:foldl(fun(X, Sum) -> length(X) + Sum end, 0, L), 2274 Upcase = fun(X) when $a =< X, X =< $z -> X + $A - $a; 2275 (X) -> X 2276 end, 2277 Upcase_word = fun(X) -> lists:map(Upcase, X) end, 2278 \"ERLANG\" = Upcase_word(\"Erlang\"), 2279 [\"I\",\"LIKE\",\"ERLANG\"] = lists:map(Upcase_word, L), 2280 {[\"I\",\"LIKE\",\"ERLANG\"],11} = 2281 lists:mapfoldl(fun(Word, Sum) -> 2282 {Upcase_word(Word), Sum + length(Word)} 2283 end, 0, L), 2284 [500,12,45] = lists:filter(Big, [500,12,2,45,6,7]), 2285 [200,500,45] = lists:takewhile(Big, [200,500,45,5,3,45,6]), 2286 [5,3,45,6] = lists:dropwhile(Big, [200,500,45,5,3,45,6]), 2287 {[200,500,45],[5,3,45,6]} = 2288 lists:splitwith(Big, [200,500,45,5,3,45,6]), 2289 %% {true,45} = lists:first(Big, [1,2,45,6,123]), 2290 %% false = lists:first(Big, [1,2,4,5]), 2291 2292 Adder = fun(X) -> fun(Y) -> X + Y end end, 2293 Add6 = Adder(6), 2294 16 = Add6(10), 2295 ok. 2296">>, 2297 [ok] = scan(Test2_shell), 2298ok. 2299 2300 2301%% OTP-5990. {erlang,is_record}. 2302otp_5990(Config) when is_list(Config) -> 2303 [true] = 2304 scan(<<"rd('OrdSet', {orddata = {},ordtype = type}), " 2305 "S = #'OrdSet'{ordtype = {}}, " 2306 "if tuple(S#'OrdSet'.ordtype) -> true; true -> false end.">>), 2307 ok. 2308 2309%% OTP-6166. Order of record definitions. 2310otp_6166(Config) when is_list(Config) -> 2311 Test1 = filename:join(proplists:get_value(priv_dir, Config), "test1.hrl"), 2312 Contents1 = <<"-module(test1). 2313 -record(r5, {f}). -record(r3, {f = #r5{}}). " 2314 "-record(r1, {f = #r3{}}). -record(r4, {f = #r1{}}). " 2315"-record(r2, {f = #r4{}}).">>, 2316 ok = file:write_file(Test1, Contents1), 2317 2318 Test2 = filename:join(proplists:get_value(priv_dir, Config), "test2.hrl"), 2319 Contents2 = <<"-module(test2). 2320 -record(r5, {f}). -record(r3, {f = #r5{}}). " 2321 "-record(r1, {f = #r3{}}). -record(r4, {f = #r1{}}). " 2322 "-record(r2, {f = #r4{}}). 2323 -record(r6, {f = #r5{}}). % r6 > r0 2324 -record(r0, {f = #r5{}, g = #r5{}}). % r0 < r5">>, 2325 ok = file:write_file(Test2, Contents2), 2326 2327 RR12 = "[r1,r2,r3,r4,r5] = rr(\"" ++ Test1 ++ "\"), 2328 [r0,r1,r2,r3,r4,r5,r6] = rr(\"" ++ Test2 ++ "\"), 2329 R0 = #r0{}, R6 = #r6{}, 2330 true = is_record(R0, r0), 2331 true = is_record(R6, r6), 2332 ok. ", 2333 [ok] = scan(RR12), 2334 2335 file:delete(Test1), 2336 file:delete(Test2), 2337 ok. 2338 2339%% OTP-6554. Formatted exits and error messages. 2340otp_6554(Config) when is_list(Config) -> 2341 %% Should check the stacktrace as well... 2342 "exception error: bad argument" = 2343 comm_err(<<"math:sqrt(a).">>), 2344 "exception error: bad argument" = 2345 comm_err(<<"fun(X, Y) -> X ++ Y end(a, b).">>), 2346 "exception error: bad argument" = 2347 comm_err(<<"math:sqrt(lists:seq(1,40)).">>), 2348 "exception error: bad argument" = 2349 comm_err(<<"math:sqrt(lists:seq(1,10)).">>), 2350 "exception error: bad argument" = 2351 comm_err(<<"a ++ b.">>), 2352 "exception error: bad argument" = 2353 comm_err(<<"I = {file_info,undefined,undefined,undefined,undefined, 2354 undefined,undefined,undefined,undefined,undefined, 2355 undefined,undefined,undefined,undefined}, 2356 aa ++ I.">>), 2357 "exception error: bad argument" = 2358 comm_err(<<"I = {file_info,undefined,undefined,undefined,undefined, 2359 undefined,undefined,undefined,undefined,undefined, 2360 undefined,undefined,undefined,undefined}, 2361 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ++ I.">>), 2362 "exception error: bad argument" = 2363 comm_err(<<"I = {file_info,undefined,undefined,undefined,undefined, 2364 undefined,undefined,undefined,undefined,undefined, 2365 undefined,undefined,undefined,undefined}, 2366 I ++ I.">>), 2367 "exception error: bad argument" = 2368 comm_err(<<"fun(X) -> not X end(a).">>), 2369 "exception error: bad argument: a" = 2370 comm_err(<<"fun(A, B) -> A orelse B end(a, b).">>), 2371 "exception error: an error occurred when evaluating an arithmetic expression" = 2372 comm_err(<<"math:sqrt(2)/round(math:sqrt(0)).">>), 2373 "exception error: interpreted function with arity 1 called with no arguments" = 2374 comm_err(<<"fun(V) -> V end().">>), 2375 "exception error: interpreted function with arity 1 called with two arguments" = 2376 comm_err(<<"fun(V) -> V end(1,2).">>), 2377 "exception error: interpreted function with arity 0 called with one argument" = 2378 comm_err(<<"fun() -> v end(1).">>), 2379 "exception error: interpreted function with arity 0 called with 4 arguments" = 2380 comm_err(<<"fun() -> v end(1,2,3,4).">>), 2381 "exception error: math:sqrt/1 called with two arguments" = 2382 comm_err(<<"fun math:sqrt/1(1,2).">>), 2383 "exception error: bad function 1." ++ _ = 2384 comm_err(<<"(math:sqrt(2))().">>), 2385 "exception error: bad function [1," ++ _ = 2386 comm_err(<<"(lists:seq(1, 100))().">>), 2387 "exception error: no match of right hand side value 1" ++ _ = 2388 comm_err(<<"a = math:sqrt(2).">>), 2389 "exception error: no match of right hand side value" ++ _ = 2390 comm_err(<<"I = {file_info,undefined,undefined,undefined,undefined, 2391 undefined,undefined,undefined,undefined,undefined, 2392 undefined,undefined,undefined,undefined}, 2393 a = I.">>), 2394 "exception error: no case clause matching 1" ++ _ = 2395 comm_err(<<"case math:sqrt(2) of a -> ok end.">>), 2396 "exception error: no case clause matching [1," ++ _ = 2397 comm_err(<<"V = lists:seq(1, 20), case V of a -> ok end.">>), 2398 "exception error: no function clause matching" = 2399 comm_err(<<"fun(P) when is_pid(P) -> true end(a).">>), 2400 case test_server:is_native(erl_eval) of 2401 true -> 2402 %% Native code has different exit reason. Don't bother 2403 %% testing them. 2404 ok; 2405 false -> 2406 "exception error: {function_clause," = 2407 comm_err(<<"erlang:error(function_clause, " 2408 "[unproper | list]).">>), 2409 %% Cheating: 2410 "exception error: no function clause matching " 2411 "shell:apply_fun(4)" ++ _ = 2412 comm_err(<<"erlang:error(function_clause, [4]).">>), 2413 "exception error: no function clause matching " 2414 "lists:reverse(" ++ _ = 2415 comm_err(<<"F=fun() -> hello end, lists:reverse(F).">>), 2416 "exception error: no function clause matching " 2417 "lists:reverse(34) (lists.erl, line " ++ _ = 2418 comm_err(<<"lists:reverse(34).">>) 2419 end, 2420 "exception error: function_clause" = 2421 comm_err(<<"erlang:error(function_clause, 4).">>), 2422 "exception error: no function clause matching" ++ _ = 2423 comm_err(<<"fun(a, b, c, d) -> foo end" 2424 " (lists:seq(1,17)," 2425 " lists:seq(1, 18)," 2426 " lists:seq(1, 40)," 2427 " lists:seq(1, 5)).">>), 2428 2429 "exception error: no function clause matching" = 2430 comm_err(<<"fun(P, q) when is_pid(P) -> true end(a, b).">>), 2431 "exception error: no true branch found when evaluating an if expression" = 2432 comm_err(<<"if length([a,b]) > 17 -> a end.">>), 2433 "exception error: no such process or port" = 2434 comm_err(<<"Pid = spawn(fun() -> a end)," 2435 "timer:sleep(1)," 2436 "link(Pid).">>), 2437 "exception error: a system limit has been reached" = 2438 comm_err(<<"list_to_atom(lists:duplicate(300,$a)).">>), 2439 "exception error: bad receive timeout value" = 2440 comm_err(<<"receive after a -> foo end.">>), 2441 "exception error: no try clause matching 1" ++ _ = 2442 comm_err(<<"try math:sqrt(2) of bar -> yes after 3 end.">>), 2443 "exception error: no try clause matching [1" ++ _ = 2444 comm_err(<<"V = lists:seq(1, 20)," 2445 "try V of bar -> yes after 3 end.">>), 2446 "exception error: undefined function math:sqrt/2" = 2447 comm_err(<<"math:sqrt(2, 2).">>), 2448 "exception error: limit of number of arguments to interpreted function " 2449 "exceeded" = 2450 comm_err(<<"fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U) ->" 2451 " a end().">>), 2452 "exception error: bad filter a" = 2453 comm_err(<<"[b || begin a end].">>), 2454 "exception error: bad generator a" = 2455 comm_err(<<"[X || X <- a].">>), 2456 "exception throw: undef" = comm_err(<<"throw(undef).">>), 2457 "exception exit: undef" = comm_err(<<"exit(undef).">>), 2458 2459 "exception exit: foo" = 2460 comm_err(<<"catch spawn_link(fun() ->" 2461 " timer:sleep(300), exit(foo) " 2462 " end)," 2463 "timer:sleep(500).">>), 2464 [ok] = scan( 2465 <<"begin process_flag(trap_exit, true)," 2466 " Pid = spawn_link(fun() ->" 2467 " timer:sleep(300), exit(foo) " 2468 " end)," 2469 " timer:sleep(500)," 2470 " receive {'EXIT', Pid, foo} -> ok end end.">>), 2471 "exception exit: badarith" = 2472 comm_err(<<"catch spawn_link(fun() ->" 2473 " timer:sleep(300), 1/0 " 2474 " end)," 2475 "timer:sleep(500).">>), 2476 "exception exit: {nocatch,foo}" = 2477 comm_err(<<"catch spawn_link(fun() ->" 2478 " timer:sleep(300), throw(foo) " 2479 " end)," 2480 "timer:sleep(500).">>), 2481 [ok] = scan( 2482 <<"begin process_flag(trap_exit, true)," 2483 " Pid = spawn_link(fun() ->" 2484 " timer:sleep(300), throw(foo) " 2485 " end)," 2486 " timer:sleep(500)," 2487 " receive {'EXIT', Pid, {{nocatch,foo},_}} -> ok end " 2488 "end.">>), 2489 2490 "exception error: an error occurred when evaluating an arithmetic expression" = 2491 comm_err(<<"begin catch_exception(true), 1/0 end.">>), 2492 "exception error: an error occurred when evaluating an arithmetic expression" = 2493 comm_err(<<"begin catch_exception(false), 1/0 end.">>), 2494 "exception error: no function clause matching call to catch_exception/1" = 2495 comm_err(<<"catch_exception(1).">>), 2496 2497 %% A bug was corrected (expansion of 'try'): 2498 "2: command not found" = 2499 comm_err(<<"try 1 of 1 -> v(2) after 3 end.">>), 2500 %% Cover a few lines: 2501 "3: command not found" = 2502 comm_err(<<"receive foo -> foo after 0 -> v(3) end.">>), 2503 "3: command not found" = 2504 comm_err(<<"receive foo -> foo after 0 -> e(3) end.">>), 2505 "1 / 0: command not found" = comm_err(<<"v(1/0).">>), 2506 "1\n1.\n" = t(<<"1. e(1).">>), 2507 [ok] = scan(<<"h().">>), 2508 "exception exit: normal" = comm_err(<<"exit(normal).">>), 2509 [foo] = scan(<<"begin history(0), foo end.">>), 2510 application:unset_env(stdlib, shell_history_length), 2511 [true] = scan(<<"begin <<10:(1024*1024*10)>>," 2512 "<<10:(1024*1024*10)>>, garbage_collect() end.">>), 2513 "1: syntax error before: '.'" = comm_err("1-."), 2514 %% comm_err(<<"exit().">>), % would hang 2515 "exception error: no function clause matching call to history/1" = 2516 comm_err(<<"history(foo).">>), 2517 "exception error: no function clause matching call to results/1" = 2518 comm_err(<<"results(foo).">>), 2519 2520 Test = filename:join(proplists:get_value(priv_dir, Config), 2521 "otp_6554.erl"), 2522 Contents = <<"-module(otp_6554). 2523 -export([local_allowed/3, non_local_allowed/3]). 2524 local_allowed(_,_,State) -> 2525 {true,State}. 2526 2527 non_local_allowed(_,_,State) -> 2528 {true,State}. 2529 ">>, 2530 ok = compile_file(Config, Test, Contents, []), 2531 "exception exit: restricted shell starts now" = 2532 comm_err(<<"begin shell:start_restricted(otp_6554) end.">>), 2533 "-record(r,{}).\n1.\nok.\n" = 2534 t(<<"f(), f(B), h(), b(), history(20), results(20)," 2535 "rd(r, {}), rl(r), rf('_'), rl(), rf()," 2536 "rp(1), _ = rr({foo}), _ = rr({foo}, [])," 2537 "rr({foo}, [], []), ok.">>), 2538 "false.\n" = t(<<"catch_exception(true).">>), 2539 "exception exit: restricted shell stopped"= 2540 comm_err(<<"begin shell:stop_restricted() end.">>), 2541 "true.\n" = t(<<"catch_exception(false).">>), 2542 2543 "20\n1\n1\n1: results(2)\n2: 1\n-> 1\n3: v(2)\n-> 1.\nok.\n" = 2544 t(<<"results(2). 1. v(2). h().">>), 2545 application:unset_env(stdlib, shell_saved_results), 2546 "1\nfoo\n17\nB = foo\nC = 17\nF = fun() ->\n foo" 2547 "\n end.\nok.\n" = 2548 t(<<"begin F = fun() -> foo end, 1 end. B = F(). C = 17. b().">>), 2549 2550 "3: command not found" = comm_err(<<"#{v(3) => v}.">>), 2551 "3: command not found" = comm_err(<<"#{k => v(3)}.">>), 2552 "3: command not found" = comm_err(<<"#{v(3) := v}.">>), 2553 "3: command not found" = comm_err(<<"#{k := v(3)}.">>), 2554 "3: command not found" = comm_err(<<"(v(3))#{}.">>), 2555 %% Tests I'd like to do: (you should try them manually) 2556 %% "catch spawn_link(fun() -> timer:sleep(1000), exit(foo) end)." 2557 %% "** exception error: foo" should be output after 1 second 2558 %% "catch spawn_link(fun() -> timer:sleep(1000), 1/0 end)." 2559 %% "** exception error: bad argument..." should be output after 1 second 2560 %% "1/0", "exit(foo)", "throw(foo)". 2561 %% "h()." should show {'EXIT', {badarith,..}}, {'EXIT',{foo,...}}, 2562 %% and {'EXIT',{{nocatch,foo},...}}. 2563 2564 ok. 2565 2566%% OTP-7184. Propagate exit signals from dying evaluator process. 2567otp_7184(Config) when is_list(Config) -> 2568 register(otp_7184, self()), 2569 catch 2570 t(<<"P = self(), 2571 spawn_link(fun() -> process_flag(trap_exit,true), 2572 P ! up, 2573 receive X -> 2574 otp_7184 ! {otp_7184, X} 2575 end 2576 end), 2577 receive up -> ok end, 2578 erlang:raise(throw, thrown, []).">>), 2579 receive {otp_7184,{'EXIT',_,{{nocatch,thrown},[]}}} -> ok end, 2580 2581 catch 2582 t(<<"P = self(), 2583 spawn_link(fun() -> process_flag(trap_exit,true), 2584 P ! up, 2585 receive X -> 2586 otp_7184 ! {otp_7184, X} 2587 end 2588 end), 2589 receive up -> ok end, 2590 erlang:raise(exit, fini, []).">>), 2591 receive {otp_7184,{'EXIT',_,{fini,[]}}} -> ok end, 2592 2593 catch 2594 t(<<"P = self(), 2595 spawn_link(fun() -> process_flag(trap_exit,true), 2596 P ! up, 2597 receive X -> 2598 otp_7184 ! {otp_7184,X} 2599 end 2600 end), 2601 receive up -> ok end, 2602 erlang:raise(error, bad, []).">>), 2603 receive {otp_7184,{'EXIT',_,{bad,[]}}} -> ok end, 2604 2605 unregister(otp_7184), 2606 2607 %% v/1, a few missed cases 2608 "17\n<<0,0,0,64>>.\nok.\n" = 2609 t(<<"17. " 2610 "<<64:32>>. " 2611 "<<64>> = << << X >> || << X >> <= v(2), X > v(1) >>, ok.">>), 2612 2613 "17\n<<0,17>>.\n" =t(<<"17. <<(v(1)):16>>.">>), 2614 2615 ok. 2616 2617%% OTP-7232. qlc:info() bug. 2618otp_7232(Config) when is_list(Config) -> 2619 Info = <<"qlc:info(qlc:sort(qlc:q([X || X <- [55296,56296]]), " 2620 "{order, fun(A,B)-> A>B end})).">>, 2621 "qlc:sort([55296, 56296],\n" 2622 " [{order,\n" 2623 " fun(A, B) ->\n" 2624 " A > B\n" 2625 " end}])" = evaluate(Info, []), 2626 ok. 2627 2628%% OTP-8393. Prompt string. 2629otp_8393(Config) when is_list(Config) -> 2630 _ = shell:prompt_func(default), 2631 "Bad prompt function: '> '" = 2632 prompt_err(<<"shell:prompt_func('> ').">>), 2633 2634 _ = shell:prompt_func(default), 2635 "exception error: an error occurred when evaluating an arithmetic expression"++_ = 2636 prompt_err(<<"shell:prompt_func({shell_SUITE,prompt4}).">>), 2637 2638 _ = shell:prompt_func(default), 2639 "default.\n" = 2640 t(<<"shell:prompt_func({shell_SUITE,prompt2}).">>), 2641 2642 _ = shell:prompt_func(default), 2643 "default\nl.\n" = 2644 t(<<"shell:prompt_func({shell_SUITE,prompt3}). l.">>), 2645 2646 %% 2647 %% Although this tests that you can set a unicode prompt function 2648 %% it does not really test that it does work with the io-servers. 2649 %% That is instead tested in the io_proto_SUITE, which has 2650 %% the right infrastructure in place for such tests. /PaN 2651 %% 2652 _ = shell:prompt_func(default), 2653 "default\nl.\n" = 2654 t(<<"shell:prompt_func({shell_SUITE,prompt5}). l.">>), 2655 2656 %% Restricted shell. 2657 Contents = <<"-module(test_restricted_shell). 2658 -export([local_allowed/3, non_local_allowed/3]). 2659 local_allowed(_,_,State) -> 2660 {false,State}. 2661 2662 non_local_allowed({shell,stop_restricted},[],State) -> 2663 {true,State}; 2664 non_local_allowed({shell,prompt_func},[_L],State) -> 2665 {true,State}; 2666 non_local_allowed({shell_SUITE,prompt1},[_L],State) -> 2667 {true,State}; 2668 non_local_allowed(_,_,State) -> 2669 {false,State}. 2670 ">>, 2671 Test = filename:join(proplists:get_value(priv_dir, Config), 2672 "test_restricted_shell.erl"), 2673 ok = compile_file(Config, Test, Contents, []), 2674 _ = shell:prompt_func(default), 2675 "exception exit: restricted shell starts now" = 2676 comm_err(<<"begin shell:start_restricted(" 2677 "test_restricted_shell) end.">>), 2678 "default.\n"++_ = 2679 t(<<"shell:prompt_func({shell_SUITE,prompt1}).">>), 2680 "exception exit: restricted shell does not allow apple(" ++ _ = 2681 comm_err(<<"apple(1).">>), 2682 "{shell_SUITE,prompt1}.\n" = 2683 t(<<"shell:prompt_func(default).">>), 2684 "exception exit: restricted shell stopped"= 2685 comm_err(<<"begin shell:stop_restricted() end.">>), 2686 undefined = 2687 application:get_env(stdlib, restricted_shell), 2688 2689 NR = shell:results(20), 2690 "default\n20.\n" = 2691 t(<<"shell:prompt_func({shell_SUITE,prompt3}). results(0).">>), 2692 2693 _ = shell:prompt_func(default), 2694 0 = shell:results(NR), 2695 ok. 2696 2697prompt1(_L) -> 2698 "prompt> ". 2699 2700prompt2(_L) -> 2701 {'EXIT', []}. 2702 2703prompt3(L) -> 2704 N = proplists:get_value(history, L), 2705 integer_to_list(N). 2706 2707prompt4(_L) -> 2708 erlang:apply(fun erlang:'/'/2, [1,0]). 2709 2710prompt5(_L) -> 2711 [1050,1072,1082,1074,1086,32,1077,32,85,110,105,99,111,100,101,32,63]. 2712 2713-ifdef(not_used). 2714exit_term(B) -> 2715 "** exception exit:" ++ Reply = t(B), 2716 S0 = string:left(Reply, string:chr(Reply, $\n)-1), 2717 S = string:strip(S0, right, $*), 2718 {ok,Ts,_} = erl_scan:string(S), 2719 {ok,Term} = erl_parse:parse_term(Ts), 2720 Term. 2721-endif. 2722 2723error_string(B) -> 2724 "** exception error:" ++ Reply = t(B), 2725 caught_string(Reply). 2726 2727exit_string(B) -> 2728 "** exception exit:" ++ Reply = t(B), 2729 caught_string(Reply). 2730 2731caught_string(Reply) -> 2732 S0 = string:left(Reply, string:chr(Reply, $\n)-1), 2733 S1 = string:strip(S0, right, $.), 2734 S2 = string:strip(S1, left, $*), 2735 S = string:strip(S2, both, $ ), 2736 string:strip(S, both, $"). 2737 2738comm_err(B) -> 2739 Reply = t(B), 2740 S0 = string:left(Reply, string:chr(Reply, $\n)-1), 2741 S1 = string:strip(S0, left, $*), 2742 S2 = string:strip(S1, both, $ ), 2743 S = string:strip(S2, both, $"), 2744 string:strip(S, right, $.). 2745 2746prompt_err(B) -> 2747 Reply = t(B), 2748 S00 = string:sub_string(Reply, string:chr(Reply, $\n)+1), 2749 S0 = string:left(S00, string:chr(S00, $\n)-1), 2750 S1 = string:strip(S0, left, $*), 2751 S2 = string:strip(S1, both, $ ), 2752 S = string:strip(S2, both, $"), 2753 string:strip(S, right, $.). 2754 2755%% OTP-10302. Unicode. Also OTP-14285, Unicode atoms. 2756otp_10302(Config) when is_list(Config) -> 2757 {ok,Node} = start_node(shell_suite_helper_2, 2758 "-pa "++proplists:get_value(priv_dir,Config)++ 2759 " +pc unicode"), 2760 Test1 = 2761 <<"begin 2762 io:setopts([{encoding,utf8}]), 2763 [1024] = \"\\x{400}\", 2764 rd(rec, {a = \"\\x{400}\"}), 2765 ok = rl(rec) 2766 end.">>, 2767 "-record(rec,{a = \"\x{400}\"}).\nok.\n" = t({Node,Test1}), 2768 2769 Test3 = 2770 <<"io:setopts([{encoding,utf8}]). 2771 rd(rec, {a = \"\\x{400}\"}). 2772 ok = rp(#rec{}).">>, 2773 "ok.\nrec\n#rec{a = \"\x{400}\"}.\nok.\n" = t({Node,Test3}), 2774 2775 Test4 = 2776 <<"io:setopts([{encoding,utf8}]). 2777 A = [1024] = \"\\x{400}\". 2778 b(). 2779 h().">>, 2780 2781 "ok.\n\"\x{400}\"\nA = \"\x{400}\".\nok.\n" 2782 "1: io:setopts([{encoding, utf8}])\n-> ok.\n" 2783 "2: A = [1024] = \"\x{400}\"\n-> \"\x{400}\"\n" 2784 "3: b()\n-> ok.\nok.\n" = t({Node,Test4}), 2785 2786 Test5 = 2787 <<"begin 2788 io:setopts([{encoding,utf8}]), 2789 results(0), 2790 A = [1024] = \"\\x{400}\", 2791 b(), 2792 h() 2793 end.">>, 2794 "A = \"\x{400}\".\nok.\n" = t({Node,Test5}), 2795 2796 %% One $" is "lost": 2797 true = 2798 "\x{400}\": command not found" =:= 2799 prompt_err({Node, 2800 <<"io:setopts([{encoding,utf8}]). v(\"\x{400}\")."/utf8>>, 2801 unicode}), 2802 2803 "ok.\ndefault\n* Bad prompt function: \"\x{400}\".\n" = 2804 t({Node,<<"io:setopts([{encoding,utf8}]). " 2805 "shell:prompt_func(\"\x{400}\")."/utf8>>, 2806 unicode}), 2807 rpc:call(Node,shell, prompt_func, [default]), 2808 _ = shell:prompt_func(default), 2809 2810 %% Test erl_error:format_exception() (cf. OTP-6554) 2811 Test6 = 2812 <<"begin 2813 A = <<\"\\xaa\">>, 2814 S = lists:flatten(io_lib:format(\"~p/~p.\", [A, A])), 2815 {ok, Ts, _} = erl_scan:string(S, 1), 2816 {ok, Es} = erl_parse:parse_exprs(Ts), 2817 B = erl_eval:new_bindings(), 2818 erl_eval:exprs(Es, B) 2819 end.">>, 2820 2821 "** exception error: an error occurred when evaluating" 2822 " an arithmetic expression\n in operator '/'/2\n" 2823 " called as <<\"\xaa\">> / <<\"\xaa\">>.\n" = t(Test6), 2824 Test7 = 2825 <<"io:setopts([{encoding,utf8}]). 2826 A = <<\"\\xaa\">>, 2827 S = lists:flatten(io_lib:format(\"~p/~p.\", [A, A])), 2828 {ok, Ts, _} = erl_scan:string(S, 1), 2829 {ok, Es} = erl_parse:parse_exprs(Ts), 2830 B = erl_eval:new_bindings(), 2831 erl_eval:exprs(Es, B).">>, 2832 2833 "ok.\n** exception error: an error occurred when evaluating" 2834 " an arithmetic expression\n in operator '/'/2\n" 2835 " called as <<\"ª\">> / <<\"ª\">>.\n" = t({Node,Test7}), 2836 Test8 = 2837 <<"begin 2838 A = [1089], 2839 S = lists:flatten(io_lib:format(\"~tp/~tp.\", [A, A])), 2840 {ok, Ts, _} = erl_scan:string(S, 1), 2841 {ok, Es} = erl_parse:parse_exprs(Ts), 2842 B = erl_eval:new_bindings(), 2843 erl_eval:exprs(Es, B) 2844 end.">>, 2845 "** exception error: an error occurred when evaluating" 2846 " an arithmetic expression\n in operator '/'/2\n" 2847 " called as [1089] / [1089].\n" = t(Test8), 2848 Test9 = 2849 <<"io:setopts([{encoding,utf8}]). 2850 A = [1089], 2851 S = lists:flatten(io_lib:format(\"~tp/~tp.\", [A, A])), 2852 {ok, Ts, _} = erl_scan:string(S, 1), 2853 {ok, Es} = erl_parse:parse_exprs(Ts), 2854 B = erl_eval:new_bindings(), 2855 erl_eval:exprs(Es, B).">>, 2856 2857 "ok.\n** exception error: an error occurred when evaluating" 2858 " an arithmetic expression\n in operator '/'/2\n" 2859 " called as \"\x{441}\" / \"\x{441}\".\n" = t({Node,Test9}), 2860 Test10 = 2861 <<"A = {\"1\\xaa\", 2862 $\\xaa, 2863 << <<\"hi\">>/binary >>, 2864 <<\"1\xaa\">>}, 2865 fun(a) -> true end(A).">>, 2866 "** exception error: no function clause matching \n" 2867 " erl_eval:'-inside-an-interpreted-fun-'" 2868 "({\"1\xc2\xaa\",170,<<\"hi\">>,\n " 2869 " <<\"1\xc2\xaa\">>}) .\n" = t(Test10), 2870 Test11 = 2871 <<"io:setopts([{encoding,utf8}]). 2872 A = {\"1\\xaa\", 2873 $\\xaa, 2874 << <<\"hi\">>/binary >>, 2875 <<\"1\xaa\">>}, 2876 fun(a) -> true end(A).">>, 2877 2878 "ok.\n** exception error: no function clause matching \n" 2879 " erl_eval:'-inside-an-interpreted-fun-'" 2880 "({\"1\xaa\",170,<<\"hi\">>,\n " 2881 " <<\"1\xaa\"/utf8>>}) .\n" = t({Node,Test11}), 2882 Test12 = <<"fun(a, b) -> false end(65, [1089]).">>, 2883 "** exception error: no function clause matching \n" 2884 " erl_eval:'-inside-an-interpreted-fun-'(65,[1089])" 2885 " .\n" = t(Test12), 2886 Test13 = 2887 <<"io:setopts([{encoding,utf8}]). 2888 fun(a, b) -> false end(65, [1089]).">>, 2889 "ok.\n** exception error: no function clause matching \n" 2890 " erl_eval:'-inside-an-interpreted-fun-'(65,\"\x{441}\")" 2891 " .\n" = t({Node,Test13}), 2892 2893 %% Unicode atoms. 2894 Test14 = <<"'\\x{447}\\x{435}'().">>, 2895 "** exception error: undefined shell command '\\x{447}\\x{435}'/0.\n" = 2896 t(Test14), 2897 Test15 = <<"io:setopts([{encoding,utf8}]). 2898 '\\x{447}\\x{435}'().">>, 2899 "ok.\n** exception error: undefined shell command '\x{447}\x{435}'/0.\n" = 2900 t({Node,Test15}), 2901 Test16 = <<"shell_SUITE:'\\x{447}\\x{435}'().">>, 2902 "** exception error: undefined function " 2903 "shell_SUITE:'\\x{447}\\x{435}'/0.\n" = t(Test16), 2904 Test17 = <<"io:setopts([{encoding,utf8}]). 2905 shell_SUITE:'\\x{447}\\x{435}'().">>, 2906 "ok.\n** exception error: undefined function " 2907 "shell_SUITE:'\x{447}\x{435}'/0.\n" = 2908 t({Node,Test17}), 2909 test_server:stop_node(Node), 2910 ok. 2911 2912otp_13719(Config) when is_list(Config) -> 2913 Test = <<"-module(otp_13719). 2914 -record(bar, {}). 2915 -record(foo, {bar :: #bar{}}).">>, 2916 File = filename("otp_13719.erl", Config), 2917 Beam = filename("otp_13719.beam", Config), 2918 ok = compile_file(Config, File, Test, []), 2919 RR = "rr(\"" ++ Beam ++ "\"). #foo{}.", 2920 "[bar,foo]\n#foo{bar = undefined}.\n" = t(RR), 2921 file:delete(filename("test.beam", Config)), 2922 file:delete(File), 2923 ok. 2924 2925otp_14285(Config) -> 2926 {ok,Node} = start_node(shell_suite_helper_4, 2927 "-pa "++proplists:get_value(priv_dir,Config)++ 2928 " +pc unicode"), 2929 Test1 = 2930 <<"begin 2931 io:setopts([{encoding,utf8}]), 2932 [1024] = atom_to_list('\\x{400}'), 2933 rd('\\x{400}', {'\\x{400}' = '\\x{400}'}), 2934 ok = rl('\\x{400}') 2935 end.">>, 2936 "-record('\x{400}',{'\x{400}' = '\x{400}'}).\nok.\n" = 2937 t({Node,Test1}), 2938 test_server:stop_node(Node), 2939 ok. 2940 2941otp_14296(Config) when is_list(Config) -> 2942 fun() -> 2943 F = fun() -> a end, 2944 LocalFun = term_to_string(F), 2945 S = LocalFun ++ ".", 2946 "1: syntax error before: Fun" = comm_err(S) 2947 end(), 2948 2949 fun() -> 2950 F = fun mod:func/1, 2951 ExternalFun = term_to_string(F), 2952 S = ExternalFun ++ ".", 2953 R = ExternalFun ++ ".\n", 2954 R = t(S) 2955 end(), 2956 2957 fun() -> 2958 UnknownPid = "<100000.0.0>", 2959 S = UnknownPid ++ ".", 2960 "1: syntax error before: '<'" = comm_err(S) 2961 end(), 2962 2963 fun() -> 2964 KnownPid = term_to_string(self()), 2965 S = KnownPid ++ ".", 2966 R = KnownPid ++ ".\n", 2967 R = t(S) 2968 end(), 2969 2970 fun() -> 2971 Port = open_port({spawn, "erl -s erlang halt"}, [{line,1}]), 2972 KnownPort = erlang:port_to_list(Port), 2973 S = KnownPort ++ ".", 2974 R = KnownPort ++ ".\n", 2975 R = t(S) 2976 end(), 2977 2978 fun() -> 2979 UnknownPort = "#Port<100000.0>", 2980 S = UnknownPort ++ ".", 2981 "1: syntax error before: Port" = comm_err(S) 2982 end(), 2983 2984 fun() -> 2985 UnknownRef = "#Ref<100000.0.0.0>", 2986 S = UnknownRef ++ ".", 2987 "1: syntax error before: Ref" = comm_err(S) 2988 end(), 2989 2990 fun() -> 2991 KnownRef = term_to_string(make_ref()), 2992 S = KnownRef ++ ".", 2993 R = KnownRef ++ ".\n", 2994 R = t(S) 2995 end(), 2996 2997 %% Test erl_eval:extended_parse_term/1 2998 TF = fun(S) -> 2999 {ok, Ts, _} = erl_scan:string(S++".", 1, [text]), 3000 case erl_eval:extended_parse_term(Ts) of 3001 {ok, Term} -> Term; 3002 {error, _}=Error -> Error 3003 end 3004 end, 3005 Fun = fun m:f/1, 3006 Fun = TF(term_to_string(Fun)), 3007 Fun = TF("fun m:f/1"), 3008 Pid = self(), 3009 Pid = TF(term_to_string(Pid)), 3010 Ref = make_ref(), 3011 Ref = TF(term_to_string(Ref)), 3012 Term = {[10, a], {"foo", []}, #{x => <<"bar">>}}, 3013 Term = TF(lists:flatten(io_lib:format("~p", [Term]))), 3014 {$a, F1, "foo"} = TF("{$a, 1.0, \"foo\"}"), 3015 true = is_float(F1), 3016 3 = TF("+3"), 3017 $a = TF("+$a"), 3018 true = is_float(TF("+1.0")), 3019 true = -3 =:= TF("-3"), 3020 true = -$a =:= TF("-$a"), 3021 true = is_float(TF("-1.0")), 3022 {error, {_, _, ["syntax error"++_|_]}} = TF("{1"), 3023 {error, {_,_,"bad term"}} = TF("fun() -> foo end"), 3024 {error, {_,_,"bad term"}} = TF("1, 2"), 3025 ok. 3026 3027term_to_string(T) -> 3028 lists:flatten(io_lib:format("~w", [T])). 3029 3030scan(B) -> 3031 F = fun(Ts) -> 3032 case erl_parse:parse_term(Ts) of 3033 {ok,Term} -> 3034 Term; 3035 _Error -> 3036 {ok,Form} = erl_parse:parse_form(Ts), 3037 Form 3038 end 3039 end, 3040 scan(t(B), F). 3041 3042scan(S0, F) -> 3043 case erl_scan:tokens([], S0, 1) of 3044 {done,{ok,Ts,_},S} -> 3045 [F(Ts) | scan(S, F)]; 3046 _Else -> 3047 [] 3048 end. 3049 3050t({Node,Bin,Enc}) when is_atom(Node),is_binary(Bin), is_atom(Enc) -> 3051 t0({Bin,Enc}, fun() -> start_new_shell(Node) end); 3052t({Node,Bin}) when is_atom(Node),is_binary(Bin) -> 3053 t0({Bin,latin1}, fun() -> start_new_shell(Node) end); 3054t(Bin) when is_binary(Bin) -> 3055 t0({Bin,latin1}, fun() -> start_new_shell() end); 3056t({Bin,Enc}) when is_binary(Bin), is_atom(Enc) -> 3057 t0({Bin,Enc}, fun() -> start_new_shell() end); 3058t(L) -> 3059 t(list_to_binary(L)). 3060 3061t0({Bin,Enc}, F) -> 3062 %% Spawn a process so that io_request messages do not interfer. 3063 P = self(), 3064 C = spawn(fun() -> t1(P, {Bin, Enc}, F) end), 3065 receive {C, R} -> R end. 3066 3067t1(Parent, {Bin,Enc}, F) -> 3068 io:format("*** Testing ~s~n", [binary_to_list(Bin)]), 3069 S = #state{bin = Bin, unic = Enc, reply = [], leader = group_leader()}, 3070 group_leader(self(), self()), 3071 _Shell = F(), 3072 try 3073 server_loop(S) 3074 catch exit:R -> Parent ! {self(), R}; 3075 throw:{?MODULE,LoopReply,latin1} -> 3076 L0 = binary_to_list(list_to_binary(LoopReply)), 3077 [$\n | L1] = lists:dropwhile(fun(X) -> X =/= $\n end, L0), 3078 Parent ! {self(), dotify(L1)}; 3079 throw:{?MODULE,LoopReply,_Uni} -> 3080 Tmp = unicode:characters_to_binary(LoopReply), 3081 L0 = unicode:characters_to_list(Tmp), 3082 [$\n | L1] = lists:dropwhile(fun(X) -> X =/= $\n end, L0), 3083 Parent ! {self(), dotify(L1)} 3084 after group_leader(S#state.leader, self()) 3085 end. 3086 3087dotify([$., $\n | L]) -> 3088 [$., $\n | dotify(L)]; 3089dotify([$,, $\n | L]) -> 3090 [$,, $\n | dotify(L)]; 3091dotify("ok\n" ++ L) -> 3092 "ok.\n" ++ dotify(L); 3093dotify("\nok\n" ++ L) -> 3094 ".\nok.\n" ++ dotify(L); 3095dotify([$\n]) -> 3096 [$., $\n]; 3097dotify([C | L]) -> 3098 [C | dotify(L)]; 3099dotify([]) -> 3100 []. 3101 3102start_new_shell() -> 3103 Shell = shell:start(), 3104 link(Shell), 3105 Shell. 3106 3107start_new_shell(Node) -> 3108 Shell = rpc:call(Node,shell,start,[]), 3109 link(Shell), 3110 Shell. 3111 3112%% This is a very minimal implementation of the IO protocol... 3113 3114server_loop(S) -> 3115 receive 3116 {io_request, From, ReplyAs, Request} when is_pid(From) -> 3117 server_loop(do_io_request(Request, From, S, ReplyAs)); 3118 NotExpected -> 3119 exit(NotExpected) 3120 end. 3121 3122do_io_request(Req, From, S, ReplyAs) -> 3123 case io_requests([Req], [], S) of 3124 {_Status,{eof,_},S1} -> 3125 io_reply(From, ReplyAs, {error,terminated}), 3126 throw({?MODULE,S1#state.reply,S1#state.unic}); 3127 {_Status,Reply,S1} -> 3128 io_reply(From, ReplyAs, Reply), 3129 S1 3130 end. 3131 3132io_reply(From, ReplyAs, Reply) -> 3133 From ! {io_reply, ReplyAs, Reply}. 3134 3135io_requests([{requests, Rs1} | Rs], Cont, S) -> 3136 io_requests(Rs1, [Rs | Cont], S); 3137io_requests([R | Rs], Cont, S) -> 3138 case io_request(R, S) of 3139 {ok, ok, S1} -> 3140 io_requests(Rs, Cont, S1); 3141 Reply -> 3142 Reply 3143 end; 3144io_requests([], [Rs|Cont], S) -> 3145 io_requests(Rs, Cont, S); 3146io_requests([], [], S) -> 3147 {ok,ok,S}. 3148 3149io_request({setopts, Opts}, S) -> 3150 #state{unic = OldEnc, bin = Bin} = S, 3151 NewEnc = case proplists:get_value(encoding, Opts) of 3152 undefined -> OldEnc; 3153 utf8 -> unicode; 3154 New -> New 3155 end, 3156 NewBin = case {OldEnc, NewEnc} of 3157 {E, E} -> Bin; 3158 {latin1, _} -> 3159 unicode:characters_to_binary(Bin, latin1, unicode); 3160 {_, latin1} -> 3161 unicode:characters_to_binary(Bin, unicode, latin1); 3162 {_, _} -> Bin 3163 end, 3164 {ok, ok, S#state{unic = NewEnc, bin = NewBin}}; 3165io_request(getopts, S) -> 3166 {ok,[{encoding,S#state.unic}],S}; 3167io_request({get_geometry,columns}, S) -> 3168 {ok,80,S}; 3169io_request({get_geometry,rows}, S) -> 3170 {ok,24,S}; 3171io_request({put_chars,latin1,Chars}, S) -> 3172 {ok,ok,S#state{reply = [S#state.reply | Chars]}}; 3173io_request({put_chars,unicode,Chars0}, S) -> 3174 Chars = unicode:characters_to_list(Chars0), 3175 {ok,ok,S#state{reply = [S#state.reply | Chars]}}; 3176io_request({put_chars,Enc,Mod,Func,Args}, S) -> 3177 case catch apply(Mod, Func, Args) of 3178 Chars when is_list(Chars) -> 3179 io_request({put_chars,Enc,Chars}, S) 3180 end; 3181io_request({get_until,Enc,_Prompt,Mod,Func,ExtraArgs}, S) -> 3182 get_until(Mod, Func, ExtraArgs, S, Enc). 3183 3184get_until(Mod, Func, ExtraArgs, S, Enc) -> 3185 get_until_loop(Mod, Func, ExtraArgs, S, {more,[]}, Enc). 3186 3187get_until_loop(M, F, As, S, {more,Cont}, Enc) -> 3188 Bin = S#state.bin, 3189 case byte_size(Bin) of 3190 0 -> 3191 get_until_loop(M, F, As, S, 3192 catch apply(M, F, [Cont,eof|As]), Enc); 3193 _ when S#state.unic =:= latin1 -> 3194 get_until_loop(M, F, As, S#state{bin = <<>>}, 3195 catch apply(M, F, [Cont,binary_to_list(Bin)|As]), Enc); 3196 _ -> 3197 get_until_loop(M, F, As, S#state{bin = <<>>}, 3198 catch apply(M, F, [Cont,unicode:characters_to_list(Bin)|As]), Enc) 3199 end; 3200get_until_loop(_M, _F, _As, S, {done,Res,Buf}, Enc) -> 3201 {ok,Res,S#state{bin = buf2bin(Buf, Enc)}}; 3202get_until_loop(_M, F, _As, S, _Other, _Enc) -> 3203 {error,{error,F},S}. 3204 3205buf2bin(eof,_) -> 3206 <<>>; 3207buf2bin(Buf,latin1) -> 3208 list_to_binary(Buf); 3209buf2bin(Buf,utf8) -> 3210 unicode:characters_to_binary(Buf,unicode,unicode); 3211buf2bin(Buf,unicode) -> 3212 unicode:characters_to_binary(Buf,unicode,unicode). 3213 3214run_file(Config, Module, Test) -> 3215 FileName = filename(lists:concat([Module, ".erl"]), Config), 3216 BeamFile = filename(lists:concat([Module, ".beam"]), Config), 3217 LoadBeamFile = filename(Module, Config), 3218 ok = file:write_file(FileName, Test), 3219 ok = compile_file(Config, FileName, Test, []), 3220 code:purge(Module), 3221 {module, Module} = code:load_abs(LoadBeamFile), 3222 ok = Module:t(), 3223 file:delete(FileName), 3224 file:delete(BeamFile), 3225 ok. 3226 3227compile_file(Config, File, Test, Opts0) -> 3228 Opts = [export_all,nowarn_export_all,return,{outdir,proplists:get_value(priv_dir, Config)}|Opts0], 3229 ok = file:write_file(File, Test), 3230 case compile:file(File, Opts) of 3231 {ok, _M, _Ws} -> ok; 3232 _ -> error 3233 end. 3234 3235filename(Name, Config) when is_atom(Name) -> 3236 filename(atom_to_list(Name), Config); 3237filename(Name, Config) -> 3238 filename:join(proplists:get_value(priv_dir, Config), Name). 3239 3240start_node(Name, Xargs) -> 3241 N = test_server:start_node(Name, slave, [{args, " " ++ Xargs}]), 3242 global:sync(), 3243 N. 3244 3245purge_and_delete(Module) -> 3246 (catch code:purge(Module)), 3247 (catch code:delete(Module)). 3248