diff options
Diffstat (limited to 'erts/emulator/test')
24 files changed, 1645 insertions, 159 deletions
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 4d0c87bf12..08d2066da3 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -61,7 +61,7 @@ MODULES= \ exception_SUITE \ float_SUITE \ fun_SUITE \ - fun_r12_SUITE \ + fun_r13_SUITE \ gc_SUITE \ guard_SUITE \ hash_SUITE \ diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl index 3487917677..413bd3bcae 100644 --- a/erts/emulator/test/big_SUITE.erl +++ b/erts/emulator/test/big_SUITE.erl @@ -26,7 +26,7 @@ shift_limit_1/1, powmod/1, system_limit/1, otp_6692/1]). %% Internal exports. --export([eval/1, funcall/2]). +-export([eval/1]). -export([init/3]). -export([fac/1, fib/1, pow/2, gcd/2, lcm/2]). @@ -162,12 +162,15 @@ multi_match([Node|Ns], Expr, Rs) -> multi_match([], _, Rs) -> Rs. eval(Expr) -> - Fun = {?MODULE,funcall}, - {value,V,_} = erl_eval:expr(Expr, [], Fun), %Applied arithmetic BIFs. - V = eval(Expr, Fun), %Real arithmetic instructions. - V. + LFH = fun(Name, As) -> apply(?MODULE, Name, As) end, + + %% Applied arithmetic BIFs. + {value,V,_} = erl_eval:expr(Expr, [], {value,LFH}), -funcall(F, As) -> apply(?MODULE, F, As). + %% Real arithmetic instructions. + V = eval(Expr, LFH), + + V. %% Like a subset of erl_eval:expr/3, but uses real arithmetic instructions instead of %% applying them (it does make a difference). diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index fed5854112..d9fc876482 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -33,7 +33,6 @@ %% erlang:external_size/1 %% size(Binary) %% iolist_size/1 -%% concat_binary/1 %% split_binary/2 %% hash(Binary, N) %% phash(Binary, N) @@ -47,7 +46,7 @@ init_per_testcase/2, end_per_testcase/2, copy_terms/1, conversions/1, deep_lists/1, deep_bitstr_lists/1, bad_list_to_binary/1, bad_binary_to_list/1, - t_split_binary/1, bad_split/1, t_concat_binary/1, + t_split_binary/1, bad_split/1, terms/1, terms_float/1, external_size/1, t_iolist_size/1, t_hash/1, bad_size/1, @@ -68,7 +67,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, all() -> [copy_terms, conversions, deep_lists, deep_bitstr_lists, - t_split_binary, bad_split, t_concat_binary, + t_split_binary, bad_split, bad_list_to_binary, bad_binary_to_list, terms, terms_float, external_size, t_iolist_size, bad_binary_to_term_2, safe_binary_to_term2, @@ -93,7 +92,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Config. @@ -381,41 +379,6 @@ bad_split(Config) when is_list(Config) -> bad_split(Bin, Pos) -> {'EXIT',{badarg,_}} = (catch split_binary(Bin, Pos)). -%% Tests concat_binary/2 and size/1. - -t_concat_binary(suite) -> []; -t_concat_binary(Config) when is_list(Config) -> - test_concat([]), - - test_concat([[]]), - test_concat([[], []]), - test_concat([[], [], []]), - - test_concat([[1], []]), - test_concat([[], [2]]), - test_concat([[], [3], []]), - - test_concat([[1, 2, 3], [4, 5, 6, 7]]), - test_concat([[1, 2, 3], [4, 5, 6, 7], [9, 10]]), - - test_concat([lists:seq(0, 255), lists:duplicate(1024, $@), - lists:duplicate(2048, $a), - lists:duplicate(4000, $b)]), - ok. - -test_concat(Lists) -> - test_concat(Lists, 0, [], []). - -test_concat([List|Rest], Size, Combined, Binaries) -> - ?line Bin = list_to_binary(List), - ?line test_concat(Rest, Size+length(List), Combined++List, [Bin|Binaries]); -test_concat([], Size, Combined, Binaries0) -> - ?line Binaries = lists:reverse(Binaries0), - ?line Bin = concat_binary(Binaries), - ?line Size = size(Bin), - ?line Size = iolist_size(Bin), - ?line Combined = binary_to_list(Bin). - t_hash(doc) -> "Test hash/2 with different type of binaries."; t_hash(Config) when is_list(Config) -> test_hash([]), diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl index b022f96740..15427661f3 100644 --- a/erts/emulator/test/bs_match_misc_SUITE.erl +++ b/erts/emulator/test/bs_match_misc_SUITE.erl @@ -23,7 +23,7 @@ bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1, kenneth/1,encode_binary/1,native/1,happi/1, size_var/1,wiger/1,x0_context/1,huge_float_field/1, - writable_binary_matched/1,otp_7198/1]). + writable_binary_matched/1,otp_7198/1,unordered_bindings/1]). -include_lib("test_server/include/test_server.hrl"). @@ -33,7 +33,7 @@ all() -> [bound_var, bound_tail, t_float, little_float, sean, kenneth, encode_binary, native, happi, size_var, wiger, x0_context, huge_float_field, writable_binary_matched, - otp_7198]. + otp_7198, unordered_bindings]. groups() -> []. @@ -553,5 +553,15 @@ otp_7198_scan(<<C, Rest/binary>>, TokAcc) when otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) end. +unordered_bindings(Config) when is_list(Config) -> + {<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} = + unordered_bindings(4, 2, 3, <<1,2,3,4, 42,42, 3,3,3, 3>>), + ok. + +unordered_bindings(CompressedLength, HashSize, PadLength, T) -> + <<Content:CompressedLength/binary,Mac:HashSize/binary, + Padding:PadLength/binary,PadLength>> = T, + {Content,Mac,Padding}. + id(I) -> I. diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl index 72c656c400..4ab7d674a6 100644 --- a/erts/emulator/test/bs_utf_SUITE.erl +++ b/erts/emulator/test/bs_utf_SUITE.erl @@ -64,8 +64,7 @@ end_per_group(_GroupName, Config) -> utf8_roundtrip(Config) when is_list(Config) -> ?line utf8_roundtrip(0, 16#D7FF), - ?line utf8_roundtrip(16#E000, 16#FFFD), - ?line utf8_roundtrip(16#10000, 16#10FFFF), + ?line utf8_roundtrip(16#E000, 16#10FFFF), ok. utf8_roundtrip(First, Last) when First =< Last -> @@ -91,8 +90,7 @@ utf16_roundtrip(Config) when is_list(Config) -> do_utf16_roundtrip(Fun) -> do_utf16_roundtrip(0, 16#D7FF, Fun), - do_utf16_roundtrip(16#E000, 16#FFFD, Fun), - do_utf16_roundtrip(16#10000, 16#10FFFF, Fun). + do_utf16_roundtrip(16#E000, 16#10FFFF, Fun). do_utf16_roundtrip(First, Last, Fun) when First =< Last -> Fun(First), @@ -129,8 +127,7 @@ utf32_roundtrip(Config) when is_list(Config) -> do_utf32_roundtrip(Fun) -> do_utf32_roundtrip(0, 16#D7FF, Fun), - do_utf32_roundtrip(16#E000, 16#FFFD, Fun), - do_utf32_roundtrip(16#10000, 16#10FFFF, Fun). + do_utf32_roundtrip(16#E000, 16#10FFFF, Fun). do_utf32_roundtrip(First, Last, Fun) when First =< Last -> Fun(First), @@ -158,7 +155,6 @@ utf32_little_roundtrip(Char) -> utf8_illegal_sequences(Config) when is_list(Config) -> ?line fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line fail_range(16#FFFE, 16#FFFF), %Non-characters. %% Illegal first character. ?line [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)], @@ -251,7 +247,6 @@ fail_1(_) -> ok. utf16_illegal_sequences(Config) when is_list(Config) -> ?line utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf16_fail_range(16#FFFE, 16#FFFF), %Non-characters. ?line lonely_hi_surrogate(16#D800, 16#DFFF), ?line leading_lo_surrogate(16#DC00, 16#DFFF), @@ -300,7 +295,6 @@ leading_lo_surrogate(_, _, _) -> ok. utf32_illegal_sequences(Config) when is_list(Config) -> ?line utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf32_fail_range(16#FFFE, 16#FFFF), %Non-characters. ?line utf32_fail_range(-100, -1), ok. diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 93fdc157f7..3e2bee06d1 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -934,6 +934,10 @@ exception_nocatch(Config) when is_list(Config) -> exception_nocatch(). exception_nocatch() -> + Deep4LocThrow = get_deep_4_loc({throw,[42]}), + Deep4LocError = get_deep_4_loc({error,[42]}), + Deep4LocBadmatch = get_deep_4_loc({'=',[a,b]}), + Prog = [{'_',[],[{exception_trace}]}], ?line 1 = erlang:trace_pattern({?MODULE,deep_1,'_'}, Prog), ?line 1 = erlang:trace_pattern({?MODULE,deep_2,'_'}, Prog), @@ -959,8 +963,9 @@ exception_nocatch() -> {trace,t2,exception_from,{erlang,throw,1}, {error,{nocatch,Q2}}}], exception_from, {error,{nocatch,Q2}}), - ?line expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2]}, - {?MODULE,deep_4,1}]}}), + ?line expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]}, + {?MODULE,deep_4,1, + Deep4LocThrow}]}}), ?line Q3 = {dump,[dump,{dump}]}, ?line T3 = exception_nocatch(?LINE, error, [Q3], 4, @@ -968,18 +973,29 @@ exception_nocatch() -> {trace,t3,exception_from,{erlang,error,1}, {error,Q3}}], exception_from, {error,Q3}), - ?line expect({trace,T3,exit,{Q3,[{erlang,error,[Q3]}, - {?MODULE,deep_4,1}]}}), + ?line expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]}, + {?MODULE,deep_4,1,Deep4LocError}]}}), ?line T4 = exception_nocatch(?LINE, '=', [17,4711], 5, [], exception_from, {error,{badmatch,4711}}), - ?line expect({trace,T4,exit,{{badmatch,4711},[{?MODULE,deep_4,1}]}}), + ?line expect({trace,T4,exit,{{badmatch,4711}, + [{?MODULE,deep_4,1,Deep4LocBadmatch}]}}), %% ?line erlang:trace_pattern({?MODULE,'_','_'}, false), ?line erlang:trace_pattern({erlang,'_','_'}, false), ?line expect(), ?line ok. +get_deep_4_loc(Arg) -> + try + deep_4(Arg), + ?t:fail(should_not_return_to_here) + catch + _:_ -> + [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(), + Loc0 + end. + exception_nocatch(Line, B, Q, N, Extra, Tag, R) -> ?line io:format("== Subtest: ~w", [Line]), ?line Go = make_ref(), diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 29cbdedd17..2f9b01cc92 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -24,9 +24,10 @@ t_check_process_code/1,t_check_old_code/1, t_check_process_code_ets/1, external_fun/1,get_chunk/1,module_md5/1,make_stub/1, - make_stub_many_funs/1,constant_pools/1, - false_dependency/1,coverage/1]). + make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1, + false_dependency/1,coverage/1,fun_confusion/1]). +-define(line_trace, 1). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -35,15 +36,18 @@ all() -> [new_binary_types, t_check_process_code, t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, - constant_pools, false_dependency, coverage]. + constant_pools, constant_refc_binaries, false_dependency, + coverage, fun_confusion]. groups() -> []. init_per_suite(Config) -> + erts_debug:set_internal_state(available_internal_state, true), Config. end_per_suite(_Config) -> + catch erts_debug:set_internal_state(available_internal_state, false), ok. init_per_group(_GroupName, Config) -> @@ -278,7 +282,8 @@ t_check_old_code(Config) when is_list(Config) -> external_fun(Config) when is_list(Config) -> ?line false = erlang:function_exported(another_code_test, x, 1), - ?line ExtFun = erlang:make_fun(id(another_code_test), x, 1), + AnotherCodeTest = id(another_code_test), + ExtFun = fun AnotherCodeTest:x/1, ?line {'EXIT',{undef,_}} = (catch ExtFun(answer)), ?line false = erlang:function_exported(another_code_test, x, 1), ?line false = lists:member(another_code_test, erlang:loaded()), @@ -403,7 +408,7 @@ make_stub_many_funs(Config) when is_list(Config) -> constant_pools(Config) when is_list(Config) -> ?line Data = ?config(data_dir, Config), ?line File = filename:join(Data, "literals"), - ?line {ok,literals,Code} = compile:file(File, [report,binary,constant_pool]), + ?line {ok,literals,Code} = compile:file(File, [report,binary]), ?line {module,literals} = erlang:load_module(literals, make_sub_binary(Code)), @@ -474,6 +479,131 @@ create_old_heap() -> create_old_heap() end. +constant_refc_binaries(Config) when is_list(Config) -> + wait_for_memory_deallocations(), + Bef = memory_binary(), + io:format("Binary data (bytes) before test: ~p\n", [Bef]), + + %% Compile the the literals module. + Data = ?config(data_dir, Config), + File = filename:join(Data, "literals"), + {ok,literals,Code} = compile:file(File, [report,binary]), + + %% Load the code and make sure that the binary is a refc binary. + {module,literals} = erlang:load_module(literals, Code), + Bin = literals:binary(), + Sz = byte_size(Bin), + Check = erlang:md5(Bin), + io:format("Size of literal refc binary: ~p\n", [Sz]), + {refc_binary,Sz,_,_} = erts_debug:get_internal_state({binary_info,Bin}), + true = erlang:delete_module(literals), + false = erlang:check_process_code(self(), literals), + true = erlang:purge_module(literals), + + %% Now try to provoke a memory leak. + provoke_mem_leak(10, Code, Check), + + %% Calculate the change in allocated binary data. + erlang:garbage_collect(), + wait_for_memory_deallocations(), + Aft = memory_binary(), + io:format("Binary data (bytes) after test: ~p", [Aft]), + Diff = Aft - Bef, + if + Diff < 0 -> + io:format("~p less bytes", [abs(Diff)]); + Diff > 0 -> + io:format("~p more bytes", [Diff]); + true -> + ok + end, + + %% Test for leaks. We must accept some natural variations in + %% the size of allocated binaries. + if + Diff > 64*1024 -> + ?t:fail(binary_leak); + true -> + ok + end. + +memory_binary() -> + try + erlang:memory(binary) + catch + error:notsup -> + 0 + end. + +provoke_mem_leak(0, _, _) -> ok; +provoke_mem_leak(N, Code, Check) -> + {module,literals} = erlang:load_module(literals, Code), + + %% Create several processes with references to the literal binary. + Self = self(), + Pids = [spawn_link(fun() -> + create_binaries(Self, NumRefs, Check) + end) || NumRefs <- lists:seq(1, 10)], + [receive {started,Pid} -> ok end || Pid <- Pids], + + %% Make the code old and remove references to the constant pool + %% in all processes. + true = erlang:delete_module(literals), + Ms = [spawn_monitor(fun() -> + false = erlang:check_process_code(Pid, literals) + end) || Pid <- Pids], + [receive + {'DOWN',R,process,P,normal} -> + ok + end || {P,R} <- Ms], + + %% Purge the code. + true = erlang:purge_module(literals), + + %% Tell the processes that the code has been purged. + [begin + monitor(process, Pid), + Pid ! purged + end || Pid <- Pids], + + %% Wait for all processes to terminate. + [receive + {'DOWN',_,process,Pid,normal} -> + ok + end || Pid <- Pids], + + %% We now expect that the binary has been deallocated. + provoke_mem_leak(N-1, Code, Check). + +create_binaries(Parent, NumRefs, Check) -> + Bin = literals:binary(), + Bins = lists:duplicate(NumRefs, Bin), + {bits,Bits} = literals:bits(), + Parent ! {started,self()}, + receive + purged -> + %% The code has been purged. Now make sure that + %% the binaries haven't been corrupted. + Check = erlang:md5(Bin), + [Bin = B || B <- Bins], + <<42:13,Bin/binary>> = Bits, + + %% Remove all references to the binaries + %% Doing it explicitly like this ensures that + %% the binaries are gone when the parent process + %% receives the 'DOWN' message. + erlang:garbage_collect() + end. + +wait_for_memory_deallocations() -> + try + erts_debug:set_internal_state(wait, deallocations) + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_for_memory_deallocations() + end. + %% OTP-7559: c_p->cp could contain garbage and create a false dependency %% to a module in a process. (Thanks to Richard Carlsson.) false_dependency(Config) when is_list(Config) -> @@ -555,6 +685,30 @@ coverage(Config) when is_list(Config) -> ?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), ok. +fun_confusion(Config) when is_list(Config) -> + Data = ?config(data_dir, Config), + Src = filename:join(Data, "fun_confusion"), + Mod = fun_confusion, + + %% Load first version of module. + compile_load(Mod, Src, 1), + F1 = Mod:f(), + 1 = F1(), + + %% Load second version of module. + compile_load(Mod, Src, 2), + F2 = Mod:f(), + + %% F1 should refer to the old code, not the newly loaded code. + 1 = F1(), + 2 = F2(), + ok. + +compile_load(Mod, Src, Ver) -> + {ok,Mod,Code1} = compile:file(Src, [binary,{d,version,Ver}]), + {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1), + ok. + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> diff --git a/erts/emulator/test/code_SUITE_data/fun_confusion.erl b/erts/emulator/test/code_SUITE_data/fun_confusion.erl new file mode 100644 index 0000000000..16000861df --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/fun_confusion.erl @@ -0,0 +1,31 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(fun_confusion). + +-export([f/0]). + +f() -> + fun() -> version() end. + +version() -> + %% Changing the value returned here should change + %% the identity of the fun in f/0. + ?version. + diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl index 9f99b1a780..d9cb8938db 100644 --- a/erts/emulator/test/code_SUITE_data/literals.erl +++ b/erts/emulator/test/code_SUITE_data/literals.erl @@ -18,7 +18,7 @@ %% -module(literals). --export([a/0,b/0,huge_bignum/0]). +-export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]). a() -> {a,42.0,[7,38877938333399637266518333334747]}. @@ -81,3 +81,22 @@ b() -> huge_bignum() -> 36#9987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR0737376766798779987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987779JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR0737376766798779987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR073737676679877. + +-define(TIMES_FOUR(X), X,X,X,X). +-define(BYTES_256, 0:256,1:256,2:256,3:256, 4:256,5:256,6:256,7:256). +-define(KB_1, ?TIMES_FOUR(?BYTES_256)). +-define(KB_4, ?TIMES_FOUR(?KB_1)). +-define(KB_16, ?TIMES_FOUR(?KB_4)). +-define(KB_64, ?TIMES_FOUR(?KB_16)). +-define(KB_128, ?TIMES_FOUR(?KB_64)). +-define(MB_1, ?TIMES_FOUR(?KB_128)). + +binary() -> + %% Too big to be a heap binary. + <<?MB_1>>. + +unused_binaries() -> + {<<?KB_128>>,<<?BYTES_256>>}. + +bits() -> + {bits,<<42:13,?MB_1>>}. diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 19281f6d58..08308629fe 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -18,7 +18,7 @@ %% -module(distribution_SUITE). --compile(r12). +-compile(r13). %% Tests distribution and the tcp driver. @@ -37,7 +37,7 @@ dist_auto_connect_never/1, dist_auto_connect_once/1, dist_parallel_send/1, atom_roundtrip/1, - atom_roundtrip_r12b/1, + atom_roundtrip_r13b/1, contended_atom_cache_entry/1, bad_dist_structure/1, bad_dist_ext_receive/1, @@ -62,7 +62,7 @@ all() -> link_to_dead_new_node, applied_monitor_node, ref_port_roundtrip, nil_roundtrip, stop_dist, {group, trap_bif}, {group, dist_auto_connect}, - dist_parallel_send, atom_roundtrip, atom_roundtrip_r12b, + dist_parallel_send, atom_roundtrip, atom_roundtrip_r13b, contended_atom_cache_entry, bad_dist_structure, {group, bad_dist_ext}]. groups() -> @@ -1100,17 +1100,17 @@ atom_roundtrip(Config) when is_list(Config) -> ?line stop_node(Node), ?line ok. -atom_roundtrip_r12b(Config) when is_list(Config) -> - case ?t:is_release_available("r12b") of +atom_roundtrip_r13b(Config) when is_list(Config) -> + case ?t:is_release_available("r13b") of true -> ?line AtomData = atom_data(), ?line verify_atom_data(AtomData), - ?line {ok, Node} = start_node(Config, [], "r12b"), + ?line {ok, Node} = start_node(Config, [], "r13b"), ?line do_atom_roundtrip(Node, AtomData), ?line stop_node(Node), ?line ok; false -> - ?line {skip,"No OTP R12B available"} + ?line {skip,"No OTP R13B available"} end. do_atom_roundtrip(Node, AtomData) -> diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index a77ea4f3be..c07dbc5871 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -75,7 +75,9 @@ smp_select/1, driver_select_use/1, thread_mseg_alloc_cache_clean/1, - otp_9302/1]). + otp_9302/1, + thr_free_drv/1, + async_blast/1]). -export([bin_prefix/2]). @@ -143,7 +145,9 @@ all() -> otp_6879, caller, many_events, missing_callbacks, smp_select, driver_select_use, thread_mseg_alloc_cache_clean, - otp_9302]. + otp_9302, + thr_free_drv, + async_blast]. groups() -> [{timer, [], @@ -1792,7 +1796,7 @@ driver_select_use0(Config) -> thread_mseg_alloc_cache_clean(Config) when is_list(Config) -> case {erlang:system_info(threads), - erlang:system_info({allocator,mseg_alloc}), + mseg_inst_info(0), driver_alloc_sbct()} of {_, false, _} -> ?line {skipped, "No mseg_alloc"}; @@ -1804,13 +1808,13 @@ thread_mseg_alloc_cache_clean(Config) when is_list(Config) -> ?line {skipped, "driver_alloc() using too large single block threshold"}; {_, _, 0} -> ?line {skipped, "driver_alloc() using too low single block threshold"}; - {true, MsegAllocInfo, SBCT} -> + {true, _MsegAllocInfo, SBCT} -> ?line DrvName = 'thr_alloc_drv', ?line Path = ?config(data_dir, Config), ?line erl_ddll:start(), ?line ok = load_driver(Path, DrvName), ?line Port = open_port({spawn, DrvName}, []), - ?line CCI = mseg_alloc_cci(MsegAllocInfo), + ?line CCI = 1000, ?line ?t:format("CCI = ~p~n", [CCI]), ?line CCC = mseg_alloc_ccc(), ?line ?t:format("CCC = ~p~n", [CCC]), @@ -1831,7 +1835,7 @@ mseg_alloc_cci(MsegAllocInfo) -> ?line CCI. mseg_alloc_ccc() -> - mseg_alloc_ccc(erlang:system_info({allocator,mseg_alloc})). + mseg_alloc_ccc(mseg_inst_info(0)). mseg_alloc_ccc(MsegAllocInfo) -> ?line {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo), @@ -1841,7 +1845,7 @@ mseg_alloc_ccc(MsegAllocInfo) -> ?line GigaCCC*1000000000 + CCC. mseg_alloc_cached_segments() -> - mseg_alloc_cached_segments(erlang:system_info({allocator,mseg_alloc})). + mseg_alloc_cached_segments(mseg_inst_info(0)). mseg_alloc_cached_segments(MsegAllocInfo) -> MemName = case is_halfword_vm() of @@ -1859,6 +1863,13 @@ mseg_alloc_cached_segments(MsegAllocInfo) -> = lists:keysearch(cached_segments, 1, SL), ?line CS. +mseg_inst_info(I) -> + {value, {instance, I, Value}} + = lists:keysearch(I, + 2, + erlang:system_info({allocator,mseg_alloc})), + Value. + is_halfword_vm() -> case {erlang:system_info({wordsize, internal}), erlang:system_info({wordsize, external})} of @@ -1902,18 +1913,105 @@ otp_9302(Config) when is_list(Config) -> ?line port_command(Port, ""), ?line {msg, block} = get_port_msg(Port, infinity), ?line {msg, job} = get_port_msg(Port, infinity), - ?line case erlang:system_info(thread_pool_size) of - 0 -> - {msg, cancel} = get_port_msg(Port, infinity); - _ -> - ok - end, - ?line {msg, job} = get_port_msg(Port, infinity), + ?line C = case erlang:system_info(thread_pool_size) of + 0 -> + ?line {msg, cancel} = get_port_msg(Port, infinity), + ?line {msg, job} = get_port_msg(Port, infinity), + ?line false; + _ -> + case get_port_msg(Port, infinity) of + {msg, cancel} -> %% Cancel always fail in Rel >= 15 + ?line {msg, job} = get_port_msg(Port, infinity), + ?line false; + {msg, job} -> + ?line ok, + ?line true + end + end, ?line {msg, end_of_jobs} = get_port_msg(Port, infinity), ?line no_msg = get_port_msg(Port, 2000), ?line port_close(Port), + ?line case C of + true -> + ?line {comment, "Async job cancelled"}; + false -> + ?line {comment, "Async job not cancelled"} + end. + +thr_free_drv(Config) when is_list(Config) -> + ?line Path = ?config(data_dir, Config), + ?line erl_ddll:start(), + ?line ok = load_driver(Path, thr_free_drv), + ?line MemBefore = driver_alloc_size(), +% io:format("SID=~p", [erlang:system_info(scheduler_id)]), + ?line Port = open_port({spawn, thr_free_drv}, []), + ?line MemPeek = driver_alloc_size(), + ?line true = is_port(Port), + ?line ok = thr_free_drv_control(Port, 0), + ?line port_close(Port), + ?line MemAfter = driver_alloc_size(), + ?line io:format("MemPeek=~p~n", [MemPeek]), + ?line io:format("MemBefore=~p, MemAfter=~p~n", [MemBefore, MemAfter]), + ?line MemBefore = MemAfter, + ?line case MemPeek of + undefined -> ok; + _ -> + ?line true = MemPeek > MemBefore + end, ?line ok. +thr_free_drv_control(Port, N) -> + case erlang:port_control(Port, 0, "") of + "done" -> + ok; + "more" -> + erlang:yield(), +% io:format("N=~p, SID=~p", [N, erlang:system_info(scheduler_id)]), + thr_free_drv_control(Port, N+1) + end. + +async_blast(Config) when is_list(Config) -> + ?line Path = ?config(data_dir, Config), + ?line erl_ddll:start(), + ?line ok = load_driver(Path, async_blast_drv), + ?line SchedOnln = erlang:system_info(schedulers_online), + ?line MemBefore = driver_alloc_size(), + ?line Start = os:timestamp(), + ?line Blast = fun () -> + Port = open_port({spawn, async_blast_drv}, []), + true = is_port(Port), + port_command(Port, ""), + receive + {Port, done} -> + ok + end, + port_close(Port) + end, + ?line Ps = lists:map(fun (N) -> + spawn_opt(Blast, + [{scheduler, + (N rem SchedOnln)+ 1}, + monitor]) + end, + lists:seq(1, 100)), + ?line MemMid = driver_alloc_size(), + ?line lists:foreach(fun ({Pid, Mon}) -> + receive + {'DOWN',Mon,process,Pid,_} -> ok + end + end, Ps), + ?line End = os:timestamp(), + ?line MemAfter = driver_alloc_size(), + ?line io:format("MemBefore=~p, MemMid=~p, MemAfter=~p~n", + [MemBefore, MemMid, MemAfter]), + ?line AsyncBlastTime = timer:now_diff(End,Start)/1000000, + ?line io:format("AsyncBlastTime=~p~n", [AsyncBlastTime]), + ?line MemBefore = MemAfter, + ?line erlang:display({async_blast_time, AsyncBlastTime}), + ?line ok. + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Utilities %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2077,3 +2175,33 @@ start_node(Config) when is_list(Config) -> stop_node(Node) -> ?t:stop_node(Node). + +wait_deallocations() -> + try + erts_debug:set_internal_state(wait, deallocations) + catch error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_deallocations() + end. + +driver_alloc_size() -> + wait_deallocations(), + case erlang:system_info({allocator_sizes, driver_alloc}) of + false -> + undefined; + MemInfo -> + CS = lists:foldl( + fun ({instance, _, L}, Acc) -> + {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L), + {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), + {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), + [SBMBCS,MBCS,SBCS | Acc] + end, + [], + MemInfo), + lists:foldl( + fun(L, Sz0) -> + {value,{_,Sz,_,_}} = lists:keysearch(blocks_size, 1, L), + Sz0+Sz + end, 0, CS) + end. diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src index 5b3ba1557e..dd48f6a0f7 100644 --- a/erts/emulator/test/driver_SUITE_data/Makefile.src +++ b/erts/emulator/test/driver_SUITE_data/Makefile.src @@ -12,7 +12,9 @@ MISC_DRVS = outputv_drv@dll@ \ many_events_drv@dll@ \ missing_callback_drv@dll@ \ thr_alloc_drv@dll@ \ - otp_9302_drv@dll@ + otp_9302_drv@dll@ \ + thr_free_drv@dll@ \ + async_blast_drv@dll@ SYS_INFO_DRVS = sys_info_1_0_drv@dll@ \ sys_info_1_1_drv@dll@ \ diff --git a/erts/emulator/test/driver_SUITE_data/async_blast_drv.c b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c new file mode 100644 index 0000000000..3821f7e3dc --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c @@ -0,0 +1,124 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#include "erl_driver.h" + +#define NO_ASYNC_JOBS 10000 + +static void stop(ErlDrvData drv_data); +static ErlDrvData start(ErlDrvPort port, + char *command); +static void output(ErlDrvData drv_data, + char *buf, int len); +static void ready_async(ErlDrvData drv_data, + ErlDrvThreadData thread_data); + +static ErlDrvEntry async_blast_drv_entry = { + NULL /* init */, + start, + stop, + output, + NULL /* ready_input */, + NULL /* ready_output */, + "async_blast_drv", + NULL /* finish */, + NULL /* handle */, + NULL /* control */, + NULL /* timeout */, + NULL /* outputv */, + ready_async, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +typedef struct { + ErlDrvPort port; + ErlDrvTermData caller; + int counter; +} async_blast_data_t; + + +DRIVER_INIT(async_blast_drv) +{ + return &async_blast_drv_entry; +} + +static void stop(ErlDrvData drv_data) +{ + driver_free((void *) drv_data); +} + +static ErlDrvData start(ErlDrvPort port, + char *command) +{ + async_blast_data_t *abd; + + abd = driver_alloc(sizeof(async_blast_data_t)); + if (!abd) + return ERL_DRV_ERROR_GENERAL; + + abd->port = port; + abd->counter = 0; + return (ErlDrvData) abd; +} + +static void async_invoke(void *data) +{ + +} +#include <stdio.h> + +static void ready_async(ErlDrvData drv_data, + ErlDrvThreadData thread_data) +{ + async_blast_data_t *abd = (async_blast_data_t *) drv_data; + if (--abd->counter == 0) { + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(abd->port), + ERL_DRV_ATOM, driver_mk_atom("done"), + ERL_DRV_TUPLE, 2 + }; + driver_send_term(abd->port, abd->caller, + spec, sizeof(spec)/sizeof(spec[0])); + } +} + +static void output(ErlDrvData drv_data, + char *buf, int len) +{ + async_blast_data_t *abd = (async_blast_data_t *) drv_data; + if (abd->counter == 0) { + int i; + abd->caller = driver_caller(abd->port); + abd->counter = NO_ASYNC_JOBS; + for (i = 0; i < NO_ASYNC_JOBS; i++) { + if (0 > driver_async(abd->port, NULL, async_invoke, NULL, NULL)) { + driver_failure_atom(abd->port, "driver_async_failed"); + break; + } + } + } +} diff --git a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c new file mode 100644 index 0000000000..622a62ebea --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c @@ -0,0 +1,241 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#include <stdlib.h> +#include <errno.h> +#include <string.h> +#include "erl_driver.h" + +#define BLOCKS_PER_THREAD 100000 +#define NO_THREADS 10 +#define BLOCKS_PER_CTRL 1000 + +typedef struct { + ErlDrvMutex *mtx; + ErlDrvCond *cnd; + int b; + int *go; + int *skip; + void *blocks[BLOCKS_PER_THREAD]; +} test_thread_data; + +typedef struct { + ErlDrvPort port; + int b; + int go; + int skip; + test_thread_data ttd[NO_THREADS+1]; + ErlDrvTid tids[NO_THREADS+1]; +} test_data; + +static ErlDrvData start(ErlDrvPort port, char *command); +static void stop(ErlDrvData data); +static int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); + +static ErlDrvEntry thr_free_drv_entry = { + NULL /* init */, + start, + stop, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + "thr_free_drv", + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(thr_free_drv) +{ + return &thr_free_drv_entry; +} + +void * +test_thread(void *vttd) +{ + test_thread_data *ttd = (test_thread_data *) vttd; + int i, skip; + + erl_drv_mutex_lock(ttd->mtx); + + while (!*ttd->go) + erl_drv_cond_wait(ttd->cnd, ttd->mtx); + skip = *ttd->skip; + erl_drv_mutex_unlock(ttd->mtx); + + if (!skip) { + for (i = 0; i < BLOCKS_PER_THREAD; i++) + driver_free(ttd->blocks[i]); + } + return NULL; +} + +ErlDrvData start(ErlDrvPort port, char *command) +{ + int join = 0, t, b, res; + test_thread_data *ttd; + test_data *td = driver_alloc(sizeof(test_data)); + if (!td) + return ERL_DRV_ERROR_GENERAL; + ttd = td->ttd; + for (b = 0; b < BLOCKS_PER_THREAD; b++) + for (t = 0; t <= NO_THREADS; t++) + ttd[t].blocks[b] = NULL; + ttd[0].mtx = NULL; + ttd[0].cnd = NULL; + + for (b = 0; b < BLOCKS_PER_THREAD; b++) { + for (t = 0; t <= NO_THREADS; t++) { + ttd[t].blocks[b] = driver_alloc(1); + if (ttd[t].blocks[b] == NULL) + goto fail; + } + } + + td->b = -1; + td->go = 0; + td->skip = 0; + + ttd[0].mtx = erl_drv_mutex_create("test_mutex"); + if (!ttd[0].mtx) + goto fail; + ttd[0].cnd = erl_drv_cond_create("test_cnd"); + if (!ttd[0].cnd) + goto fail; + ttd[0].go = &td->go; + ttd[0].skip = &td->skip; + + for (t = 1; t <= NO_THREADS; t++) { + ttd[t].mtx = ttd[0].mtx; + ttd[t].cnd = ttd[0].cnd; + ttd[t].go = ttd[0].go; + ttd[t].skip = ttd[0].skip; + res = erl_drv_thread_create("test_thread", + &td->tids[t], + test_thread, + &ttd[t], + NULL); + if (res != 0) + goto fail; + join = t; + } + + td->port = port; + + return (ErlDrvData) td; + +fail: + + if (join) { + erl_drv_mutex_lock(ttd[0].mtx); + td->go = 1; + td->skip = 1; + erl_drv_cond_broadcast(ttd[0].cnd); + erl_drv_mutex_unlock(ttd[0].mtx); + for (t = 1; t <= join; t++) + erl_drv_thread_join(td->tids[t], NULL); + } + + if (ttd[0].mtx) + erl_drv_mutex_destroy(ttd[0].mtx); + if (ttd[0].cnd) + erl_drv_cond_destroy(ttd[0].cnd); + + for (b = 0; b < BLOCKS_PER_THREAD; b++) { + for (t = 0; t <= NO_THREADS; t++) { + if (ttd[t].blocks[b] != NULL) + driver_free(ttd[t].blocks[b]); + } + } + + return ERL_DRV_ERROR_GENERAL; +} + +static void stop(ErlDrvData drv_data) +{ + test_data *td = (test_data *) drv_data; + int t, b; + for (t = 1; t <= NO_THREADS; t++) + erl_drv_thread_join(td->tids[t], NULL); + for (b = 0; b < BLOCKS_PER_THREAD; b++) { + if (td->ttd[0].blocks[b]) + driver_free(td->ttd[0].blocks[b]); + } + erl_drv_mutex_destroy(td->ttd[0].mtx); + erl_drv_cond_destroy(td->ttd[0].cnd); + driver_free(td); +} + +static int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen) +{ + test_data *td = (test_data *) drv_data; + char *result = "failure"; + int i, b; + int res; + int result_len; + + if (td->b == -1) { + erl_drv_mutex_lock(td->ttd[0].mtx); + td->go = 1; + erl_drv_cond_broadcast(td->ttd[0].cnd); + erl_drv_mutex_unlock(td->ttd[0].mtx); + td->b = 0; + } + + for (i = 0, b = td->b; i < BLOCKS_PER_CTRL && b < BLOCKS_PER_THREAD; i++, b++) { + driver_free(td->ttd[0].blocks[b]); + td->ttd[0].blocks[b] = NULL; + } + + td->b = b; + if (b >= BLOCKS_PER_THREAD) + result = "done"; + else + result = "more"; + + result_len = strlen(result); + if (result_len <= rlen) { + memcpy(*rbuf, result, result_len); + return result_len; + } + else { + *rbuf = driver_alloc(result_len); + if (!*rbuf) { + driver_failure_posix(td->port, ENOMEM); + return 0; + } + else { + memcpy(*rbuf, result, result_len); + return result_len; + } + } +} diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index 9d6fc9521d..109cec25cb 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -23,9 +23,10 @@ init_per_group/2,end_per_group/2, badmatch/1, pending_errors/1, nil_arith/1, stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1, - exception_with_heap_frag/1]). + exception_with_heap_frag/1, line_numbers/1]). -export([bad_guy/2]). +-export([crash/1]). -include_lib("test_server/include/test_server.hrl"). -import(lists, [foreach/2]). @@ -35,7 +36,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [badmatch, pending_errors, nil_arith, stacktrace, nested_stacktrace, raise, gunilla, per, - exception_with_heap_frag]. + exception_with_heap_frag, line_numbers]. groups() -> []. @@ -141,14 +142,20 @@ pending_exit_message(Args, Expected) -> end, process_flag(trap_exit, false). -pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, Func, Args, _Code) - when is_atom(Bif), is_list(BifArgs), length(Args) == Arity -> +pending({badarg,[{erlang,Bif,BifArgs,Loc1}, + {?MODULE,Func,Arity,Loc2}|_]}, + Func, Args, _Code) + when is_atom(Bif), is_list(BifArgs), length(Args) =:= Arity, + is_list(Loc1), is_list(Loc2) -> ok; -pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) -> +pending({undef,[{non_existing_module,foo,[],Loc}|_]}, _, _, _) + when is_list(Loc) -> ok; -pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) -> +pending({function_clause,[{?MODULE,Func,Args,Loc}|_]}, Func, Args, _Code) + when is_list(Loc) -> ok; -pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) when length(Args) == Arity -> +pending({Code,[{?MODULE,Func,Arity,Loc}|_]}, Func, Args, Code) + when length(Args) =:= Arity, is_list(Loc) -> ok; pending(Reason, _Function, _Args, _Code) -> test_server:fail({bad_exit_reason,Reason}). @@ -255,24 +262,24 @@ stacktrace(Conf) when is_list(Conf) -> ?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), ?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, V = [make_ref()|self()], - ?line {value2,{caught1,badarg,[{erlang,abs,[V]}|_]=St1}} = + ?line {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = stacktrace_1({'abs',V}, error, {value,V}), ?line St1 = erase(stacktrace1), ?line St1 = erase(stacktrace2), ?line St1 = erlang:get_stacktrace(), - ?line {caught2,{error,badarith},[{?MODULE,my_add,2}|_]=St2} = + ?line {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), - ?line [{?MODULE,my_div,2}|_] = erase(stacktrace1), + ?line [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), ?line St2 = erase(stacktrace2), ?line St2 = erlang:get_stacktrace(), - ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3}|_]=St3} = + ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = stacktrace_1({value,V}, error, {value,V}), ?line St3 = erase(stacktrace1), ?line St3 = erase(stacktrace2), ?line St3 = erlang:get_stacktrace(), - ?line {caught2,{throw,V},[{?MODULE,foo,1}|_]=St4} = + ?line {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = stacktrace_1({value,V}, error, {throw,V}), - ?line [{?MODULE,stacktrace_1,3}|_] = erase(stacktrace1), + ?line [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), ?line St4 = erase(stacktrace2), ?line St4 = erlang:get_stacktrace(), @@ -280,8 +287,8 @@ stacktrace(Conf) when is_list(Conf) -> ?line stacktrace_2() catch error:{badmatch,_} -> - [{?MODULE,stacktrace_2,0}, - {?MODULE,stacktrace,1}|_] = + [{?MODULE,stacktrace_2,0,_}, + {?MODULE,stacktrace,1,_}|_] = erlang:get_stacktrace(), ok end. @@ -315,15 +322,15 @@ nested_stacktrace(Conf) when is_list(Conf) -> nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, {void,void,void}), ?line {caught1, - [{?MODULE,my_add,2}|_], + [{?MODULE,my_add,2,_}|_], value2, - [{?MODULE,my_add,2}|_]} = + [{?MODULE,my_add,2,_}|_]} = nested_stacktrace_1({{'add',{V,x1}},error,badarith}, {{value,{V,x2}},void,{V,x2}}), ?line {caught1, - [{?MODULE,my_add,2}|_], - {caught2,[{erlang,abs,[V]}|_]}, - [{erlang,abs,[V]}|_]} = + [{?MODULE,my_add,2,_}|_], + {caught2,[{erlang,abs,[V],_}|_]}, + [{erlang,abs,[V],_}|_]} = nested_stacktrace_1({{'add',{V,x1}},error,badarith}, {{'abs',V},error,badarg}), ok. @@ -362,14 +369,14 @@ raise(Conf) when is_list(Conf) -> end, ?line A = erlang:get_stacktrace(), ?line A = get(raise), - ?line [{?MODULE,my_div,2}|_] = A, + ?line [{?MODULE,my_div,2,_}|_] = A, %% N = 8, % Must be even ?line N = erlang:system_flag(backtrace_depth, N), + ?line B = odd_even(N, []), ?line try even(N) catch error:function_clause -> ok end, - ?line B = odd_even(N, []), ?line B = erlang:get_stacktrace(), %% ?line C0 = odd_even(N+1, []), @@ -387,19 +394,12 @@ raise(Conf) when is_list(Conf) -> odd_even(N, R) when is_integer(N), N > 1 -> odd_even(N-1, [if (N rem 2) == 0 -> - {?MODULE,even,1}; + {?MODULE,even,1,[{file,"odd_even.erl"},{line,3}]}; true -> - {?MODULE,odd,1} + {?MODULE,odd,1,[{file,"odd_even.erl"},{line,6}]} end|R]); odd_even(1, R) -> - [{?MODULE,odd,[1]}|R]. - -even(N) when is_integer(N), N > 1, (N rem 2) == 0 -> - odd(N-1)++[N]. - -odd(N) when is_integer(N), N > 1, (N rem 2) == 1 -> - even(N-1)++[N]. - + [{?MODULE,odd,[1],[{file,"odd_even.erl"},{line,5}]}|R]. foo({value,Value}) -> Value; foo({'div',{A,B}}) -> @@ -526,4 +526,186 @@ do_exception_with_heap_frag(Bin, [Sz|Sizes]) -> do_exception_with_heap_frag(Bin, Sizes); do_exception_with_heap_frag(_, []) -> ok. +line_numbers(Config) when is_list(Config) -> + {'EXIT',{{case_clause,bad_tag}, + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,3}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(bad_tag, 0)), + {'EXIT',{badarith, + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,5}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, not_an_integer)), + {'EXIT',{{badmatch,{ok,1}}, + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,7}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 0)), + {'EXIT',{crash, + [{?MODULE,crash,1, + [{file,"fake_file.erl"},{line,14}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 41)), + + ModFile = ?MODULE_STRING++".erl", + [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, + {?MODULE,call1,0,[{file,"call.erl"},{line,14}]}, + {?MODULE,close_calls,1,[{file,"call.erl"},{line,5}]}, + {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = + close_calls(call1), + [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, + {?MODULE,call2,0,[{file,"call.erl"},{line,18}]}, + {?MODULE,close_calls,1,[{file,"call.erl"},{line,6}]}, + {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = + close_calls(call2), + [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, + {?MODULE,call3,0,[{file,"call.erl"},{line,22}]}, + {?MODULE,close_calls,1,[{file,"call.erl"},{line,7}]}, + {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = + close_calls(call3), + no_crash = close_calls(other), + + <<0,0>> = build_binary1(16), + {'EXIT',{badarg, + [{?MODULE,build_binary1,1, + [{file,"bit_syntax.erl"},{line,72503}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary1(bad_size)), + + <<7,1,2,3>> = build_binary2(8, <<1,2,3>>), + {'EXIT',{badarg, + [{?MODULE,build_binary2,2, + [{file,"bit_syntax.erl"},{line,72507}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(bad_size, <<>>)), + {'EXIT',{badarg, + [{erlang,bit_size,[bad_binary],[]}, + {?MODULE,build_binary2,2, + [{file,"bit_syntax.erl"},{line,72507}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(8, bad_binary)), + + {'EXIT',{function_clause, + [{?MODULE,do_call_abs,[y,y], + [{file,"gc_bif.erl"},{line,18}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(y, y)), + {'EXIT',{badarg, + [{erlang,abs,[[]],[]}, + {?MODULE,do_call_abs,2, + [{file,"gc_bif.erl"},{line,19}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(x, [])), + + {'EXIT',{{badmatch,"42"}, + [{MODULE,applied_bif_1,1,[{file,"applied_bif.erl"},{line,5}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch applied_bif_1(42)), + + {'EXIT',{{badmatch,{current_location, + {?MODULE,applied_bif_2,0, + [{file,"applied_bif.erl"},{line,9}]}}}, + [{MODULE,applied_bif_2,0,[{file,"applied_bif.erl"},{line,10}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch applied_bif_2()), + + ok. + id(I) -> I. + +-file("odd_even.erl", 1). %Line 1 +even(N) when is_integer(N), N > 1, (N rem 2) == 0 -> + odd(N-1)++[N]. %Line 3 + +odd(N) when is_integer(N), N > 1, (N rem 2) == 1 -> + even(N-1)++[N]. %Line 6 + +%% +%% If the compiler removes redundant line instructions (any +%% line instruction with the same location as the previous), +%% and the loader also removes line instructions before +%% tail-recursive calls to external functions, then the +%% badmatch exception in line 7 below will be reported as +%% occurring in line 6. +%% +%% That means that any removal of redundant line instructions +%% must all be done in the compiler OR in the loader. +%% +-file("fake_file.erl", 1). %Line 1 +line1(Tag, X) -> %Line 2 + case Tag of %Line 3 + a -> + Y = X + 1, %Line 5 + Res = id({ok,Y}), %Line 6 + ?MODULE:crash({ok,42} = Res); %Line 7 + b -> + x = id(x), %Line 9 + ok %Line 10 + end. %Line 11 + +crash(_) -> %Line 13 + erlang:error(crash). %Line 14 + +-file("call.erl", 1). %Line 1 +close_calls(Where) -> %Line 2 + put(where_to_crash, Where), %Line 3 + try + call1(), %Line 5 + call2(), %Line 6 + call3(), %Line 7 + no_crash %Line 8 + catch error:crash -> + erlang:get_stacktrace() %Line 10 + end. %Line 11 + +call1() -> %Line 13 + maybe_crash(call1), %Line 14 + ok. %Line 15 + +call2() -> %Line 17 + maybe_crash(call2), %Line 18 + ok. %Line 19 + +call3() -> %Line 21 + maybe_crash(call3), %Line 22 + ok. %Line 23 + +maybe_crash(Name) -> %Line 25 + case get(where_to_crash) of %Line 26 + Name -> + erlang:error(crash); %Line 28 + _ -> + ok %Line 30 + end. + +-file("bit_syntax.erl", 72500). %Line 72500 +build_binary1(Size) -> %Line 72501 + id(42), %Line 72502 + <<0:Size>>. %Line 72503 + +build_binary2(Size, Bin) -> %Line 72505 + id(0), %Line 72506 + <<7:Size,Bin/binary>>. %Line 72507 + +-file("gc_bif.erl", 17). +do_call_abs(x, Arg) -> %Line 18 + abs(Arg). %Line 19 + +%% Make sure a BIF that is applied does not leave the p->cp +%% set (and thus generating an extra entry on the stack). + +-file("applied_bif.erl", 1). +%% Explicit apply. +applied_bif_1(I) -> %Line 3 + L = apply(erlang, integer_to_list, [I]), %Line 4 + fail = L, %Line 5 + ok. %Line 6 +%% Implicit apply. +applied_bif_2() -> %Line 8 + R = process_info(self(), current_location), %Line 9 + fail = R, %Line 10 + ok. %Line 11 diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index 736510339f..8e6923ce9f 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -25,8 +25,9 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, - bad_float_unpack/1]). + bad_float_unpack/1,cmp_zero/1, cmp_integer/1, cmp_bignum/1]). -export([otp_7178/1]). +-export([hidden_inf/1]). init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> @@ -41,10 +42,12 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized, - match, bad_float_unpack]. + match, bad_float_unpack, {group, comparison} + ,hidden_inf + ]. groups() -> - []. + [{comparison, [parallel], [cmp_zero, cmp_integer, cmp_bignum]}]. init_per_suite(Config) -> Config. @@ -187,6 +190,101 @@ bad_float_unpack(Config) when is_list(Config) -> bad_float_unpack_match(<<F:64/float>>) -> F; bad_float_unpack_match(<<I:64/integer-signed>>) -> I. +cmp_zero(_Config) -> + cmp(0.5e-323,0). + +cmp_integer(_Config) -> + Axis = (1 bsl 53)-2.0, %% The point where floating points become unprecise + span_cmp(Axis,2,200), + cmp(Axis*Axis,round(Axis)). + +cmp_bignum(_Config) -> + span_cmp((1 bsl 58) - 1.0),%% Smallest bignum float + + %% Test when the big num goes from I to I+1 in size + [span_cmp((1 bsl (32*I)) - 1.0) || I <- lists:seq(2,30)], + + %% Test bignum greater then largest float + cmp((1 bsl (64*16)) - 1, (1 bsl (64*15)) * 1.0), + %% Test when num is much larger then float + [cmp((1 bsl (32*I)) - 1, (1 bsl (32*(I-2))) * 1.0) || I <- lists:seq(3,30)], + %% Test when float is much larger than num + [cmp((1 bsl (64*15)) * 1.0, (1 bsl (32*(I)))) || I <- lists:seq(1,29)], + + %% Test that all int == float works as they should + [true = 1 bsl N == (1 bsl N)*1.0 || N <- lists:seq(0, 1023)], + [true = (1 bsl N)*-1 == (1 bsl N)*-1.0 || N <- lists:seq(0, 1023)]. + +span_cmp(Axis) -> + span_cmp(Axis, 25). +span_cmp(Axis, Length) -> + span_cmp(Axis, round(Axis) bsr 52, Length). +span_cmp(Axis, Incr, Length) -> + [span_cmp(Axis, Incr, Length, 1 bsl (1 bsl I)) || I <- lists:seq(0,6)]. +%% This function creates tests around number axis. Both <, > and == is tested +%% for both negative and positive numbers. +%% +%% Axis: The number around which to do the tests eg. (1 bsl 58) - 1.0 +%% Incr: How much to increment the test numbers inbetween each test. +%% Length: Length/2 is the number of Incr away from Axis to test on the +%% negative and positive plane. +%% Diff: How much the float and int should differ when comparing +span_cmp(Axis, Incr, Length, Diff) -> + [begin + cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), + cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr) + end || I <- lists:seq((Length div 2)*-1,(Length div 2))], + [begin + cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr), + cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr) + end || I <- lists:seq((Length div 2)*-1,(Length div 2))]. + +cmp(Big,Small) when is_float(Big) -> + BigGtSmall = lists:flatten( + io_lib:format("~f > ~p",[Big,Small])), + BigLtSmall = lists:flatten( + io_lib:format("~f < ~p",[Big,Small])), + BigEqSmall = lists:flatten( + io_lib:format("~f == ~p",[Big,Small])), + SmallGtBig = lists:flatten( + io_lib:format("~p > ~f",[Small,Big])), + SmallLtBig = lists:flatten( + io_lib:format("~p < ~f",[Small,Big])), + SmallEqBig = lists:flatten( + io_lib:format("~p == ~f",[Small,Big])), + cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall); +cmp(Big,Small) when is_float(Small) -> + BigGtSmall = lists:flatten( + io_lib:format("~p > ~f",[Big,Small])), + BigLtSmall = lists:flatten( + io_lib:format("~p < ~f",[Big,Small])), + BigEqSmall = lists:flatten( + io_lib:format("~p == ~f",[Big,Small])), + SmallGtBig = lists:flatten( + io_lib:format("~f > ~p",[Small,Big])), + SmallLtBig = lists:flatten( + io_lib:format("~f < ~p",[Small,Big])), + SmallEqBig = lists:flatten( + io_lib:format("~f == ~p",[Small,Big])), + cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall). + +cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall) -> + {_,_,_,true} = {Big,Small,BigGtSmall, + Big > Small}, + {_,_,_,false} = {Big,Small,BigLtSmall, + Big < Small}, + {_,_,_,false} = {Big,Small,SmallGtBig, + Small > Big}, + {_,_,_,true} = {Big,Small,SmallLtBig, + Small < Big}, + {_,_,_,false} = {Big,Small,SmallEqBig, + Small == Big}, + {_,_,_,false} = {Big,Small,BigEqSmall, + Big == Small}. + id(I) -> I. start_node(Config) when is_list(Config) -> @@ -205,3 +303,25 @@ start_node(Config) when is_list(Config) -> stop_node(Node) -> ?t:stop_node(Node). + + +%% Test that operations that might hide infinite intermediate results +%% do not supress the badarith. +hidden_inf(Config) when is_list(Config) -> + ZeroP = 0.0, + ZeroN = id(ZeroP) * (-1), + [hidden_inf_1(A, B, Z, 9.23e307) + || A <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], + B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], + Z <- [ZeroP, ZeroN]], + ok. + +hidden_inf_1(A, B, Zero, Huge) -> + {'EXIT',{badarith,_}} = (catch (B / (A / Zero))), + {'EXIT',{badarith,_}} = (catch (B * (A / Zero))), + {'EXIT',{badarith,_}} = (catch (B / (Huge * Huge))), + {'EXIT',{badarith,_}} = (catch (B * (Huge * Huge))), + {'EXIT',{badarith,_}} = (catch (B / (Huge + Huge))), + {'EXIT',{badarith,_}} = (catch (B * (Huge + Huge))), + {'EXIT',{badarith,_}} = (catch (B / (-Huge - Huge))), + {'EXIT',{badarith,_}} = (catch (B * (-Huge - Huge))). diff --git a/erts/emulator/test/fun_r12_SUITE.erl b/erts/emulator/test/fun_r13_SUITE.erl index 3b1dfc9825..76ddf9fec9 100644 --- a/erts/emulator/test/fun_r12_SUITE.erl +++ b/erts/emulator/test/fun_r13_SUITE.erl @@ -17,10 +17,10 @@ %% %CopyrightEnd% %% --module(fun_r12_SUITE). --compile(r12). +-module(fun_r13_SUITE). +-compile(r13). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2,dist_old_release/1]). @@ -29,10 +29,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [dist_old_release]. -groups() -> +groups() -> []. init_per_suite(Config) -> diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl index f41324c2cc..a5df9b59a0 100644 --- a/erts/emulator/test/guard_SUITE.erl +++ b/erts/emulator/test/guard_SUITE.erl @@ -421,7 +421,7 @@ try_gbif(Id, X, Y) -> try_fail_gbif(Id, X, Y) -> case catch guard_bif(Id, X, Y) of - {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} -> + {'EXIT',{function_clause,[{?MODULE,guard_bif,[Id,X,Y],_}|_]}} -> io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); Other -> ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", @@ -493,9 +493,9 @@ type_tests(Test, [Type|T], Allowed) -> end; false -> case catch type_test(Test, Value) of - {'EXIT', {function_clause, {?MODULE,type_test,[Test,Value]}}} -> - ok; - {'EXIT', {function_clause,[{?MODULE,type_test,[Test,Value]}|_]}} -> + {'EXIT',{function_clause, + [{?MODULE,type_test,[Test,Value],Loc}|_]}} + when is_list(Loc) -> ok; {'EXIT',Other} -> ?line test_server:fail({unexpected_error_reason,Other}); diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl index e0a7878bd8..879d2f61dd 100644 --- a/erts/emulator/test/mtx_SUITE.erl +++ b/erts/emulator/test/mtx_SUITE.erl @@ -62,16 +62,29 @@ init_per_suite(Config) when is_list(Config) -> Config. end_per_suite(Config) when is_list(Config) -> + catch erts_debug:set_internal_state(available_internal_state, false), Config. init_per_testcase(_Case, Config) -> Dog = ?t:timetrap(?t:minutes(15)), + %% Wait for deallocations to complete since we measure + %% runtime in test cases. + wait_deallocations(), [{watchdog, Dog}|Config]. end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog). +wait_deallocations() -> + try + erts_debug:set_internal_state(wait, deallocations) + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_deallocations() + end. + suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index f6344791f1..370363bf9e 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -35,7 +35,9 @@ resource_takeover/1, threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, is_checks/1, - get_length/1, make_atom/1, make_string/1]). + get_length/1, make_atom/1, make_string/1, reverse_list_test/1, + otp_9668/1 + ]). -export([many_args_100/100]). @@ -60,7 +62,9 @@ all() -> iolist_as_binary, resource, resource_binary, resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks, get_length, make_atom, - make_string]. + make_string,reverse_list_test, + otp_9668 + ]. groups() -> []. @@ -1165,7 +1169,28 @@ is_checks(Config) when is_list(Config) -> ?line ensure_lib_loaded(Config, 1), ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], - {hejsan, "hejsan", [$h,"ejs",<<"an">>]}), + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 12), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -12), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551617), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551617), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 99.146), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -99.146), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551616.2e2), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2), try ?line error = check_is_exception(), ?line throw(expected_badarg) @@ -1208,6 +1233,27 @@ make_string(Config) when is_list(Config) -> AStringWithAccents = [$E,$r,$l,$a,$n,$g,$ ,16#e4,$r,$ ,$e,$t,$t,$ ,$g,$e,$n,$e,$r,$e,$l,$l,$t,$ ,$p,$r,$o,$g,$r,$a,$m,$s,$p,$r,16#e5,$k], ?line Strings = {A0String,A0String,A0String,A0String0, AStringWithAccents}. +reverse_list_test(Config) -> + ?line ensure_lib_loaded(Config, 1), + List = lists:seq(1,100), + RevList = lists:reverse(List), + ?line RevList = reverse_list(List), + ?line badarg = reverse_list(foo). + +otp_9668(doc) -> ["Memory leak of tmp-buffer when inspecting iolist or unaligned binary in unbound environment"]; +otp_9668(Config) -> + ensure_lib_loaded(Config, 1), + TmpMem = tmpmem(), + IOList = ["This",' ',<<"is">>,' ',[<<"an iolist">>,'.']], + otp_9668_nif(IOList), + + <<_:5/bitstring,UnalignedBin:10/binary,_/bitstring>> = <<"Abuse me as unaligned">>, + otp_9668_nif(UnalignedBin), + + ?line verify_tmpmem(TmpMem), + ok. + + tmpmem() -> case erlang:system_info({allocator,temp_alloc}) of false -> undefined; @@ -1296,7 +1342,7 @@ get_resource(_,_) -> ?nif_stub. release_resource(_) -> ?nif_stub. last_resource_dtor_call() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. -check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. +check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. check_is_exception() -> ?nif_stub. length_test(_,_,_,_,_) -> ?nif_stub. make_atoms() -> ?nif_stub. @@ -1314,8 +1360,10 @@ send_blob_thread(_,_,_) -> ?nif_stub. join_send_thread(_) -> ?nif_stub. copy_blob(_) -> ?nif_stub. send_term(_,_) -> ?nif_stub. +reverse_list(_) -> ?nif_stub. echo_int(_) -> ?nif_stub. type_sizes() -> ?nif_stub. +otp_9668_nif(_) -> ?nif_stub. nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 92f1bab8dd..7d7903af25 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -832,6 +832,7 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER * argv[7] an empty list * argv[8] a non-empty list * argv[9] a tuple + * argv[10] a number (small, big integer or float) */ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -848,6 +849,7 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] if (!enif_is_list(env, argv[7])) return enif_make_badarg(env); if (!enif_is_list(env, argv[8])) return enif_make_badarg(env); if (!enif_is_tuple(env, argv[9])) return enif_make_badarg(env); + if (!enif_is_number(env, argv[10])) return enif_make_badarg(env); return ok_atom; } @@ -1421,6 +1423,34 @@ static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ return enif_make_int(env, ret); } +static ERL_NIF_TERM reverse_list(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM rev_list; + + if(!enif_make_reverse_list(env, argv[0], &rev_list)) + return enif_make_atom(env, "badarg"); + return rev_list; +} + +static ERL_NIF_TERM otp_9668_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + /* Inspect in process independent env */ + ErlNifEnv* myenv = enif_alloc_env(); + ERL_NIF_TERM mycopy = enif_make_copy(myenv, argv[0]); + ErlNifBinary obin, cbin; + + if ((enif_inspect_binary(env, argv[0], &obin) + && enif_inspect_binary(myenv, mycopy, &cbin)) + || + (enif_inspect_iolist_as_binary(env, argv[0], &obin) + && enif_inspect_iolist_as_binary(myenv, mycopy, &cbin))) + { + assert(obin.size == cbin.size); + assert(memcmp(obin.data, cbin.data, obin.size) == 0); + } + enif_free_env(myenv); + return atom_ok; +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -1447,7 +1477,7 @@ static ErlNifFunc nif_funcs[] = {"release_resource", 1, release_resource}, {"last_resource_dtor_call", 0, last_resource_dtor_call}, {"make_new_resource", 2, make_new_resource}, - {"check_is", 10, check_is}, + {"check_is", 11, check_is}, {"check_is_exception", 0, check_is_exception}, {"length_test", 5, length_test}, {"make_atoms", 0, make_atoms}, @@ -1466,8 +1496,10 @@ static ErlNifFunc nif_funcs[] = {"join_send_thread", 1, join_send_thread}, {"copy_blob", 1, copy_blob}, {"send_term", 2, send_term}, + {"reverse_list",1, reverse_list}, {"echo_int", 1, echo_int}, - {"type_sizes", 0, type_sizes} + {"type_sizes", 0, type_sizes}, + {"otp_9668_nif", 1, otp_9668_nif} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index f68e712268..fdc55a4cc5 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -35,7 +35,7 @@ self_exit/1, normal_suicide_exit/1, abnormal_suicide_exit/1, t_exit_2_catch/1, trap_exit_badarg/1, trap_exit_badarg_in_bif/1, exit_and_timeout/1, exit_twice/1, - t_process_info/1, process_info_other_msg/1, + t_process_info/1, process_info_other/1, process_info_other_msg/1, process_info_other_dist_msg/1, process_info_2_list/1, process_info_lock_reschedule/1, process_info_lock_reschedule2/1, @@ -64,7 +64,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [spawn_with_binaries, t_exit_1, {group, t_exit_2}, trap_exit_badarg, trap_exit_badarg_in_bif, - t_process_info, process_info_other_msg, + t_process_info, process_info_other, process_info_other_msg, process_info_other_dist_msg, process_info_2_list, process_info_lock_reschedule, process_info_lock_reschedule2, @@ -258,7 +258,9 @@ trap_exit_badarg() -> ?line Pid = fun_spawn(fun() -> bad_guy(kb_128()) end), ?line Garbage = kb_128(), ?line receive - {'EXIT', Pid, {badarg,[{erlang,abs,[Garbage]},{?MODULE,bad_guy,1}|_]}} -> + {'EXIT',Pid,{badarg,[{erlang,abs,[Garbage],Loc1}, + {?MODULE,bad_guy,1,Loc2}|_]}} + when is_list(Loc1), is_list(Loc2) -> ok; Other -> ?line ok = io:format("Bad EXIT message: ~P", [Other, 30]), @@ -410,7 +412,7 @@ etwice_high(Low) -> exit(Low, first), exit(Low, second). -%% Tests the process_info/1 BIF. +%% Tests the process_info/2 BIF. t_process_info(Config) when is_list(Config) -> ?line [] = process_info(self(), registered_name), ?line register(my_name, self()), @@ -418,13 +420,100 @@ t_process_info(Config) when is_list(Config) -> ?line {status, running} = process_info(self(), status), ?line {min_heap_size, 233} = process_info(self(), min_heap_size), ?line {min_bin_vheap_size, 46368} = process_info(self(), min_bin_vheap_size), - ?line {current_function, {?MODULE, t_process_info, 1}} = + ?line {current_function,{?MODULE,t_process_info,1}} = process_info(self(), current_function), + ?line {current_function,{?MODULE,t_process_info,1}} = + apply(erlang, process_info, [self(),current_function]), + + %% current_location and current_stacktrace + {Line1,Res1} = {?LINE,process_info(self(), current_location)}, + verify_loc(Line1, Res1), + {Line2,Res2} = {?LINE,apply(erlang, process_info, + [self(),current_location])}, + verify_loc(Line2, Res2), + pi_stacktrace([{?MODULE,t_process_info,1,?LINE}]), + ?line Gleader = group_leader(), ?line {group_leader, Gleader} = process_info(self(), group_leader), ?line {'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')), ok. +pi_stacktrace(Expected0) -> + {Line,Res} = {?LINE,erlang:process_info(self(), current_stacktrace)}, + {current_stacktrace,Stack} = Res, + Expected = [{?MODULE,pi_stacktrace,1,Line}|Expected0], + pi_stacktrace_1(Stack, Expected). + +pi_stacktrace_1([{M,F,A,Loc}|Stk], [{M,F,A,Line}|Exp]) -> + case Loc of + [] -> + %% No location info for some reason (+L, native code). + io:format("Missing location information for ~w:~w/~w", + [M,F,A]), + ok; + [_|_] -> + Line = proplists:get_value(line, Loc), + File = proplists:get_value(file, Loc), + File = ?MODULE_STRING ++ ".erl" + end, + pi_stacktrace_1(Stk, Exp); +pi_stacktrace_1([_|_], []) -> ok. + +verify_loc(Line, {current_location,{?MODULE,t_process_info=F,1=A,Loc}}) -> + case Loc of + [] -> + %% No location info for some reason (+L, native code). + io:format("Missing location information for ~w:~w/~w", + [?MODULE,F,A]), + ok; + [_|_] -> + Line = proplists:get_value(line, Loc), + File = proplists:get_value(file, Loc), + File = ?MODULE_STRING ++ ".erl" + end. + +process_info_other(Config) when is_list(Config) -> + Self = self(), + Pid = spawn_link(fun() -> process_info_looper(Self) end), + receive after 1 -> ok end, + pio_current_location(10000, Pid, 0, 0), + pio_current_stacktrace(). + +pio_current_location(0, _, Pi, Looper) -> + io:format("~w call(s) to erlang:process_info/2", [Pi]), + io:format("~w call(s) to ~w:process_info_looper/1", [Looper,?MODULE]); +pio_current_location(N, Pid, Pi, Looper) -> + erlang:yield(), + {current_location,Where} = process_info(Pid, current_location), + case Where of + {erlang,process_info,2,[]} -> + pio_current_location(N-1, Pid, Pi+1, Looper); + {?MODULE,process_info_looper,1,Loc} when is_list(Loc) -> + pio_current_location(N-1, Pid, Pi, Looper+1) + end. + +pio_current_stacktrace() -> + L = [begin + {current_stacktrace,Stk} = process_info(P, current_stacktrace), + {P,Stk} + end || P <- processes()], + [erlang:garbage_collect(P) || {P,_} <- L], + erlang:garbage_collect(), + [verify_stacktrace(Stk) || {_,Stk} <- L], + ok. + +verify_stacktrace([{M,F,A,Loc}|T]) + when is_atom(M), + is_atom(F), + is_integer(A), + is_list(Loc) -> + verify_stacktrace(T); +verify_stacktrace([]) -> ok. + +process_info_looper(Parent) -> + process_info(Parent, current_location), + process_info_looper(Parent). + %% Tests the process_info/1 BIF on another process with messages. process_info_other_msg(Config) when is_list(Config) -> Self = self(), diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index 9b782b35a2..0350eb671d 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -37,7 +37,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2, end_per_testcase/2]). --export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1]). +-export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1, memory/1]). -define(DEFAULT_TIMEOUT, ?t:minutes(2)). @@ -45,7 +45,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [process_count, system_version, misc_smoke_tests, - heap_size, wordsize]. + heap_size, wordsize, memory]. groups() -> []. @@ -187,3 +187,312 @@ wordsize(Config) when is_list(Config) -> Other -> exit({unexpected_wordsizes,Other}) end. + +memory(doc) -> ["Verify that erlang:memory/0 and memory results in crashdump produce are similar"]; +memory(Config) when is_list(Config) -> + %% + %% Verify that erlang:memory/0 and memory results in + %% crashdump produce are similar. + %% + %% erlang:memory/0 requests information from each scheduler + %% thread and puts the information together in erlang code + %% (erlang.erl). + %% + %% When a crash dump is written we cannot use the + %% erlang:memory/0 implementation. The crashdump implementation + %% is a pure C implementation inspecting all allocator instances + %% after the system has been blocked (erts_memory() in erl_alloc.c). + %% + %% Since we got two implementations, modifications can easily + %% cause them to produce different results. + %% + %% erts_debug:get_internal_state(memory) blocks the system and + %% execute the same code as the crash dump writing uses. + %% + + erts_debug:set_internal_state(available_internal_state, true), + %% Use a large heap size on the controling process in + %% order to avoid changes in its heap size during + %% comparisons. + MinHeapSize = process_flag(min_heap_size, 1024*1024), + Prio = process_flag(priority, max), + try + erlang:memory(), %% first call will init stat atoms + garbage_collect(), %% blow up heap + memory_test(Config) + catch + error:notsup -> {skipped, "erlang:memory() not supported"} + after + process_flag(min_heap_size, MinHeapSize), + process_flag(priority, Prio), + catch erts_debug:set_internal_state(available_internal_state, false) + end. + +memory_test(_Config) -> + + MWs = spawn_mem_workers(), + + DPs = mem_workers_call(MWs, + fun () -> + mapn(fun (_) -> + spawn(fun () -> + receive + after infinity -> + ok + end + end) + end, + 1000 div erlang:system_info(schedulers_online)) + end, + []), + cmp_memory(MWs, "spawn procs"), + + Ps = lists:flatten(DPs), + + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (P) -> link(P) end, Ps) + end, + []), + cmp_memory(MWs, "link procs"), + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (P) -> unlink(P) end, Ps) + end, + []), + cmp_memory(MWs, "unlink procs"), + + DMs = mem_workers_call(MWs, + fun () -> + lists:map(fun (P) -> + monitor(process, P) + end, Ps) + end, + []), + cmp_memory(MWs, "monitor procs"), + Ms = lists:flatten(DMs), + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (M) -> + demonitor(M) + end, Ms) + end, + []), + cmp_memory(MWs, "demonitor procs"), + + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (P) -> + P ! {a, "message", make_ref()} + end, Ps) + end, + []), + cmp_memory(MWs, "message procs"), + + mem_workers_call(MWs, + fun () -> + Mons = lists:map(fun (P) -> + exit(P, kill), + monitor(process, P) + end, + Ps), + lists:foreach(fun (Mon) -> + receive + {'DOWN', Mon, _, _, _} -> ok + end + end, + Mons) + end, []), + cmp_memory(MWs, "kill procs"), + + mem_workers_call(MWs, + fun () -> + put(binary_data, + mapn(fun (_) -> list_to_binary(lists:duplicate(256,$?)) end, 100)) + end, + []), + + cmp_memory(MWs, "store binary data"), + + mem_workers_call(MWs, + fun () -> + put(binary_data, false), + garbage_collect() + end, + []), + cmp_memory(MWs, "release binary data"), + + mem_workers_call(MWs, + fun () -> + list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), + list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), + list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))) + end, + []), + cmp_memory(MWs, "new atoms"), + + + mem_workers_call(MWs, + fun () -> + T = ets:new(?MODULE, []), + ets:insert(T, {gurka, lists:seq(1,10000)}), + ets:insert(T, {banan, lists:seq(1,1024)}), + ets:insert(T, {appelsin, make_ref()}), + put(ets_id, T) + end, + []), + cmp_memory(MWs, "store ets data"), + + mem_workers_call(MWs, + fun () -> + ets:delete(get(ets_id)), + put(ets_id, false) + end, + []), + cmp_memory(MWs, "remove ets data"), + + lists:foreach(fun (MW) -> + unlink(MW), + Mon = monitor(process, MW), + exit(MW, kill), + receive + {'DOWN', Mon, _, _, _} -> ok + end + end, + MWs), + ok. + +mem_worker() -> + receive + {call, From, Fun, Args} -> + From ! {reply, self(), apply(Fun, Args)}, + mem_worker(); + {cast, _From, Fun, Args} -> + apply(Fun, Args), + mem_worker() + end. + +mem_workers_call(MWs, Fun, Args) -> + lists:foreach(fun (MW) -> + MW ! {call, self(), Fun, Args} + end, + MWs), + lists:map(fun (MW) -> + receive + {reply, MW, Res} -> + Res + end + end, + MWs). + +mem_workers_cast(MWs, Fun, Args) -> + lists:foreach(fun (MW) -> + MW ! {cast, self(), Fun, Args} + end, + MWs). + +spawn_mem_workers() -> + spawn_mem_workers(erlang:system_info(schedulers_online)). + +spawn_mem_workers(0) -> + []; +spawn_mem_workers(N) -> + [spawn_opt(fun () -> mem_worker() end, + [{scheduler, N rem erlang:system_info(schedulers_online) + 1}, + link]) | spawn_mem_workers(N-1)]. + + + +mem_get(X, Mem) -> + case lists:keyfind(X, 1, Mem) of + {X, Val} -> Val; + false -> false + end. + +cmp_memory(What, Mem1, Mem2, 1) -> + R1 = mem_get(What, Mem1), + R2 = mem_get(What, Mem2), + true = R1 == R2; +cmp_memory(What, Mem1, Mem2, RelDiff) -> + %% We allow RealDiff diff + R1 = mem_get(What, Mem1), + R2 = mem_get(What, Mem2), + case R1 == R2 of + true -> + ok; + false -> + case R1 > R2 of + true -> + true = R2*RelDiff > R1; + false -> + true = R1*RelDiff > R2 + end + end. + +pos_int(Val) when Val >= 0 -> + Val; +pos_int(Val) -> + exit({not_pos_int, Val}). + +check_sane_memory(Mem) -> + Tot = pos_int(mem_get(total, Mem)), + Proc = pos_int(mem_get(processes, Mem)), + ProcUsed = pos_int(mem_get(processes_used, Mem)), + Sys = pos_int(mem_get(system, Mem)), + Atom = pos_int(mem_get(atom, Mem)), + AtomUsed = pos_int(mem_get(atom_used, Mem)), + Bin = pos_int(mem_get(binary, Mem)), + Code = pos_int(mem_get(code, Mem)), + Ets = pos_int(mem_get(ets, Mem)), + + Tot = Proc + Sys, + true = Sys > Atom + Bin + Code + Ets, + true = Proc >= ProcUsed, + true = Atom >= AtomUsed, + + case mem_get(maximum, Mem) of + false -> ok; + Max -> true = pos_int(Max) >= Tot + end, + ok. + +cmp_memory(MWs, Str) -> + erlang:display(Str), + lists:foreach(fun (MW) -> garbage_collect(MW) end, MWs), + garbage_collect(), + erts_debug:set_internal_state(wait, deallocations), + + EDM = erts_debug:get_internal_state(memory), + EM = erlang:memory(), + + io:format("~s:~n" + "erlang:memory() = ~p~n" + "crash dump memory = ~p~n", + [Str, EM, EDM]), + + ?line check_sane_memory(EM), + ?line check_sane_memory(EDM), + + %% We expect these to always give us exactly the same result + + ?line cmp_memory(atom, EM, EDM, 1), + ?line cmp_memory(atom_used, EM, EDM, 1), + ?line cmp_memory(binary, EM, EDM, 1), + ?line cmp_memory(code, EM, EDM, 1), + ?line cmp_memory(ets, EM, EDM, 1), + + %% Total, processes, processes_used, and system will seldom + %% give us exactly the same result since the two readings + %% aren't taken atomically. + + ?line cmp_memory(total, EM, EDM, 1.05), + ?line cmp_memory(processes, EM, EDM, 1.05), + ?line cmp_memory(processes_used, EM, EDM, 1.05), + ?line cmp_memory(system, EM, EDM, 1.05), + + ok. + +mapn(_Fun, 0) -> + []; +mapn(Fun, N) -> + [Fun(N) | mapn(Fun, N-1)]. diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl index 091e960610..32e2a98e3c 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -767,8 +767,8 @@ exception_test(Opts, Func0, Args0) -> end, ?line R1 = exc_slave(ExcOpts, Func, Args), - ?line Stack2 = [{?MODULE,exc_top,3},{?MODULE,slave,2}], - ?line Stack3 = [{?MODULE,exc,2}|Stack2], + ?line Stack2 = [{?MODULE,exc_top,3,[]},{?MODULE,slave,2,[]}], + ?line Stack3 = [{?MODULE,exc,2,[]}|Stack2], ?line Rs = case x_exc_top(ExcOpts, Func, Args) of % Emulation {crash,{Reason,Stack}}=R when is_list(Stack) -> @@ -789,21 +789,29 @@ exception_test(Opts, Func0, Args0) -> end, ?line expect({nm}). -exception_validate(R1, [R2|Rs]) -> +exception_validate(R0, Rs0) -> + R = clean_location(R0), + Rs = [clean_location(E) || E <- Rs0], + exception_validate_1(R, Rs). + +exception_validate_1(R1, [R2|Rs]) -> case [R1|R2] of [R|R] -> ok; - [{crash,{badarg,[{lists,reverse,[L1a,L1b]}|T]}}| - {crash,{badarg,[{lists,reverse,[L2a,L2b]}|T]}}] -> + [{crash,{badarg,[{lists,reverse,[L1a,L1b],_}|T]}}| + {crash,{badarg,[{lists,reverse,[L2a,L2b],_}|T]}}] -> same({crash,{badarg,[{lists,reverse, - [lists:reverse(L1b, L1a),[]]}|T]}}, + [lists:reverse(L1b, L1a),[]],[]}|T]}}, {crash,{badarg,[{lists,reverse, - [lists:reverse(L2b, L2a),[]]}|T]}}); + [lists:reverse(L2b, L2a),[]],[]}|T]}}); _ when is_list(Rs), Rs =/= [] -> exception_validate(R1, Rs) end. - +clean_location({crash,{Reason,Stk0}}) -> + Stk = [{M,F,A,[]} || {M,F,A,_} <- Stk0], + {crash,{Reason,Stk}}; +clean_location(Term) -> Term. %%% Tracee target functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% @@ -1057,10 +1065,10 @@ x_exc_exception(_Rtt, M, F, _, Arity, CR) -> x_exc_stacktrace() -> x_exc_stacktrace(erlang:get_stacktrace()). %% Truncate stacktrace to below exc/2 -x_exc_stacktrace([{?MODULE,x_exc,4}|_]) -> []; -x_exc_stacktrace([{?MODULE,x_exc_func,4}|_]) -> []; -x_exc_stacktrace([{?MODULE,x_exc_body,4}|_]) -> []; -x_exc_stacktrace([{?MODULE,exc,2}|_]) -> []; +x_exc_stacktrace([{?MODULE,x_exc,4,_}|_]) -> []; +x_exc_stacktrace([{?MODULE,x_exc_func,4,_}|_]) -> []; +x_exc_stacktrace([{?MODULE,x_exc_body,4,_}|_]) -> []; +x_exc_stacktrace([{?MODULE,exc,2,_}|_]) -> []; x_exc_stacktrace([H|T]) -> [H|x_exc_stacktrace(T)]. |