diff options
Diffstat (limited to 'erts/emulator/test')
44 files changed, 4912 insertions, 539 deletions
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 478555a902..fb56d72691 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -87,6 +87,7 @@ MODULES= \ gc_SUITE \ guard_SUITE \ hash_SUITE \ + hash_property_test_SUITE \ hibernate_SUITE \ hipe_SUITE \ iovec_SUITE \ @@ -148,6 +149,7 @@ MODULES= \ dgawd_handler \ random_iolist \ erts_test_utils \ + erts_test_destructor \ crypto_reference \ literal_area_collector_test @@ -247,7 +249,7 @@ release_tests_spec: make_emakefile $(INSTALL_DATA) $(NO_OPT_ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(NATIVE_ERL_FILES) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" - tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + tar cf - *_SUITE_data property_test | (cd "$(RELSYSDIR)"; tar xf -) release_docs_spec: diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 4e0243c1cd..24677247a7 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -302,45 +302,52 @@ wait_for_memory_deallocations() -> end. print_stats(migration) -> - IFun = fun({instance,Inr,Istats}, {Bacc,Cacc,Pacc}) -> - {mbcs,MBCS} = lists:keyfind(mbcs, 1, Istats), - Btup = lists:keyfind(blocks, 1, MBCS), - Ctup = lists:keyfind(carriers, 1, MBCS), - - Ptup = case lists:keyfind(mbcs_pool, 1, Istats) of - {mbcs_pool,POOL} -> - {blocks, Bpool} = lists:keyfind(blocks, 1, POOL), - {carriers, Cpool} = lists:keyfind(carriers, 1, POOL), - {pool, Bpool, Cpool}; - false -> - {pool, 0, 0} - end, - io:format("{instance,~p,~p,~p,~p}}\n", - [Inr, Btup, Ctup, Ptup]), - {tuple_add(Bacc,Btup),tuple_add(Cacc,Ctup), - tuple_add(Pacc,Ptup)}; - (_, Acc) -> Acc + IFun = fun({instance,_,Stats}, {Regular0, Pooled0}) -> + {mbcs,MBCS} = lists:keyfind(mbcs, 1, Stats), + {sbcs,SBCS} = lists:keyfind(sbcs, 1, Stats), + + Regular = MBCS ++ SBCS ++ Regular0, + case lists:keyfind(mbcs_pool, 1, Stats) of + {mbcs_pool,Pool} -> {Regular, Pool ++ Pooled0}; + false -> {Regular, Pooled0} + end; + (_, Acc) -> + Acc end, - {Btot,Ctot,Ptot} = lists:foldl(IFun, - {{blocks,0,0,0},{carriers,0,0,0},{pool,0,0}}, - erlang:system_info({allocator,test_alloc})), - - {pool, PBtot, PCtot} = Ptot, - io:format("Number of blocks : ~p\n", [Btot]), - io:format("Number of carriers: ~p\n", [Ctot]), - io:format("Number of pooled blocks : ~p\n", [PBtot]), - io:format("Number of pooled carriers: ~p\n", [PCtot]); -print_stats(_) -> ok. - -tuple_add(T1, T2) -> - list_to_tuple(lists:zipwith(fun(E1,E2) when is_number(E1), is_number(E2) -> - E1 + E2; - (A,A) -> - A - end, - tuple_to_list(T1), tuple_to_list(T2))). + Stats = erlang:system_info({allocator,test_alloc}), + {Regular, Pooled} = lists:foldl(IFun, {[], []}, Stats), + {RegBlocks, RegCarriers} = summarize_alloc_stats(Regular, {0, 0}), + {PooledBlocks, PooledCarriers} = summarize_alloc_stats(Pooled, {0, 0}), + + io:format("Number of blocks : ~p\n", [RegBlocks]), + io:format("Number of carriers: ~p\n", [RegCarriers]), + io:format("Number of pooled blocks : ~p\n", [PooledBlocks]), + io:format("Number of pooled carriers: ~p\n", [PooledCarriers]); +print_stats(_) -> + ok. + +summarize_alloc_stats([{blocks,L} | Rest], {Blocks0, Carriers}) -> + Blocks = count_blocks([S || {_Type, S} <- L], Blocks0), + summarize_alloc_stats(Rest, {Blocks, Carriers}); +summarize_alloc_stats([{carriers, Count, _, _} | Rest], {Blocks, Carriers0}) -> + summarize_alloc_stats(Rest, {Blocks, Carriers0 + Count}); +summarize_alloc_stats([{carriers, Count} | Rest], {Blocks, Carriers0}) -> + summarize_alloc_stats(Rest, {Blocks, Carriers0 + Count}); +summarize_alloc_stats([_ | Rest], Acc) -> + summarize_alloc_stats(Rest, Acc); +summarize_alloc_stats([], Acc) -> + Acc. + +count_blocks([{count, Count, _, _} | Rest], Acc) -> + count_blocks(Rest, Acc + Count); +count_blocks([{count, Count} | Rest], Acc) -> + count_blocks(Rest, Acc + Count); +count_blocks([_ | Rest], Acc) -> + count_blocks(Rest, Acc); +count_blocks([], Acc) -> + Acc. one_shot(CaseName) -> State = CaseName:start({1, 0, erlang:system_info(build_type)}), diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index d3b3b96b14..b1f1e115ac 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -132,7 +132,8 @@ packed_registers(Config) when is_list(Config) -> "_ = id(2),\n" "id([_@Vars,_@NewVars,_@MoreNewVars]).\n" "id(I) -> I.\n"]), - merl:compile_and_load(Code), + + merl:compile_and_load(Code, []), %% Optionally print the generated code. PrintCode = false, %Change to true to print code. diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index c5abd04e07..1904ffdf93 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -29,8 +29,8 @@ shadow_comments/1,list_to_utf8_atom/1, specs/1,improper_bif_stubs/1,auto_imports/1, t_list_to_existing_atom/1,os_env/1,otp_7526/1, - binary_to_atom/1,binary_to_existing_atom/1, - atom_to_binary/1,min_max/1, erlang_halt/1, + t_binary_to_atom/1,t_binary_to_existing_atom/1, + t_atom_to_binary/1,min_max/1, erlang_halt/1, erl_crash_dump_bytes/1, is_builtin/1, error_stacktrace/1, error_stacktrace_during_call_trace/1, @@ -50,7 +50,7 @@ all() -> specs, improper_bif_stubs, auto_imports, t_list_to_existing_atom, os_env, otp_7526, display, display_string, list_to_utf8_atom, - atom_to_binary, binary_to_atom, binary_to_existing_atom, + t_atom_to_binary, t_binary_to_atom, t_binary_to_existing_atom, erl_crash_dump_bytes, min_max, erlang_halt, is_builtin, error_stacktrace, error_stacktrace_during_call_trace, group_leader_prio, group_leader_prio_dirty, @@ -496,7 +496,7 @@ test_7526(N) -> -define(BADARG(E), {'EXIT',{badarg,_}} = (catch E)). -define(SYS_LIMIT(E), {'EXIT',{system_limit,_}} = (catch E)). -binary_to_atom(Config) when is_list(Config) -> +t_binary_to_atom(Config) when is_list(Config) -> HalfLong = lists:seq(0, 127), HalfLongAtom = list_to_atom(HalfLong), HalfLongBin = list_to_binary(HalfLong), @@ -524,8 +524,10 @@ binary_to_atom(Config) when is_list(Config) -> test_binary_to_atom(<<C/utf8>>, utf8) end], - <<"こんにちは"/utf8>> = - atom_to_binary(test_binary_to_atom(<<"こんにちは"/utf8>>, utf8), utf8), + ExoticBin = <<"こんにちは"/utf8>>, + ExoticAtom = test_binary_to_atom(ExoticBin, utf8), + ExoticBin = atom_to_binary(ExoticAtom, utf8), + ExoticBin = atom_to_binary(ExoticAtom), %% badarg failures. fail_binary_to_atom(atom), @@ -543,6 +545,7 @@ binary_to_atom(Config) when is_list(Config) -> %% Bad UTF8 sequences. ?BADARG(binary_to_atom(id(<<255>>), utf8)), + ?BADARG(binary_to_atom(id(<<255>>))), ?BADARG(binary_to_atom(id(<<255,0>>), utf8)), ?BADARG(binary_to_atom(id(<<16#C0,16#80>>), utf8)), %Overlong 0. <<B:1/binary, _/binary>> = id(<<194, 163>>), %Truncated character ERL-474 @@ -550,6 +553,7 @@ binary_to_atom(Config) when is_list(Config) -> %% system_limit failures. ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)), + ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>))), ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255,0>>), utf8)), ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, latin1)), ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, latin1)), @@ -562,6 +566,14 @@ binary_to_atom(Config) when is_list(Config) -> test_binary_to_atom(Bin0, Encoding) -> Res = binary_to_atom(Bin0, Encoding), Res = binary_to_existing_atom(Bin0, Encoding), + if + Encoding =:= utf8; + Encoding =:= unicode -> + Res = binary_to_atom(Bin0), + Res = binary_to_existing_atom(Bin0); + true -> + ok + end, Bin1 = id(<<7:3,Bin0/binary,32:5>>), Sz = byte_size(Bin0), <<_:3,UnalignedBin:Sz/binary,_:5>> = Bin1, @@ -581,6 +593,12 @@ fail_binary_to_atom(Bin) -> ok end, try + binary_to_atom(Bin) + catch + error:badarg -> + ok + end, + try binary_to_existing_atom(Bin, latin1) catch error:badarg -> @@ -591,10 +609,16 @@ fail_binary_to_atom(Bin) -> catch error:badarg -> ok + end, + try + binary_to_existing_atom(Bin) + catch + error:badarg -> + ok end. -binary_to_existing_atom(Config) when is_list(Config) -> +t_binary_to_existing_atom(Config) when is_list(Config) -> UnlikelyBin = <<"ou0897979655678dsfj923874390867er869fds973qerueoru">>, try binary_to_existing_atom(UnlikelyBin, latin1), @@ -609,6 +633,12 @@ binary_to_existing_atom(Config) when is_list(Config) -> catch error:badarg -> ok end, + try + binary_to_existing_atom(UnlikelyBin), + ct:fail(atom_exists) + catch + error:badarg -> ok + end, UnlikelyAtom = binary_to_atom(id(UnlikelyBin), latin1), UnlikelyAtom = binary_to_existing_atom(UnlikelyBin, latin1), @@ -625,7 +655,7 @@ binary_to_existing_atom(Config) when is_list(Config) -> ok. -atom_to_binary(Config) when is_list(Config) -> +t_atom_to_binary(Config) when is_list(Config) -> HalfLong = lists:seq(0, 127), HalfLongAtom = list_to_atom(HalfLong), HalfLongBin = list_to_binary(HalfLong), @@ -641,12 +671,15 @@ atom_to_binary(Config) when is_list(Config) -> LongBin = atom_to_binary(LongAtom, latin1), %% utf8. + <<>> = atom_to_binary(''), <<>> = atom_to_binary('', utf8), <<>> = atom_to_binary('', unicode), <<127>> = atom_to_binary('\177', utf8), <<"abcdef">> = atom_to_binary(abcdef, utf8), HalfLongBin = atom_to_binary(HalfLongAtom, utf8), + HalfLongBin = atom_to_binary(HalfLongAtom), LongAtomBin = atom_to_binary(LongAtom, utf8), + LongAtomBin = atom_to_binary(LongAtom), verify_long_atom_bin(LongAtomBin, 0), %% Failing cases. @@ -678,8 +711,15 @@ fail_atom_to_binary(Term) -> catch error:badarg -> ok + end, + try + atom_to_binary(Term) + catch + error:badarg -> + ok end. + min_max(Config) when is_list(Config) -> a = erlang:min(id(a), a), a = erlang:min(id(a), b), @@ -860,6 +900,7 @@ error_stacktrace_test() -> Types = [apply_const_last, apply_const, apply_last, apply, double_apply_const_last, double_apply_const, double_apply_last, double_apply, multi_apply_const_last, + apply_const_only, apply_only, multi_apply_const, multi_apply_last, multi_apply, call_const_last, call_last, call_const, call], lists:foreach(fun (Type) -> @@ -896,12 +937,18 @@ error_stacktrace_test() -> Types), ok. -stk([], Type, Func) -> - tail(Type, Func, jump), - ok; stk([_|L], Type, Func) -> stk(L, Type, Func), - ok. + %% Force the compiler to keep this body-recursive. We want the stack trace + %% to have one entry here and another in the base case to test that + %% multiple frames in the same function aren't removed unless they're + %% identical. + id(ok); +stk([], Type, Func) -> + put(erlang, erlang), + put(tail, []), + tail(Type, Func, jump), + id(ok). tail(Type, Func, jump) -> tail(Type, Func, do); @@ -910,6 +957,12 @@ tail(Type, error_1, do) -> tail(Type, error_2, do) -> do_error_2(Type). +do_error_2(apply_const_only) -> + apply(erlang, error, [oops, [apply_const_only]]); +do_error_2(apply_only) -> + Erlang = get(erlang), + Tail = get(tail), + apply(Erlang, error, [oops, [apply_only|Tail]]); do_error_2(apply_const_last) -> erlang:apply(erlang, error, [oops, [apply_const_last]]); do_error_2(apply_const) -> @@ -951,6 +1004,12 @@ do_error_2(call) -> erlang:error(id(oops), id([call])). +do_error_1(apply_const_only) -> + apply(erlang, error, [oops]); +do_error_1(apply_only) -> + Erlang = get(erlang), + Tail = get(tail), + apply(Erlang, error, [oops|Tail]); do_error_1(apply_const_last) -> erlang:apply(erlang, error, [oops]); do_error_1(apply_const) -> diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index cc4cbaad0e..6227148614 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -73,7 +73,8 @@ robustness/1,otp_8117/1, otp_8180/1, trapping/1, large/1, error_after_yield/1, cmp_old_impl/1, - t2b_system_limit/1]). + t2b_system_limit/1, + term_to_iovec/1]). %% Internal exports. -export([sleeper/0,trapping_loop/4]). @@ -92,8 +93,8 @@ all() -> b2t_used_big, bad_binary_to_term_2, safe_binary_to_term2, bad_binary_to_term, bad_terms, t_hash, bad_size, - sub_bin_copy, - bad_term_to_binary, t2b_system_limit, more_bad_terms, + sub_bin_copy, bad_term_to_binary, t2b_system_limit, + term_to_iovec, more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep, @@ -456,6 +457,7 @@ bad_term_to_binary(Config) when is_list(Config) -> T = id({a,b,c}), {'EXIT',{badarg,_}} = (catch term_to_binary(T, not_a_list)), {'EXIT',{badarg,_}} = (catch term_to_binary(T, [blurf])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [iovec])), {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,-1}])), {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,10}])), {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,cucumber}])), @@ -473,7 +475,8 @@ t2b_system_limit(Config) when is_list(Config) -> memsup:get_system_memory_data()) of Memory when is_integer(Memory), Memory > 6*1024*1024*1024 -> - test_t2b_system_limit(), + test_t2b_system_limit(term_to_binary, fun erlang:term_to_binary/1, fun erlang:term_to_binary/2), + test_t2b_system_limit(term_to_iovec, fun erlang:term_to_iovec/1, fun erlang:term_to_iovec/2), garbage_collect(), ok; _ -> @@ -483,37 +486,81 @@ t2b_system_limit(Config) when is_list(Config) -> {skipped, "Only interesting on 64-bit builds"} end. -test_t2b_system_limit() -> +test_t2b_system_limit(Name, F1, F2) -> io:format("Creating HugeBin~n", []), Bits = ((1 bsl 32)+1)*8, HugeBin = <<0:Bits>>, - io:format("Testing term_to_binary(HugeBin)~n", []), - {'EXIT',{system_limit,[{erlang,term_to_binary, + io:format("Testing ~p(HugeBin)~n", [Name]), + {'EXIT',{system_limit,[{erlang,Name, [HugeBin], - _} |_]}} = (catch term_to_binary(HugeBin)), + _} |_]}} = (catch F1(HugeBin)), - io:format("Testing term_to_binary(HugeBin, [compressed])~n", []), - {'EXIT',{system_limit,[{erlang,term_to_binary, + io:format("Testing ~p(HugeBin, [compressed])~n", [Name]), + {'EXIT',{system_limit,[{erlang,Name, [HugeBin, [compressed]], - _} |_]}} = (catch term_to_binary(HugeBin, [compressed])), + _} |_]}} = (catch F2(HugeBin, [compressed])), %% Check that it works also after we have trapped... io:format("Creating HugeListBin~n", []), HugeListBin = [lists:duplicate(2000000,2000000), HugeBin], - io:format("Testing term_to_binary(HugeListBin)~n", []), - {'EXIT',{system_limit,[{erlang,term_to_binary, + io:format("Testing ~p(HugeListBin)~n", [Name]), + {'EXIT',{system_limit,[{erlang,Name, [HugeListBin], - _} |_]}} = (catch term_to_binary(HugeListBin)), + _} |_]}} = (catch F1(HugeListBin)), - io:format("Testing term_to_binary(HugeListBin, [compressed])~n", []), - {'EXIT',{system_limit,[{erlang,term_to_binary, + io:format("Testing ~p(HugeListBin, [compressed])~n", [Name]), + {'EXIT',{system_limit,[{erlang,Name, [HugeListBin, [compressed]], - _} |_]}} = (catch term_to_binary(HugeListBin, [compressed])), + _} |_]}} = (catch F2(HugeListBin, [compressed])), ok. +term_to_iovec(Config) when is_list(Config) -> + Bin = list_to_binary(lists:duplicate(1000,100)), + Bin2 = list_to_binary(lists:duplicate(65,100)), + check_term_to_iovec({[Bin, atom, Bin, 1244, make_ref(), Bin]}), + check_term_to_iovec(Bin), + check_term_to_iovec([Bin,Bin,Bin,Bin]), + check_term_to_iovec(blipp), + check_term_to_iovec(lists:duplicate(1000,100)), + check_term_to_iovec([[Bin2]]), + check_term_to_iovec([erlang:ports(), Bin, erlang:processes()]), + ok. + +check_term_to_iovec(Term) -> + IoVec1 = erlang:term_to_iovec(Term), + ok = check_is_iovec(IoVec1), + IoVec2 = erlang:term_to_iovec(Term, []), + ok = check_is_iovec(IoVec2), + B = erlang:term_to_binary(Term), + IoVec1Bin = erlang:iolist_to_binary(IoVec1), + IoVec2Bin = erlang:iolist_to_binary(IoVec2), + try + B = IoVec1Bin + catch + _:_ -> + io:format("Binary: ~p~n", [B]), + io:format("I/O vec1 binary: ~p~n", [IoVec1Bin]), + io:format("I/O vec1: ~p~n", [IoVec1]), + ct:fail(not_same_result) + end, + try + B = IoVec2Bin + catch + _:_ -> + io:format("Binary: ~p~n", [B]), + io:format("I/O vec2 binary: ~p~n", [IoVec2Bin]), + io:format("I/O vec2: ~p~n", [IoVec2]), + ct:fail(not_same_result) + end. + +check_is_iovec([]) -> + ok; +check_is_iovec([B|Bs]) when is_binary(B) -> + check_is_iovec(Bs). + %% Tests binary_to_term/1 and term_to_binary/1. terms(Config) when is_list(Config) -> @@ -1862,9 +1909,16 @@ huge_iolist(X, Sz, Lim) -> huge_iolist([X, X], Sz*2, Lim). cmp_node(Node, {M, F, A}) -> - Res = rpc:call(Node, M, F, A), + ResN = rpc:call(Node, M, F, A), Res = apply(M, F, A), - ok. + case ResN =:= Res of + true -> + ok; + false -> + io:format("~p: ~p~n~p: ~p~n", + [Node, ResN, node(), Res]), + ct:fail(different_results) + end. make_sub_binary(Bin) when is_binary(Bin) -> {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 742592f88e..477b0f5bb3 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -832,21 +832,27 @@ deep_exception() -> R1 -> ct:fail({returned,abbr(R1)}) catch error:badarg -> ok end, - expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}, Traps) when is_list(L1), is_list(L2), S == Self -> - next; + %% Each trapping call to reverse/2 must have a corresponding + %% exception_from + {next, Traps + 1}; ({trace,S,exception_from, - {lists,reverse,2},{error,badarg}}) + {lists,reverse,2},{error,badarg}}, Traps) + when S == Self, Traps > 1 -> + {next, Traps - 1}; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}, 1) when S == Self -> expected; - ('_') -> + ('_', _Traps) -> {trace,Self,exception_from, {lists,reverse,2},{error,badarg}}; - (_) -> + (_, _Traps) -> {unexpected, {trace,Self,exception_from, {lists,reverse,2},{error,badarg}}} - end), + end, 0), deep_exception(?LINE, deep_5, [1,2], 7, [{trace,Self,call,{erlang,error,[undef]}}, {trace,Self,exception_from,{erlang,error,1}, @@ -896,21 +902,27 @@ deep_exception() -> R2 -> ct:fail({returned,abbr(R2)}) catch error:badarg -> ok end, - expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}, Traps) when is_list(L1), is_list(L2), S == Self -> - next; + %% Each trapping call to reverse/2 must have a corresponding + %% exception_from + {next, Traps + 1}; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}, Traps) + when S == Self, Traps > 1 -> + {next, Traps - 1}; ({trace,S,exception_from, - {lists,reverse,2},{error,badarg}}) + {lists,reverse,2},{error,badarg}}, 1) when S == Self -> expected; - ('_') -> + ('_', _Traps) -> {trace,Self,exception_from, {lists,reverse,2},{error,badarg}}; - (_) -> + (_, _Traps) -> {unexpected, {trace,Self,exception_from, {lists,reverse,2},{error,badarg}}} - end), + end, 0), deep_exception(?LINE, apply, [?MODULE,deep_5,[1,2]], 7, [{trace,Self,call,{erlang,error,[undef]}}, {trace,Self,exception_from,{erlang,error,1}, @@ -975,21 +987,27 @@ deep_exception() -> R3 -> ct:fail({returned,abbr(R3)}) catch error:badarg -> ok end, - expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}, Traps) when is_list(L1), is_list(L2), S == Self -> - next; + %% Each trapping call to reverse/2 must have a corresponding + %% exception_from + {next, Traps + 1}; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}, Traps) + when S == Self, Traps > 1 -> + {next, Traps - 1}; ({trace,S,exception_from, - {lists,reverse,2},{error,badarg}}) + {lists,reverse,2},{error,badarg}}, 1) when S == Self -> expected; - ('_') -> + ('_', _Traps) -> {trace,Self,exception_from, {lists,reverse,2},{error,badarg}}; - (_) -> + (_, _Traps) -> {unexpected, {trace,Self,exception_from, {lists,reverse,2},{error,badarg}}} - end), + end, 0), deep_exception(?LINE, apply, [fun () -> ?MODULE:deep_5(1,2) end, []], 7, [{trace,Self,call,{erlang,error,[undef]}}, @@ -1249,6 +1267,24 @@ expect(Message) -> ct:fail(no_trace_message) end. +expect(Validator, State0) when is_function(Validator) -> + receive + M -> + case Validator(M, State0) of + expected -> + ok = io:format("Expected and got ~p", [abbr(M)]); + {next, State} -> + ok = io:format("Expected and got ~p", [abbr(M)]), + expect(Validator, State); + {unexpected,Message} -> + io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), + ct:fail({unexpected,abbr([M|flush()])}) + end + after 5000 -> + io:format("Expected ~p; got nothing", [abbr(Validator('_'))]), + ct:fail(no_trace_message) + end. + trace_info(What, Key) -> get(tracer) ! {apply,self(),{erlang,trace_info,[What,Key]}}, Res = receive diff --git a/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl b/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl index 699f0c1161..b08cd5e654 100644 --- a/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl +++ b/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl @@ -8,8 +8,7 @@ do(Priv, Data, Type, Opts) -> try do_it(Priv, Data, Type, Opts) catch - C:E -> - ST = erlang:get_stacktrace(), + C:E:ST -> io:format("Caught exception from line ~p:\n~p\n", [get(the_line), ST]), io:format("Message queue: ~p\n", [process_info(self(), messages)]), diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index ef13b515fb..099dfabcb6 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -301,8 +301,8 @@ http(Config) when is_list(Config) -> StrA = list_to_atom(Str), StrB = list_to_binary(Str), Bin = <<StrB/binary,": ",ValB/binary,"\r\n",Rest/binary>>, - {ok, {http_header,N,StrA,undefined,Val}, Rest} = decode_pkt(httph,Bin), - {ok, {http_header,N,StrA,undefined,ValB}, Rest} = decode_pkt(httph_bin,Bin), + {ok, {http_header,N,StrA,Str,Val}, Rest} = decode_pkt(httph,Bin), + {ok, {http_header,N,StrA,StrB,ValB}, Rest} = decode_pkt(httph_bin,Bin), N + 1 end, lists:foldl(HdrF, 1, http_hdr_strings()), @@ -330,6 +330,15 @@ http(Config) when is_list(Config) -> %% Response with empty phrase {ok,{http_response,{1,1},200,[]},<<>>} = decode_pkt(http, <<"HTTP/1.1 200\r\n">>, []), {ok,{http_response,{1,1},200,<<>>},<<>>} = decode_pkt(http_bin, <<"HTTP/1.1 200\r\n">>, []), + + + %% Test error cases + {ok,{http_error,"Host\t: localhost:8000\r\n"},<<"a">>} = + decode_pkt(httph, <<"Host\t: localhost:8000\r\na">>, []), + {ok,{http_error,"Host : localhost:8000\r\n"},<<"a">>} = + decode_pkt(httph, <<"Host : localhost:8000\r\na">>, []), + {ok,{http_error," : localhost:8000\r\n"},<<"a">>} = + decode_pkt(httph, <<" : localhost:8000\r\na">>, []), ok. http_with_bin(http) -> @@ -364,31 +373,40 @@ http_request(Msg) -> {http_request, 'POST', {abs_path, "/invalid/url" }, {1,1}}, {http_request, 'POST', {abs_path,<<"/invalid/url">>}, {1,1}}}, {"Connection: close\r\n", - {http_header,2,'Connection',undefined, "close"}, - {http_header,2,'Connection',undefined,<<"close">>}}, - {"Host\t : localhost:8000\r\n", % white space before : - {http_header,14,'Host',undefined, "localhost:8000"}, - {http_header,14,'Host',undefined,<<"localhost:8000">>}}, + {http_header,2,'Connection', "Connection" , "close"}, + {http_header,2,'Connection',<<"Connection">>,<<"close">>}}, {"User-Agent: perl post\r\n", - {http_header,24,'User-Agent',undefined, "perl post"}, - {http_header,24,'User-Agent',undefined,<<"perl post">>}}, + {http_header,24,'User-Agent', "User-Agent" , "perl post"}, + {http_header,24,'User-Agent',<<"User-Agent">>,<<"perl post">>}}, {"Content-Length: 4\r\n", - {http_header,38,'Content-Length',undefined, "4"}, - {http_header,38,'Content-Length',undefined,<<"4">>}}, + {http_header,38,'Content-Length', "Content-Length" , "4"}, + {http_header,38,'Content-Length',<<"Content-Length">>,<<"4">>}}, {"Content-Type: text/xml; charset=utf-8\r\n", - {http_header,42,'Content-Type',undefined, "text/xml; charset=utf-8"}, - {http_header,42,'Content-Type',undefined,<<"text/xml; charset=utf-8">>}}, + {http_header,42,'Content-Type', "Content-Type" , "text/xml; charset=utf-8"}, + {http_header,42,'Content-Type',<<"Content-Type">>,<<"text/xml; charset=utf-8">>}}, {"Other-Field: with some text\r\n", - {http_header,0, "Other-Field" ,undefined, "with some text"}, - {http_header,0,<<"Other-Field">>,undefined,<<"with some text">>}}, + {http_header,0, "Other-Field" , "Other-Field" , "with some text"}, + {http_header,0,<<"Other-Field">>,<<"Other-Field">>,<<"with some text">>}}, + {"Content--Type: text/xml; charset=utf-8\r\n", + {http_header,0, "Content--type" , "Content--Type" , "text/xml; charset=utf-8"}, + {http_header,0,<<"Content--type">>,<<"Content--Type">>,<<"text/xml; charset=utf-8">>}}, + {"Content---Type: text/xml; charset=utf-8\r\n", + {http_header,0, "Content---Type" , "Content---Type" , "text/xml; charset=utf-8"}, + {http_header,0,<<"Content---Type">>,<<"Content---Type">>,<<"text/xml; charset=utf-8">>}}, + {"CONTENT-type: text/xml; charset=utf-8\r\n", + {http_header,42,'Content-Type', "CONTENT-type" , "text/xml; charset=utf-8"}, + {http_header,42,'Content-Type',<<"CONTENT-type">>,<<"text/xml; charset=utf-8">>}}, + {"OTHER-field: with some text\r\n", + {http_header,0, "Other-Field" , "OTHER-field" , "with some text"}, + {http_header,0,<<"Other-Field">>,<<"OTHER-field">>,<<"with some text">>}}, {"Make-sure-a-LONG-HEaDer-fIeLd-is-fORMATTED-NicelY: with some text\r\n", - {http_header,0, "Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely" ,undefined, "with some text"}, - {http_header,0,<<"Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely">>,undefined,<<"with some text">>}}, + {http_header,0, "Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely" , "Make-sure-a-LONG-HEaDer-fIeLd-is-fORMATTED-NicelY" , "with some text"}, + {http_header,0,<<"Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely">>,<<"Make-sure-a-LONG-HEaDer-fIeLd-is-fORMATTED-NicelY">>,<<"with some text">>}}, {"Multi-Line: Once upon a time in a land far far away,\r\n" " there lived a princess imprisoned in the highest tower\r\n" " of the most haunted castle.\r\n", - {http_header,0, "Multi-Line" ,undefined, "Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle."}, - {http_header,0,<<"Multi-Line">>,undefined,<<"Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle.">>}}, + {http_header,0, "Multi-Line" , "Multi-Line" , "Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle."}, + {http_header,0,<<"Multi-Line">>,<<"Multi-Line">>,<<"Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle.">>}}, {"\r\n", http_eoh, http_eoh}], @@ -404,17 +422,17 @@ http_response(Msg) -> {http_response, {1,0}, 404, "Object Not Found"}, {http_response, {1,0}, 404, <<"Object Not Found">>}}, {"Server: inets/4.7.16\r\n", - {http_header, 30, 'Server', undefined, "inets/4.7.16"}, - {http_header, 30, 'Server', undefined, <<"inets/4.7.16">>}}, + {http_header, 30, 'Server', "Server" , "inets/4.7.16"}, + {http_header, 30, 'Server', <<"Server">>, <<"inets/4.7.16">>}}, {"Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n", - {http_header, 3, 'Date', undefined, "Fri, 04 Jul 2008 17:16:22 GMT"}, - {http_header, 3, 'Date', undefined, <<"Fri, 04 Jul 2008 17:16:22 GMT">>}}, + {http_header, 3, 'Date', "Date" , "Fri, 04 Jul 2008 17:16:22 GMT"}, + {http_header, 3, 'Date', <<"Date">>, <<"Fri, 04 Jul 2008 17:16:22 GMT">>}}, {"Content-Type: text/html\r\n", - {http_header, 42, 'Content-Type', undefined, "text/html"}, - {http_header, 42, 'Content-Type', undefined, <<"text/html">>}}, + {http_header, 42, 'Content-Type', "Content-Type" , "text/html"}, + {http_header, 42, 'Content-Type', <<"Content-Type">>, <<"text/html">>}}, {"Content-Length: 207\r\n", - {http_header, 38, 'Content-Length', undefined, "207"}, - {http_header, 38, 'Content-Length', undefined, <<"207">>}}, + {http_header, 38, 'Content-Length', "Content-Length" , "207"}, + {http_header, 38, 'Content-Length', <<"Content-Length">>, <<"207">>}}, {"\r\n", http_eoh, http_eoh}], @@ -542,7 +560,7 @@ otp_8536_do(N) -> Bin = <<Hdr/binary, ": ", Data/binary, "\r\n\r\n">>, io:format("Bin='~p'\n",[Bin]), - {ok,{http_header,0,Hdr2,undefined,Data2},<<"\r\n">>} = decode_pkt(httph_bin, Bin, []), + {ok,{http_header,0,Hdr2,Hdr2,Data2},<<"\r\n">>} = decode_pkt(httph_bin, Bin, []), %% Do something to trash the C-stack, how about another decode_packet: decode_pkt(httph_bin,<<Letters/binary, ": ", Data/binary, "\r\n\r\n">>, []), diff --git a/erts/emulator/test/dirty_bif_SUITE.erl b/erts/emulator/test/dirty_bif_SUITE.erl index 4f5ad0295a..2ded862b8a 100644 --- a/erts/emulator/test/dirty_bif_SUITE.erl +++ b/erts/emulator/test/dirty_bif_SUITE.erl @@ -397,7 +397,9 @@ dirty_process_trace(Config) when is_list(Config) -> access_dirty_process( Config, fun() -> - erlang:trace_pattern({erts_debug,dirty_io,2}, + %% BIFs can only be traced when their modules are loaded. + code:ensure_loaded(erts_debug), + 1 = erlang:trace_pattern({erts_debug,dirty_io,2}, [{'_',[],[{return_trace}]}], [local,meta]), ok diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 9dcdd60060..da246d8157 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -68,7 +68,9 @@ message_latency_large_link_exit/1, message_latency_large_monitor_exit/1, message_latency_large_exit2/1, - system_limit/1]). + system_limit/1, + hopefull_data_encoding/1, + mk_hopefull_data/0]). %% Internal exports. -export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0, @@ -97,7 +99,8 @@ all() -> contended_atom_cache_entry, contended_unicode_atom_cache_entry, {group, message_latency}, {group, bad_dist}, {group, bad_dist_ext}, - start_epmd_false, epmd_module, system_limit]. + start_epmd_false, epmd_module, system_limit, + hopefull_data_encoding]. groups() -> [{bulk_send, [], [bulk_send_small, bulk_send_big, bulk_send_bigbig]}, @@ -2567,6 +2570,134 @@ address_please(_Name, _Address, _AddressFamily) -> IP = {127,0,0,1}, {ok, IP}. +hopefull_data_encoding(Config) when is_list(Config) -> + test_hopefull_data_encoding(Config, true), + test_hopefull_data_encoding(Config, false). + +test_hopefull_data_encoding(Config, Fallback) when is_list(Config) -> + {ok, ProxyNode} = start_node(hopefull_data_normal), + {ok, BouncerNode} = start_node(hopefull_data_bouncer, "-hidden"), + case Fallback of + false -> + ok; + true -> + rpc:call(BouncerNode, erts_debug, set_internal_state, + [available_internal_state, true]), + false = rpc:call(BouncerNode, erts_debug, set_internal_state, + [remove_hopefull_dflags, true]) + end, + HData = mk_hopefull_data(), + Tester = self(), + R1 = make_ref(), + R2 = make_ref(), + R3 = make_ref(), + Bouncer = spawn_link(BouncerNode, fun () -> bounce_loop() end), + Proxy = spawn_link(ProxyNode, + fun () -> + register(bouncer, self()), + %% Verify same result between this node and tester + Tester ! [R1, HData], + %% Test when connection has not been setup yet + Bouncer ! {Tester, [R2, HData]}, + Sync = make_ref(), + Bouncer ! {self(), Sync}, + receive Sync -> ok end, + %% Test when connection is already up + Bouncer ! {Tester, [R3, HData]}, + receive after infinity -> ok end + end), + receive + [R1, HData1] -> + Hdata = HData1 + end, + receive + [R2, HData2] -> + case Fallback of + false -> + HData = HData2; + true -> + check_hopefull_fallback_data(Hdata, HData2) + end + end, + receive + [R3, HData3] -> + case Fallback of + false -> + HData = HData3; + true -> + check_hopefull_fallback_data(Hdata, HData3) + end + end, + unlink(Proxy), + exit(Proxy, bye), + unlink(Bouncer), + exit(Bouncer, bye), + stop_node(ProxyNode), + stop_node(BouncerNode), + ok. + +bounce_loop() -> + receive + {SendTo, Data} -> + SendTo ! Data + end, + bounce_loop(). + +mk_hopefull_data() -> + HugeBs = list_to_bitstring([lists:duplicate(12*1024*1024, 85), <<6:6>>]), + <<_:1/bitstring,HugeBs2/bitstring>> = HugeBs, + lists:flatten([mk_hopefull_data(list_to_binary(lists:seq(1,255))), + 1234567890, HugeBs, fun gurka:banan/3, fun erlang:node/1, + self(), fun erlang:self/0, + mk_hopefull_data(list_to_binary(lists:seq(1,32))), an_atom, + fun lists:reverse/1, make_ref(), HugeBs2, + fun blipp:blapp/7]). + +mk_hopefull_data(BS) -> + BSsz = bit_size(BS), + [lists:map(fun (Offset) -> + <<_:Offset/bitstring, NewBs/bitstring>> = BS, + NewBs + end, lists:seq(1, 16)), + lists:map(fun (Offset) -> + <<NewBs:Offset/bitstring, _/bitstring>> = BS, + NewBs + end, lists:seq(BSsz-16, BSsz-1)), + lists:map(fun (Offset) -> + PreOffset = Offset rem 16, + <<_:PreOffset/bitstring, NewBs:Offset/bitstring, _/bitstring>> = BS, + NewBs + end, lists:seq(BSsz-32, BSsz-17))]. + + +check_hopefull_fallback_data([], []) -> + ok; +check_hopefull_fallback_data([X|Xs],[Y|Ys]) -> + chk_hopefull_fallback(X, Y), + check_hopefull_fallback_data(Xs,Ys). + +chk_hopefull_fallback(Binary, FallbackBinary) when is_binary(Binary) -> + Binary = FallbackBinary; +chk_hopefull_fallback(BitStr, {Bin, BitSize}) when is_bitstring(BitStr) -> + true = is_binary(Bin), + true = is_integer(BitSize), + true = BitSize > 0, + true = BitSize < 8, + Hsz = size(Bin) - 1, + <<Head:Hsz/binary, I/integer>> = Bin, + IBits = I bsr (8 - BitSize), + FallbackBitStr = list_to_bitstring([Head,<<IBits:BitSize>>]), + BitStr = FallbackBitStr, + ok; +chk_hopefull_fallback(Func, {ModName, FuncName}) when is_function(Func) -> + {M, F, _} = erlang:fun_info_mfa(Func), + M = ModName, + F = FuncName, + ok; +chk_hopefull_fallback(Other, SameOther) -> + Other = SameOther, + ok. + %%% Utilities timestamp() -> @@ -3034,3 +3165,5 @@ free_memory() -> error : undef -> ct:fail({"os_mon not built"}) end. + + diff --git a/erts/emulator/test/emulator.spec b/erts/emulator/test/emulator.spec index 7a6dd83020..087bd8880d 100644 --- a/erts/emulator/test/emulator.spec +++ b/erts/emulator/test/emulator.spec @@ -1,2 +1,3 @@ {enable_builtin_hooks, false}. {suites,"../emulator_test",all}. +{skip_groups,"../emulator_test",hash_SUITE,[phash2_benchmark],"Benchmark only"}. diff --git a/erts/emulator/test/emulator_bench.spec b/erts/emulator/test/emulator_bench.spec index 03638bfa23..8b1bb71a40 100644 --- a/erts/emulator/test/emulator_bench.spec +++ b/erts/emulator/test/emulator_bench.spec @@ -1,3 +1,4 @@ {groups,"../emulator_test",estone_SUITE,[estone_bench]}. {groups,"../emulator_test",binary_SUITE,[iolist_size_benchmarks]}. {groups,"../emulator_test",erts_debug_SUITE,[interpreter_size_bench]}. +{groups,"../emulator_test",hash_SUITE,[phash2_benchmark]}. diff --git a/erts/emulator/test/erts_test_destructor.erl b/erts/emulator/test/erts_test_destructor.erl new file mode 100644 index 0000000000..311bb0aaf9 --- /dev/null +++ b/erts/emulator/test/erts_test_destructor.erl @@ -0,0 +1,41 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% A NIF resource that sends a message in the destructor. + +-module(erts_test_destructor). + +-export([init/1, send/2]). + +init(Config) -> + case is_loaded() of + false -> + Path = proplists:get_value(data_dir, Config), + erlang:load_nif(filename:join(Path,?MODULE), []); + true -> + ok + end. + +is_loaded() -> + false. + +%% Create a resource which sends Msg to Pid when destructed. +send(_Pid, _Msg) -> + erlang:nif_error("NIF not loaded"). diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index 154bce3c35..e94a8d701b 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -303,57 +303,42 @@ maxbig_gc() -> Maxbig. stacktrace(Conf) when is_list(Conf) -> - Tag = make_ref(), - {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), - {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, V = [make_ref()|self()], - {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = - stacktrace_1({'abs',V}, error, {value,V}), - St1 = erase(stacktrace1), - St1 = erase(stacktrace2), - St1 = erlang:get_stacktrace(), - {caught2,{error,badarith},[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]=St2} = - stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), - [{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_] = erase(stacktrace1), - St2 = erase(stacktrace2), - St2 = erlang:get_stacktrace(), - {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = - stacktrace_1({value,V}, error, {value,V}), - St3 = erase(stacktrace1), - St3 = erase(stacktrace2), - St3 = erlang:get_stacktrace(), - {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = - stacktrace_1({value,V}, error, {throw,V}), - [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), - St4 = erase(stacktrace2), - St4 = erlang:get_stacktrace(), + {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]}} = + stacktrace_1({'abs',V}, error, {value,V}), + {caught2,{error,badarith},[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]} = + stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), + {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]} = + stacktrace_1({value,V}, error, {value,V}), + {caught2,{throw,V},[{?MODULE,foo,1,_}|_]} = + stacktrace_1({value,V}, error, {throw,V}), try stacktrace_2() catch - error:{badmatch,_} -> + error:{badmatch,_}:Stk -> [{?MODULE,stacktrace_2,0,_}, - {?MODULE,stacktrace,1,_}|_] = - erlang:get_stacktrace(), + {?MODULE,stacktrace,1,_}|_] = Stk, ok end. stacktrace_1(X, C1, Y) -> - erase(stacktrace1), - erase(stacktrace2), try try foo(X) of C1 -> value1 catch - C1:D1 -> {caught1,D1,erlang:get_stacktrace()} + C1:D1:Stk1 -> + [] = erlang:get_stacktrace(), + {caught1,D1,Stk1} after - put(stacktrace1, erlang:get_stacktrace()), foo(Y) end of V2 -> {value2,V2} catch - C2:D2 -> {caught2,{C2,D2},erlang:get_stacktrace()} + C2:D2:Stk2 -> + [] = erlang:get_stacktrace(), + {caught2,{C2,D2},Stk2} after - put(stacktrace2, erlang:get_stacktrace()) + ok end. stacktrace_2() -> @@ -364,76 +349,71 @@ stacktrace_2() -> nested_stacktrace(Conf) when is_list(Conf) -> V = [{make_ref()}|[self()]], value1 = - nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, - {void,void,void}), + nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, + {void,void,void}), {caught1, [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_], - value2, - [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_]} = - nested_stacktrace_1({{'add',{V,x1}},error,badarith}, - {{value,{V,x2}},void,{V,x2}}), + value2} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{value,{V,x2}},void,{V,x2}}), {caught1, [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_], - {caught2,[{erlang,abs,[V],_}|_]}, - [{erlang,abs,[V],_}|_]} = - nested_stacktrace_1({{'add',{V,x1}},error,badarith}, - {{'abs',V},error,badarg}), + {caught2,[{erlang,abs,[V],_}|_]}} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{'abs',V},error,badarg}), ok. nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> try foo(X1) of V1 -> value1 catch - C1:V1 -> - S1 = erlang:get_stacktrace(), - T2 = - try foo(X2) of - V2 -> value2 - catch - C2:V2 -> {caught2,erlang:get_stacktrace()} + C1:V1:S1 -> + T2 = try foo(X2) of + V2 -> value2 + catch + C2:V2:S2 -> {caught2,S2} end, - {caught1,S1,T2,erlang:get_stacktrace()} + {caught1,S1,T2} end. raise(Conf) when is_list(Conf) -> erase(raise), - A = - try - try foo({'div',{1,0}}) + A = + try + try foo({'div',{1,0}}) + catch + error:badarith:A0 -> + put(raise, A0), + erlang:raise(error, badarith, A0) + end catch - error:badarith:A0 -> - put(raise, A0 = erlang:get_stacktrace()), - erlang:raise(error, badarith, A0) - end - catch - error:badarith:A1 -> - A1 = erlang:get_stacktrace(), - A1 = get(raise) - end, - A = erlang:get_stacktrace(), + error:badarith:A1 -> + A1 = get(raise) + end, A = get(raise), [{erlang,'div',[1, 0], _},{?MODULE,my_div,2,_}|_] = A, %% N = 8, % Must be even N = erlang:system_flag(backtrace_depth, N), - B = odd_even(N, []), - try even(N) - catch error:function_clause -> ok + try + even(N) + catch + error:function_clause -> ok end, - B = erlang:get_stacktrace(), %% - C0 = odd_even(N+1, []), - C = lists:sublist(C0, N), - try odd(N+1) - catch error:function_clause -> ok + C = odd_even(N+1, []), + try + odd(N+1) + catch + error:function_clause -> ok end, - C = erlang:get_stacktrace(), - try erlang:raise(error, function_clause, C0) - catch error:function_clause -> ok + try + erlang:raise(error, function_clause, C) + catch + error:function_clause -> ok end, - C = erlang:get_stacktrace(), ok. odd_even(N, R) when is_integer(N), N > 1 -> @@ -601,11 +581,11 @@ do_exception_with_heap_frag(Bin, [Sz|Sizes]) -> try binary_to_term(Bin) catch - _:_ -> + _:_:Stk -> %% term_to_binary/1 is an easy way to traverse the %% entire stacktrace term to make sure that every part %% of it is OK. - term_to_binary(erlang:get_stacktrace()) + term_to_binary(Stk) end, id(Filler) end), @@ -811,8 +791,8 @@ close_calls(Where) -> %Line 2 call2(), %Line 6 call3(), %Line 7 no_crash %Line 8 - catch error:crash -> - erlang:get_stacktrace() %Line 10 + catch error:crash:Stk -> + Stk %Line 10 end. %Line 11 call1() -> %Line 13 diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index 3cbb3c7d5f..dd71c3da58 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -33,7 +33,25 @@ -module(hash_SUITE). -export([basic_test/0,cmp_test/1,range_test/0,spread_test/1, phash2_test/0, otp_5292_test/0, - otp_7127_test/0]). + otp_7127_test/0, + run_phash2_benchmarks/0, + test_phash2_binary_aligned_and_unaligned_equal/1, + test_phash2_4GB_plus_bin/1, + test_phash2_10MB_plus_bin/1, + test_phash2_large_map/1, + test_phash2_shallow_long_list/1, + test_phash2_deep_list/1, + test_phash2_deep_tuple/1, + test_phash2_deep_tiny/1, + test_phash2_with_42/1, + test_phash2_with_short_tuple/1, + test_phash2_with_short_list/1, + test_phash2_with_tiny_bin/1, + test_phash2_with_tiny_unaligned_sub_binary/1, + test_phash2_with_small_unaligned_sub_binary/1, + test_phash2_with_large_bin/1, + test_phash2_with_large_unaligned_sub_binary/1, + test_phash2_with_super_large_unaligned_sub_binary/1]). %% %% Define to run outside of test server @@ -43,13 +61,15 @@ %% %% Define for debug output %% -%-define(debug,1). +-define(debug,1). -ifdef(STANDALONE). -define(config(A,B),config(A,B)). +-record(event, {name, data}). -export([config/2]). -else. -include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). -endif. -ifdef(debug). @@ -67,12 +87,15 @@ -ifdef(STANDALONE). config(priv_dir,_) -> ".". +notify(X) -> + erlang:display(X). -else. %% When run in test server. --export([all/0, suite/0, +-export([groups/0, all/0, suite/0, test_basic/1,test_cmp/1,test_range/1,test_spread/1, test_phash2/1,otp_5292/1,bit_level_binaries/1,otp_7127/1, - test_hash_zero/1]). + test_hash_zero/1, init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -81,7 +104,71 @@ suite() -> all() -> [test_basic, test_cmp, test_range, test_spread, test_phash2, otp_5292, bit_level_binaries, otp_7127, - test_hash_zero]. + test_hash_zero, test_phash2_binary_aligned_and_unaligned_equal, + test_phash2_4GB_plus_bin, + test_phash2_10MB_plus_bin, + {group, phash2_benchmark_tests}, + {group, phash2_benchmark}]. + +get_phash2_benchmarks() -> + [ + test_phash2_large_map, + test_phash2_shallow_long_list, + test_phash2_deep_list, + test_phash2_deep_tuple, + test_phash2_deep_tiny, + test_phash2_with_42, + test_phash2_with_short_tuple, + test_phash2_with_short_list, + test_phash2_with_tiny_bin, + test_phash2_with_tiny_unaligned_sub_binary, + test_phash2_with_small_unaligned_sub_binary, + test_phash2_with_large_bin, + test_phash2_with_large_unaligned_sub_binary, + test_phash2_with_super_large_unaligned_sub_binary + ]. + +groups() -> + [ + { + phash2_benchmark_tests, + [], + get_phash2_benchmarks() + }, + { + phash2_benchmark, + [], + get_phash2_benchmarks() + } + ]. + + +init_per_suite(Config) -> + io:format("START APPS~n"), + A0 = case application:start(sasl) of + ok -> [sasl]; + _ -> [] + end, + A = case application:start(os_mon) of + ok -> [os_mon|A0]; + _ -> A0 + end, + io:format("APPS STARTED~n"), + [{started_apps, A}|Config]. + +end_per_suite(Config) -> + As = proplists:get_value(started_apps, Config), + lists:foreach(fun (A) -> application:stop(A) end, As), + Config. + +init_per_group(phash2_benchmark_tests, Config) -> + [phash2_benchmark_tests |Config]; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. + %% Tests basic functionality of erlang:phash and that the %% hashes has not changed (neither hash nor phash) @@ -119,6 +206,9 @@ otp_7127(Config) when is_list(Config) -> test_hash_zero(Config) when is_list(Config) -> hash_zero_test(). + +notify(X) -> + ct_event:notify(X). -endif. @@ -133,26 +223,17 @@ basic_test() -> 16#77777777777777],16#FFFFFFFF), ExternalReference = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64, 110,111,104,111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0>>, - 1113403635 = erlang:phash(binary_to_term(ExternalReference), - 16#FFFFFFFF), - ExternalFun = <<131,117,0,0,0,3,103,100,0,13,110,111,110,111,100,101,64, - 110,111,104,111,115,116,0,0,0,38,0,0,0,0,0,100,0,8,101, - 114,108,95,101,118,97,108,97,20,98,5,182,139,98,108,0,0, - 0,3,104,2,100,0,1,66,109,0,0,0,33,131,114,0,3,100,0,13, - 110,111,110,111,100,101,64,110,111,104,111,115,116,0,0, - 0,0,122,0,0,0,0,0,0,0,0,104,2,100,0,1,76,107,0,33,131, - 114,0,3,100,0,13,110,111,110,111,100,101,64,110,111,104, - 111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0,104,2,100,0,1,82, - 114,0,3,100,0,13,110,111,110,111,100,101,64,110,111,104, - 111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0,106,108,0,0,0,1, - 104,5,100,0,6,99,108,97,117,115,101,97,1,106,106,108,0,0, - 0,1,104,3,100,0,7,105,110,116,101,103,101,114,97,1,97,1, - 106,106,104,3,100,0,4,101,118,97,108,104,2,100,0,5,115, - 104,101,108,108,100,0,10,108,111,99,97,108,95,102,117, - 110,99,108,0,0,0,1,103,100,0,13,110,111,110,111,100,101, - 64,110,111,104,111,115,116,0,0,0,22,0,0,0,0,0,106>>, - 170987488 = erlang:phash(binary_to_term(ExternalFun), - 16#FFFFFFFF), + ExternalReference = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64, + 110,111,104,111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0>>, + 1113403635 = phash_from_external(ExternalReference), + + ExternalFun = <<131,112,0,0,0,70,1,212,190,220,28,179,144,194,131, + 19,215,105,97,77,251,125,93,0,0,0,0,0,0,0,2,100,0,1, + 116,97,0,98,6,165,246,224,103,100,0,13,110,111, + 110,111,100,101,64,110,111,104,111,115,116,0,0,0,91, + 0,0,0,0,0,97,2,97,1>>, + 25769064 = phash_from_external(ExternalFun), + case (catch erlang:phash(1,0)) of {'EXIT',{badarg, _}} -> ok; @@ -160,6 +241,8 @@ basic_test() -> exit(phash_accepted_zero_as_range) end. +phash_from_external(Ext) -> + erlang:phash(binary_to_term(Ext), 16#FFFFFFFF). range_test() -> F = fun(From,From,_FF) -> @@ -354,6 +437,7 @@ phash2_test() -> %% bit-level binaries {<<0:7>>, 1055790816}, + {(fun()-> B = <<255,7:3>>, <<_:4,D/bitstring>> = B, D end)(), 911751529}, {<<"abc",13:4>>, 670412287}, {<<5:3,"12345678901234567890">>, 289973273}, @@ -424,6 +508,159 @@ phash2_test() -> [] = [{E,H,H2} || {E,H} <- L, (H2 = erlang:phash2(E, Max)) =/= H], ok. +test_phash2_binary_aligned_and_unaligned_equal(Config) when is_list(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + test_aligned_and_unaligned_equal_up_to(256*12+255), + erts_debug:set_internal_state(available_internal_state, false). + +test_aligned_and_unaligned_equal_up_to(BinSize) -> + Results = + lists:map(fun(Size) -> + test_aligned_and_unaligned_equal(Size) + end, lists:seq(1, BinSize)), + %% DataDir = filename:join(filename:dirname(code:which(?MODULE)), "hash_SUITE_data"), + %% ExpResFile = filename:join(DataDir, "phash2_bin_expected_results.txt"), + %% {ok, [ExpRes]} = file:consult(ExpResFile), + %% %% ok = file:write_file(ExpResFile, io_lib:format("~w.~n", [Results])), + %% Results = ExpRes, + 110469206 = erlang:phash2(Results). + +test_aligned_and_unaligned_equal(BinSize) -> + Bin = make_random_bin(BinSize), + LastByte = last_byte(Bin), + LastInBitstring = LastByte rem 11, + Bitstring = << Bin/binary, <<LastInBitstring:5>>/bitstring >>, + UnalignedBin = make_unaligned_sub_bitstring(Bin), + UnalignedBitstring = make_unaligned_sub_bitstring(Bitstring), + case erts_debug:get_internal_state(available_internal_state) of + false -> erts_debug:set_internal_state(available_internal_state, true); + _ -> ok + end, + erts_debug:set_internal_state(reds_left, 3), + BinHash = erlang:phash2(Bin), + BinHash = erlang:phash2(Bin), + erts_debug:set_internal_state(reds_left, 3), + UnalignedBinHash = erlang:phash2(UnalignedBin), + UnalignedBinHash = erlang:phash2(UnalignedBin), + BinHash = UnalignedBinHash, + erts_debug:set_internal_state(reds_left, 3), + BitstringHash = erlang:phash2(Bitstring), + BitstringHash = erlang:phash2(Bitstring), + erts_debug:set_internal_state(reds_left, 3), + UnalignedBitstringHash = erlang:phash2(UnalignedBitstring), + UnalignedBitstringHash = erlang:phash2(UnalignedBitstring), + BitstringHash = UnalignedBitstringHash, + {BinHash, BitstringHash}. + +last_byte(Bin) -> + NotLastByteSize = (erlang:bit_size(Bin)) - 8, + <<_:NotLastByteSize/bitstring, LastByte:8>> = Bin, + LastByte. + +test_phash2_4GB_plus_bin(Config) when is_list(Config) -> + run_when_enough_resources( + fun() -> + erts_debug:set_internal_state(available_internal_state, true), + %% Created Bin4GB here so it only needs to be created once + erts_debug:set_internal_state(force_gc, self()), + Bin4GB = get_4GB_bin(), + test_phash2_plus_bin_helper1(Bin4GB, <<>>, <<>>, 13708901), + erts_debug:set_internal_state(force_gc, self()), + test_phash2_plus_bin_helper1(Bin4GB, <<>>, <<3:5>>, 66617678), + erts_debug:set_internal_state(force_gc, self()), + test_phash2_plus_bin_helper1(Bin4GB, <<13>>, <<>>, 31308392), + erts_debug:set_internal_state(force_gc, self()), + erts_debug:set_internal_state(available_internal_state, false) + end). + + +test_phash2_10MB_plus_bin(Config) when is_list(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(force_gc, self()), + Bin10MB = get_10MB_bin(), + test_phash2_plus_bin_helper1(Bin10MB, <<>>, <<>>, 22776267), + erts_debug:set_internal_state(force_gc, self()), + test_phash2_plus_bin_helper1(Bin10MB, <<>>, <<3:5>>, 124488972), + erts_debug:set_internal_state(force_gc, self()), + test_phash2_plus_bin_helper1(Bin10MB, <<13>>, <<>>, 72958346), + erts_debug:set_internal_state(force_gc, self()), + erts_debug:set_internal_state(available_internal_state, false). + +get_10MB_bin() -> + TmpBin = make_random_bin(10239), + Bin = erlang:iolist_to_binary([0, TmpBin]), + IOList10MB = duplicate_iolist(Bin, 10), + Bin10MB = erlang:iolist_to_binary(IOList10MB), + 10485760 = size(Bin10MB), + Bin10MB. + +get_4GB_bin() -> + TmpBin = make_random_bin(65535), + Bin = erlang:iolist_to_binary([0, TmpBin]), + IOList4GB = duplicate_iolist(Bin, 16), + Bin4GB = erlang:iolist_to_binary(IOList4GB), + 4294967296 = size(Bin4GB), + Bin4GB. + +duplicate_iolist(IOList, 0) -> + IOList; +duplicate_iolist(IOList, NrOfTimes) -> + duplicate_iolist([IOList, IOList], NrOfTimes - 1). + +test_phash2_plus_bin_helper1(Bin4GB, ExtraBytes, ExtraBits, ExpectedHash) -> + test_phash2_plus_bin_helper2(Bin4GB, fun id/1, ExtraBytes, ExtraBits, ExpectedHash), + test_phash2_plus_bin_helper2(Bin4GB, fun make_unaligned_sub_bitstring/1, ExtraBytes, ExtraBits, ExpectedHash). + +test_phash2_plus_bin_helper2(Bin, TransformerFun, ExtraBytes, ExtraBits, ExpectedHash) -> + ExtraBitstring = << ExtraBytes/binary, ExtraBits/bitstring >>, + LargerBitstring = << ExtraBytes/binary, + ExtraBits/bitstring, + Bin/bitstring >>, + LargerTransformedBitstring = TransformerFun(LargerBitstring), + ExtraBitstringHash = erlang:phash2(ExtraBitstring), + ExpectedHash = + case size(LargerTransformedBitstring) < 4294967296 of + true -> + erts_debug:set_internal_state(force_gc, self()), + erts_debug:set_internal_state(reds_left, 1), + Hash = erlang:phash2(LargerTransformedBitstring), + Hash = erlang:phash2(LargerTransformedBitstring), + Hash; + false -> + erts_debug:set_internal_state(force_gc, self()), + erts_debug:set_internal_state(reds_left, 1), + ExtraBitstringHash = erlang:phash2(LargerTransformedBitstring), + ExtraBitstringHash = erlang:phash2(LargerTransformedBitstring), + ExtraBitstringHash + end. + +run_when_enough_resources(Fun) -> + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem >= 31 -> + Fun(); + {Mem, WordSize} -> + {skipped, + io_lib:format("Not enough resources (System Memory >= ~p, Word Size = ~p)", + [Mem, WordSize])} + end. + +%% Total memory in GB +total_memory() -> + try + MemoryData = memsup:get_system_memory_data(), + case lists:keysearch(total_memory, 1, MemoryData) of + {value, {total_memory, TM}} -> + TM div (1024*1024*1024); + false -> + {value, {system_total_memory, STM}} = + lists:keysearch(system_total_memory, 1, MemoryData), + STM div (1024*1024*1024) + end + catch + _ : _ -> + undefined + end. + -ifdef(FALSE). f1() -> abc. @@ -436,14 +673,23 @@ f3(X, Y) -> -endif. otp_5292_test() -> - PH = fun(E) -> [erlang:phash(E, 1 bsl 32), - erlang:phash(-E, 1 bsl 32), - erlang:phash2(E, 1 bsl 32), - erlang:phash2(-E, 1 bsl 32)] - end, + PH = fun(E) -> + EInList = [1, 2, 3, E], + EInList2 = [E, 1, 2, 3], + NegEInList = [1, 2, 3, -E], + NegEInList2 = [-E, 1, 2, 3], + [erlang:phash(E, 1 bsl 32), + erlang:phash(-E, 1 bsl 32), + erlang:phash2(E, 1 bsl 32), + erlang:phash2(-E, 1 bsl 32), + erlang:phash2(EInList, 1 bsl 32), + erlang:phash2(EInList2, 1 bsl 32), + erlang:phash2(NegEInList, 1 bsl 32), + erlang:phash2(NegEInList2, 1 bsl 32)] + end, S2 = md5([md5(hash_int(S, E, PH)) || {Start, N, Sz} <- d(), {S, E} <- int(Start, N, Sz)]), - <<124,81,198,121,174,233,19,137,10,83,33,80,226,111,238,99>> = S2, + <<234,63,192,76,253,57,250,32,44,11,73,1,161,102,14,238>> = S2, ok. d() -> @@ -684,3 +930,313 @@ unaligned_sub_bitstr(Bin0) when is_bitstring(Bin0) -> id(I) -> I. + +%% Benchmarks for phash2 + +run_phash2_benchmarks() -> + Benchmarks = [ + test_phash2_large_map, + test_phash2_shallow_long_list, + test_phash2_deep_list, + test_phash2_deep_tuple, + test_phash2_deep_tiny, + test_phash2_with_42, + test_phash2_with_short_tuple, + test_phash2_with_short_list, + test_phash2_with_tiny_bin, + test_phash2_with_tiny_unaligned_sub_binary, + test_phash2_with_small_unaligned_sub_binary, + test_phash2_with_large_bin, + test_phash2_with_large_unaligned_sub_binary, + test_phash2_with_super_large_unaligned_sub_binary + ], + [print_comment(B) || B <- Benchmarks]. + + +print_comment(FunctionName) -> + io:format("~p~n", [FunctionName]), + io:format("~s~n", [element(2, erlang:apply(?MODULE, FunctionName, [[]]))]). + +nr_of_iters(BenchmarkNumberOfIterations, Config) -> + case lists:member(phash2_benchmark_tests, Config) of + true -> 1; + false -> BenchmarkNumberOfIterations + end. + + +test_phash2_large_map(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {1000000, 121857429}; + _ -> + {1000, 66609305} + end, + run_phash2_test_and_benchmark(nr_of_iters(45, Config), + get_map(Size), + ExpectedHash). + +test_phash2_shallow_long_list(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {1000000, 78700388}; + _ -> + {1000, 54749638} + end, + run_phash2_test_and_benchmark(nr_of_iters(1, Config), + lists:duplicate(Size, get_complex_tuple()), + ExpectedHash). + +test_phash2_deep_list(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {500000, 17986444}; + _ -> + {1000, 81794308} + end, + run_phash2_test_and_benchmark(nr_of_iters(1, Config), + make_deep_list(Size, get_complex_tuple()), + ExpectedHash). + +test_phash2_deep_tuple(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {500000, 116594715}; + _ -> + {500, 109057352} + end, + run_phash2_test_and_benchmark(nr_of_iters(1, Config), + make_deep_tuple(Size, get_complex_tuple()), + ExpectedHash). + +test_phash2_deep_tiny(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(1000000, Config), + make_deep_list(19, 42), + 111589624). + +test_phash2_with_42(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(20000000, Config), + 42, + 30328728). + +test_phash2_with_short_tuple(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(10000000, Config), + {a,b,<<"hej">>, "hej"}, + 50727199). + +test_phash2_with_short_list(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(10000000, Config), + [a,b,"hej", "hello"], + 117108642). + +test_phash2_with_tiny_bin(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(20000000, Config), + make_random_bin(10), + 129616602). + +test_phash2_with_tiny_unaligned_sub_binary(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(10000000, Config), + make_unaligned_sub_binary(make_random_bin(11)), + 59364725). + +test_phash2_with_small_unaligned_sub_binary(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(400000, Config), + make_unaligned_sub_binary(make_random_bin(1001)), + 130388119). + +test_phash2_with_large_bin(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {10000000, 48249379}; + _ -> + {1042, 14679520} + end, + run_phash2_test_and_benchmark(nr_of_iters(150, Config), + make_random_bin(Size), + ExpectedHash). + +test_phash2_with_large_unaligned_sub_binary(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {10000001, 122836437}; + _ -> + {10042, 127144287} + end, + run_phash2_test_and_benchmark(nr_of_iters(50, Config), + make_unaligned_sub_binary(make_random_bin(Size)), + ExpectedHash). + +test_phash2_with_super_large_unaligned_sub_binary(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {20000001, 112086727}; + _ -> + {20042, 91996619} + end, + run_phash2_test_and_benchmark(nr_of_iters(20, Config), + make_unaligned_sub_binary(make_random_bin(Size)), + ExpectedHash). + +make_deep_list(1, Item) -> + {Item, Item}; +make_deep_list(Depth, Item) -> + [{Item, Item}, make_deep_list(Depth - 1, Item)]. + +make_deep_tuple(1, Item) -> + [Item, Item]; +make_deep_tuple(Depth, Item) -> + {[Item, Item], make_deep_tuple(Depth - 1, Item)}. + +% Helper functions for benchmarking + +loop(0, _) -> ok; +loop(Iterations, Fun) -> + Fun(), + loop(Iterations - 1, Fun). + +run_phash2_test_and_benchmark(Iterations, Term, ExpectedHash) -> + Parent = self(), + Test = + fun() -> + Hash = erlang:phash2(Term), + case ExpectedHash =:= Hash of + false -> + Parent ! {got_bad_hash, Hash}, + ExpectedHash = Hash; + _ -> ok + end + end, + Benchmark = + fun() -> + garbage_collect(), + {Time, _} =timer:tc(fun() -> loop(Iterations, Test) end), + Parent ! Time + end, + spawn(Benchmark), + receive + {got_bad_hash, Hash} -> + ExpectedHash = Hash; + Time -> + TimeInS = case (Time/1000000) of + 0.0 -> 0.0000000001; + T -> T + end, + IterationsPerSecond = Iterations / TimeInS, + notify(#event{ name = benchmark_data, data = [{value, IterationsPerSecond}]}), + {comment, io_lib:format("Iterations per second: ~p, Iterations ~p, Benchmark time: ~p seconds)", + [IterationsPerSecond, Iterations, Time/1000000])} + end. + +get_complex_tuple() -> + BPort = <<131,102,100,0,13,110,111,110,111,100,101,64,110,111,104, + 111,115,116,0,0,0,1,0>>, + Port = binary_to_term(BPort), + + BXPort = <<131,102,100,0,11,97,112,97,64,108,101,103,111,108,97,115, + 0,0,0,24,3>>, + XPort = binary_to_term(BXPort), + + BRef = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64,110,111,104, + 111,115,116,0,0,0,1,255,0,0,0,0,0,0,0,0>>, + Ref = binary_to_term(BRef), + + BXRef = <<131,114,0,3,100,0,11,97,112,97,64,108,101,103,111,108,97,115, + 2,0,0,0,155,0,0,0,0,0,0,0,0>>, + XRef = binary_to_term(BXRef), + + BXPid = <<131,103,100,0,11,97,112,97,64,108,101,103,111,108,97,115, + 0,0,0,36,0,0,0,0,1>>, + XPid = binary_to_term(BXPid), + + + %% X = f1(), Y = f2(), Z = f3(X, Y), + + %% F1 = fun f1/0, % -> abc + B1 = <<131,112,0,0,0,66,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,1,0,0,0,0,100,0,1,116,97,1,98,2,195,126, + 58,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F1 = binary_to_term(B1), + + %% F2 = fun f2/0, % -> abd + B2 = <<131,112,0,0,0,66,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,2,0,0,0,0,100,0,1,116,97,2,98,3,130,152, + 185,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F2 = binary_to_term(B2), + + %% F3 = fun f3/2, % -> {abc, abd} + B3 = <<131,112,0,0,0,66,2,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,3,0,0,0,0,100,0,1,116,97,3,98,7,168,160, + 93,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F3 = binary_to_term(B3), + + %% F4 = fun () -> 123456789012345678901234567 end, + B4 = <<131,112,0,0,0,66,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,4,0,0,0,0,100,0,1,116,97,4,98,2,230,21, + 171,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F4 = binary_to_term(B4), + + %% F5 = fun() -> {X,Y,Z} end, + B5 = <<131,112,0,0,0,92,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,5,0,0,0,3,100,0,1,116,97,5,98,0,99,101, + 130,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0,100,0,3,97,98,99,100,0,3,97,98, + 100,104,2,100,0,3,97,98,99,100,0,3,97,98,100>>, + F5 = binary_to_term(B5), + {{1,{2}},an_atom, 1, 3434.923942394,<<"this is a binary">>, + make_unaligned_sub_binary(<<"this is also a binary">>),c,d,e,f,g,h,i,j,k,l,[f], + 999999999999999999666666662123123123123324234999999999999999, 234234234, + BPort, Port, BXPort, XPort, BRef, Ref, BXRef, XRef, BXPid, XPid, F1, F2, F3, F4, F5, + #{a => 1, b => 2, c => 3, d => 4, e => 5, f => 6, g => 7, h => 8, i => 9, + j => 1, k => 1, l => 123123123123213, m => [1,2,3,4,5,6,7,8], o => 5, p => 6, + q => 7, r => 8, s => 9}}. + +get_map_helper(MapSoFar, 0) -> + MapSoFar; +get_map_helper(MapSoFar, NumOfItemsToAdd) -> + NewMapSoFar = maps:put(NumOfItemsToAdd, NumOfItemsToAdd, MapSoFar), + get_map_helper(NewMapSoFar, NumOfItemsToAdd -1). + +get_map(Size) -> + get_map_helper(#{}, Size). + + +%% Copied from binary_SUITE +make_unaligned_sub_binary(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +make_unaligned_sub_bitstring(Bin0) -> + Bin1 = <<0:3,Bin0/bitstring,31:5>>, + Sz = erlang:bit_size(Bin0), + <<0:3,Bin:Sz/bitstring,31:5>> = id(Bin1), + Bin. + +make_random_bin(Size) -> + make_random_bin(Size, []). + +make_random_bin(0, Acc) -> + iolist_to_binary(Acc); +make_random_bin(Size, []) -> + make_random_bin(Size - 1, [simple_rand() rem 256]); +make_random_bin(Size, [N | Tail]) -> + make_random_bin(Size - 1, [simple_rand(N) rem 256, N |Tail]). + +simple_rand() -> + 123456789. +simple_rand(Seed) -> + A = 1103515245, + C = 12345, + M = (1 bsl 31), + (A * Seed + C) rem M. diff --git a/erts/emulator/test/hash_property_test_SUITE.erl b/erts/emulator/test/hash_property_test_SUITE.erl new file mode 100644 index 0000000000..b4c7810a52 --- /dev/null +++ b/erts/emulator/test/hash_property_test_SUITE.erl @@ -0,0 +1,103 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(hash_property_test_SUITE). + +-export([suite/0,all/0,groups/0,init_per_suite/1, + end_per_suite/1,init_per_group/2,end_per_group/2]). + +-export([test_phash2_no_diff/1, + test_phash2_no_diff_long/1, + test_phash2_no_diff_between_versions/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> [{group, proper}]. + +groups() -> + [{proper, [], [test_phash2_no_diff, + test_phash2_no_diff_long, + test_phash2_no_diff_between_versions]}]. + + +%%% First prepare Config and compile the property tests for the found tool: +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). + +end_per_suite(Config) -> + Config. + +%%% Only proper is supported +init_per_group(proper, Config) -> + case proplists:get_value(property_test_tool,Config) of + proper -> Config; + X -> {skip, lists:concat([X," is not supported"])} + end; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. + +test_phash2_no_diff(Config) when is_list(Config) -> + true = ct_property_test:quickcheck( + phash2_properties:prop_phash2_same_with_same_input(), + Config). + +test_phash2_no_diff_long(Config) when is_list(Config) -> + true = ct_property_test:quickcheck( + phash2_properties:prop_phash2_same_with_same_long_input(), + Config). + +test_phash2_no_diff_between_versions(Config) when is_list(Config) -> + R = "21", + case test_server:is_release_available(R) of + true -> + Rel = {release,R}, + case test_server:start_node(rel21,peer,[{erl,[Rel]}]) of + {error, Reason} -> {skip, io_lib:format("Could not start node: ~p~n", [Reason])}; + {ok, Node} -> + try + true = ct_property_test:quickcheck( + phash2_properties:prop_phash2_same_in_different_versions(Node), + Config), + true = ct_property_test:quickcheck( + phash2_properties:prop_phash2_same_in_different_versions_with_long_input(Node), + Config) + after + test_server:stop_node(Node) + end + end; + false -> + {skip, io_lib:format("Release ~s not available~n", [R])} + end. diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl index a20f306e04..d65d0ff2fd 100644 --- a/erts/emulator/test/hibernate_SUITE.erl +++ b/erts/emulator/test/hibernate_SUITE.erl @@ -46,12 +46,17 @@ all() -> basic(Config) when is_list(Config) -> Ref = make_ref(), Info = {self(),Ref}, - ExpectedHeapSz = erts_debug:size([Info]), + ExpectedHeapSz = expected_heap_size([Info]), Child = spawn_link(fun() -> basic_hibernator(Info) end), hibernate_wake_up(100, ExpectedHeapSz, Child), Child ! please_quit_now, ok. +expected_heap_size(Term) -> + %% When hibernating, an extra word will be allocated on the stack + %% for a continuation pointer. + erts_debug:size(Term) + 1. + hibernate_wake_up(0, _, _) -> ok; hibernate_wake_up(N, ExpectedHeapSz, Child) -> {heap_size,Before} = process_info(Child, heap_size), @@ -142,7 +147,7 @@ whats_up_calc(A1, A2, A3, A4, A5, A6, A7, A8, A9, Acc) -> dynamic_call(Config) when is_list(Config) -> Ref = make_ref(), Info = {self(),Ref}, - ExpectedHeapSz = erts_debug:size([Info]), + ExpectedHeapSz = expected_heap_size([Info]), Child = spawn_link(fun() -> ?MODULE:dynamic_call_hibernator(Info, hibernate) end), hibernate_wake_up(100, ExpectedHeapSz, Child), Child ! please_quit_now, diff --git a/erts/emulator/test/hipe_SUITE.erl b/erts/emulator/test/hipe_SUITE.erl index e62d4260f6..9741872fd8 100644 --- a/erts/emulator/test/hipe_SUITE.erl +++ b/erts/emulator/test/hipe_SUITE.erl @@ -131,8 +131,8 @@ t_trycatch(Config) -> t_trycatch_1([S|Ss]) -> io:format("~p", [S]), compile_and_load(S), - call_trycatch(try_catch), - call_trycatch(plain_catch), + call_trycatch(), + call_catch(), io:nl(), t_trycatch_1(Ss); t_trycatch_1([]) -> @@ -144,38 +144,49 @@ trycatch_combine([N|Ns]) -> trycatch_combine([]) -> [[]]. -call_trycatch(Func) -> - case do_call_trycatch(error, Func, {error,whatever}) of +call_trycatch() -> + case trycatch_1:one_try_catch({error,whatever}) of {error,whatever,[{trycatch_3,three,1,_}|_]} -> ok end, - case do_call_trycatch(error, Func, fc) of + case trycatch_1:one_try_catch(fc) of {error,function_clause,[{trycatch_3,three,[fc],_}|_]} -> ok; {error,function_clause,[{trycatch_3,three,1,_}|_]} -> + true = trycatch_3:module_info(native), ok end, - case do_call_trycatch(throw, Func, {throw,{a,b}}) of + case trycatch_1:one_try_catch({throw,{a,b}}) of {throw,{a,b},[{trycatch_3,three,1,_}|_]} -> ok end, - case do_call_trycatch(exit, Func, {exit,{a,b,c}}) of + case trycatch_1:one_try_catch({exit,{a,b,c}}) of {exit,{a,b,c},[{trycatch_3,three,1,_}|_]} -> ok end, ok. -do_call_trycatch(_Class, try_catch, Argument) -> - trycatch_1:one_try_catch(Argument); -do_call_trycatch(error, plain_catch, Argument) -> - {{'EXIT',{Reason,Stk}},Stk} = trycatch_1:one_plain_catch(Argument), - {error,Reason,Stk}; -do_call_trycatch(throw, plain_catch, Argument) -> - {Reason,Stk} = trycatch_1:one_plain_catch(Argument), - {throw,Reason,Stk}; -do_call_trycatch(exit, plain_catch, Argument) -> - {{'EXIT',Reason},Stk} = trycatch_1:one_plain_catch(Argument), - {exit,Reason,Stk}. +call_catch() -> + case trycatch_1:one_plain_catch({error,whatever}) of + {'EXIT',{whatever,[{trycatch_3,three,1,_}|_]}} -> + ok + end, + + case trycatch_1:one_plain_catch(fc) of + {'EXIT',{function_clause,[{trycatch_3,three,[fc],_}|_]}} -> + ok; + {'EXIT',{function_clause,[{trycatch_3,three,1,_}|_]}} -> + true = trycatch_3:module_info(native) + end, + case trycatch_1:one_plain_catch({throw,{a,b}}) of + {a,b} -> + ok + end, + case trycatch_1:one_plain_catch({exit,{a,b,c}}) of + {'EXIT',{a,b,c}} -> + ok + end, + ok. compile_and_load(Sources) -> _ = [begin diff --git a/erts/emulator/test/hipe_SUITE_data/trycatch_1.erl b/erts/emulator/test/hipe_SUITE_data/trycatch_1.erl index 702b14b5b9..f7d0e3bd1e 100644 --- a/erts/emulator/test/hipe_SUITE_data/trycatch_1.erl +++ b/erts/emulator/test/hipe_SUITE_data/trycatch_1.erl @@ -5,10 +5,9 @@ one_try_catch(Term) -> try trycatch_2:two(Term) catch - C:R -> - Stk = erlang:get_stacktrace(), + C:R:Stk -> {C,R,Stk} end. one_plain_catch(Term) -> - {catch trycatch_2:two(Term),erlang:get_stacktrace()}. + catch trycatch_2:two(Term). diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl index 4ddcd0f60b..68773e8611 100644 --- a/erts/emulator/test/list_bif_SUITE.erl +++ b/erts/emulator/test/list_bif_SUITE.erl @@ -156,22 +156,18 @@ t_list_to_ext_pidportref(Config) when is_list(Config) -> Port2 = list_to_port(PortStr), Ref2 = list_to_ref(RefStr), - %% The local roundtrips of externals does not work - %% as 'creation' is missing in the string formats and we don't know - %% the 'creation' of the connected node. - false = (Pid =:= Pid2), - false = (Port =:= Port2), - false = (Ref =:= Ref2), - - %% Local roundtrip kind of "works" for '==' since OTP-22.0 (bf7c722bd3b) - %% Operator '==' treats 0-creations as wildcards - %% which breaks term transitivity (A==B and B==C => B==C). + %% Local roundtrips of externals work from OTP-23 + %% as even though 'creation' is missing in the string formats + %% we know the 'creation' of the connected node and list_to_* use that. + true = (Pid =:= Pid2), + true = (Port =:= Port2), + true = (Ref =:= Ref2), true = (Pid == Pid2), true = (Port == Port2), true = (Ref == Ref2), - %% It works when sent back to node with matching name, as 0-creations - %% will be converted to the local node creation. + %% And it works when sent back to the same node instance, + %% which was connected when list_to_* were called. true = rpc:call(Node, erlang, '=:=', [Pid, Pid2]), true = rpc:call(Node, erlang, '==', [Pid, Pid2]), true = rpc:call(Node, erlang, '=:=', [Port, Port2]), @@ -179,9 +175,57 @@ t_list_to_ext_pidportref(Config) when is_list(Config) -> true = rpc:call(Node, erlang, '=:=', [Ref, Ref2]), true = rpc:call(Node, erlang, '==', [Ref, Ref2]), + %% Make sure no ugly comparison with 0-creation as wildcard is done. + Pid0 = make_0_creation(Pid), + Port0 = make_0_creation(Port), + Ref0 = make_0_creation(Ref), + false = (Pid =:= Pid0), + false = (Port =:= Port0), + false = (Ref =:= Ref0), + false = (Pid == Pid0), + false = (Port == Port0), + false = (Ref == Ref0), + + %% Check 0-creations are converted to local node creations + %% when sent to matching node name. + true = rpc:call(Node, erlang, '=:=', [Pid, Pid0]), + true = rpc:call(Node, erlang, '==', [Pid, Pid0]), + true = rpc:call(Node, erlang, '=:=', [Port, Port0]), + true = rpc:call(Node, erlang, '==', [Port, Port0]), + true = rpc:call(Node, erlang, '=:=', [Ref, Ref0]), + true = rpc:call(Node, erlang, '==', [Ref, Ref0]), + slave:stop(Node), ok. +-define(NEW_PID_EXT, 88). +-define(NEW_PORT_EXT, 89). +-define(NEWER_REFERENCE_EXT, 90). + +%% Copy pid/port/ref but set creation=0 +make_0_creation(X) when is_pid(X); is_port(X); is_reference(X) -> + B = term_to_binary(X), + Sz = byte_size(B), + B2 = case B of + <<131, ?NEW_PID_EXT, _/binary>> -> + PreSz = Sz - 4, + <<_:PreSz/binary, Cr:32>> = B, + true = (Cr =/= 0), + <<B:PreSz/binary, 0:32>>; + <<131, ?NEW_PORT_EXT, _/binary>> -> + PreSz = Sz - 4, + <<_:PreSz/binary, Cr:32>> = B, + true = (Cr =/= 0), + <<B:PreSz/binary, 0:32>>; + <<131, ?NEWER_REFERENCE_EXT, Len:16, _/binary>> -> + PostSz = Len*4, + PreSz = Sz - (4 + PostSz), + <<_:PreSz/binary, Cr:32, PostFix:PostSz/binary>> = B, + true = (Cr =/= 0), + <<B:PreSz/binary, 0:32, PostFix/binary>> + end, + binary_to_term(B2). + %% Test list_to_float/1 with correct and incorrect arguments. diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl index f19047ba71..18d72cc16a 100644 --- a/erts/emulator/test/lttng_SUITE.erl +++ b/erts/emulator/test/lttng_SUITE.erl @@ -32,8 +32,7 @@ t_driver_ready_input_output/1, t_driver_timeout/1, t_driver_caller/1, - t_driver_flush/1, - t_scheduler_poll/1]). + t_driver_flush/1]). -export([ets_load/0]). @@ -43,7 +42,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 1}}]. -all() -> +all() -> [t_lttng_list, t_memory_carrier, t_carrier_pool, @@ -52,9 +51,7 @@ all() -> t_driver_control, t_driver_timeout, t_driver_caller, - t_driver_flush, - t_scheduler_poll]. - + t_driver_flush]. init_per_suite(Config) -> case erlang:system_info(dynamic_trace) of @@ -88,8 +85,6 @@ end_per_testcase(Case, _Config) -> %% org_erlang_otp:carrier_pool_put %% org_erlang_otp:carrier_destroy %% org_erlang_otp:carrier_create -%% org_erlang_otp:aio_pool_put -%% org_erlang_otp:aio_pool_get %% org_erlang_otp:driver_control %% org_erlang_otp:driver_call %% org_erlang_otp:driver_finish @@ -105,7 +100,6 @@ end_per_testcase(Case, _Config) -> %% org_erlang_otp:driver_outputv %% org_erlang_otp:driver_init %% org_erlang_otp:driver_start -%% org_erlang_otp:scheduler_poll %% %% Testcases @@ -264,35 +258,6 @@ t_driver_caller(Config) -> ok = check_tracepoint("org_erlang_otp:driver_init", Res), ok = check_tracepoint("org_erlang_otp:driver_finish", Res), ok. - -%% org_erlang_otp:scheduler_poll -t_scheduler_poll(Config) -> - ok = lttng_start_event("org_erlang_otp:scheduler_poll", Config), - - N = 100, - - Me = self(), - Pid = spawn_link(fun() -> tcp_server(Me, {active, N*2}) end), - receive {Pid, accept} -> ok end, - - %% We want to create a scenario where the fd is moved into a scheduler - %% pollset, this means we have to send many small packages to the - %% same socket, but not fast enough for them to all arrive at the - %% same time. - {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2}]), - [begin gen_tcp:send(Sock,txt()), receive ok -> ok end end || _ <- lists:seq(1,N)], - - ok = memory_load(), - - [begin gen_tcp:send(Sock,txt()), receive ok -> ok end end || _ <- lists:seq(1,N)], - - ok = gen_tcp:close(Sock), - Pid ! die, - receive {Pid, done} -> ok end, - - Res = lttng_stop_and_view(Config), - ok = check_tracepoint("org_erlang_otp:scheduler_poll", Res), - ok. %% org_erlang_otp:driver_flush t_driver_flush(Config) -> @@ -333,24 +298,6 @@ chk_caller(Port, Callback, ExpectedCaller) -> ExpectedCaller = Caller end. -memory_load() -> - Me = self(), - Pids0 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)], - timer:sleep(50), - Pids1 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)], - [receive {Pid, done} -> ok end || Pid <- Pids0 ++ Pids1], - timer:sleep(500), - ok. - -memory_loop(Parent, N, Bin) -> - memory_loop(Parent, N, Bin, []). - -memory_loop(Parent, 0, _Bin, _) -> - Parent ! {self(), done}; -memory_loop(Parent, N, Bin0, Ls) -> - Bin = binary:copy(<<Bin0/binary, Bin0/binary>>), - memory_loop(Parent, N - 1, Bin, [a,b,c|Ls]). - ets_load(Config) -> %% Have to do on a fresh node to guarantee that carriers are created @@ -429,8 +376,6 @@ txt() -> "%% org_erlang_otp:carrier_pool_put\n" "%% org_erlang_otp:carrier_destroy\n" "%% org_erlang_otp:carrier_create\n" - "%% org_erlang_otp:aio_pool_put\n" - "%% org_erlang_otp:aio_pool_get\n" "%% org_erlang_otp:driver_control\n" "%% org_erlang_otp:driver_call\n" "%% org_erlang_otp:driver_finish\n" @@ -445,8 +390,7 @@ txt() -> "%% org_erlang_otp:driver_output\n" "%% org_erlang_otp:driver_outputv\n" "%% org_erlang_otp:driver_init\n" - "%% org_erlang_otp:driver_start\n" - "%% org_erlang_otp:scheduler_poll">>. + "%% org_erlang_otp:driver_start">>. load_driver(Dir, Driver) -> case erl_ddll:load_driver(Dir, Driver) of @@ -464,12 +408,6 @@ have_carriers(Alloc) -> _ -> true end. -have_async_threads() -> - Tps = erlang:system_info(thread_pool_size), - if Tps =:= 0 -> false; - true -> true - end. - %% lttng lttng_stop_and_view(Config) -> Path = proplists:get_value(priv_dir, Config), diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 4b638b9082..dbf6fa58ed 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -1872,15 +1872,18 @@ t_bif_map_get(Config) when is_list(Config) -> "v3" = maps:get(<<"k2">>, M1), %% error cases + %% + %% Note that the stack trace is ignored because the compiler may have + %% rewritten maps:get/2 to map_get. do_badmap(fun(T) -> - {'EXIT',{{badmap,T},[{maps,get,_,_}|_]}} = + {'EXIT',{{badmap,T},_}} = (catch maps:get(a, T)) end), - {'EXIT',{{badkey,{1,1}},[{maps,get,_,_}|_]}} = + {'EXIT',{{badkey,{1,1}},_}} = (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), - {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = (catch maps:get(a, #{})), - {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = + {'EXIT',{{badkey,a},_}} = (catch maps:get(a, #{})), + {'EXIT',{{badkey,a},_}} = (catch maps:get(a, #{b=>1, c=>2})), ok. @@ -1942,8 +1945,11 @@ t_bif_map_is_key(Config) when is_list(Config) -> false = maps:is_key(1.0, maps:put(1, "number", M1)), %% error case + %% + %% Note that the stack trace is ignored because the compiler may have + %% rewritten maps:is_key/2 to is_map_key. do_badmap(fun(T) -> - {'EXIT',{{badmap,T},[{maps,is_key,_,_}|_]}} = + {'EXIT',{{badmap,T},_}} = (catch maps:is_key(a, T)) end), ok. diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 21de6b1002..686b431876 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -198,7 +198,8 @@ caller_and_return_to(Config) -> {trace,Tracee,call,{?MODULE,do_the_put,[test]},{?MODULE,do_put,1}}, {trace,Tracee,call,{erlang,integer_to_list,[1]},{?MODULE,do_the_put,1}}, {trace,Tracee,return_to,{?MODULE,do_the_put,1}}, - {trace,Tracee,call,{erlang,put,[test,"1"]},{?MODULE,do_put,1}}, + {trace,Tracee,call,{erlang,put,[test,"1"]},{?MODULE,do_the_put,1}}, + {trace,Tracee,return_to,{?MODULE,do_the_put,1}}, {trace,Tracee,return_to,{?MODULE,do_put,1}}, %% These last trace messages are a bit strange... diff --git a/erts/emulator/test/mtx_SUITE_data/Makefile.src b/erts/emulator/test/mtx_SUITE_data/Makefile.src index 1816dc6798..c736cfa7dd 100644 --- a/erts/emulator/test/mtx_SUITE_data/Makefile.src +++ b/erts/emulator/test/mtx_SUITE_data/Makefile.src @@ -28,8 +28,10 @@ LIBS = @ERTS_LIBS@ all: $(NIF_LIBS) +WSL=@WSL@ + mtx_SUITE.c: force_rebuild - touch mtx_SUITE.c + $(WSL) touch mtx_SUITE.c force_rebuild: echo "Force rebuild to compensate for emulator type dependencies" diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 6a8f7607cd..009c3dc7ac 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -33,6 +33,7 @@ init_per_testcase/2, end_per_testcase/2, basic/1, reload_error/1, upgrade/1, heap_frag/1, t_on_load/1, + load_traced_nif/1, select/1, select_steal/1, monitor_process_a/1, monitor_process_b/1, @@ -93,6 +94,7 @@ all() -> {group, monitor}, monitor_frenzy, hipe, + load_traced_nif, binaries, get_string, get_atom, maps, api_macros, from_array, iolist_as_binary, resource, resource_binary, threading, send, send2, send3, @@ -500,6 +502,47 @@ t_on_load(Config) when is_list(Config) -> verify_tmpmem(TmpMem), ok. +%% Test load of module where a NIF stub is already traced. +load_traced_nif(Config) when is_list(Config) -> + TmpMem = tmpmem(), + + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "nif_mod"), + {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), + {module,nif_mod} = erlang:load_module(nif_mod,Bin), + + Tracee = spawn_link(fun Loop() -> receive {lib_version,ExpRet} -> + ExpRet = nif_mod:lib_version() + end, + Loop() + end), + 1 = erlang:trace_pattern({nif_mod,lib_version,0}, true, [local]), + 1 = erlang:trace(Tracee, true, [call]), + + Tracee ! {lib_version, undefined}, + {trace, Tracee, call, {nif_mod,lib_version,[]}} = receive_any(1000), + + ok = nif_mod:load_nif_lib(Config, 1), + + Tracee ! {lib_version, 1}, + {trace, Tracee, call, {nif_mod,lib_version,[]}} = receive_any(1000), + + %% Wait for NIF loading to finish and write final call_nif instruction + timer:sleep(500), + + Tracee ! {lib_version, 1}, + {trace, Tracee, call, {nif_mod,lib_version,[]}} = receive_any(1000), + + true = erlang:delete_module(nif_mod), + true = erlang:purge_module(nif_mod), + + unlink(Tracee), + exit(Tracee, kill), + + verify_tmpmem(TmpMem), + ok. + + -define(ERL_NIF_SELECT_READ, (1 bsl 0)). -define(ERL_NIF_SELECT_WRITE, (1 bsl 1)). -define(ERL_NIF_SELECT_STOP, (1 bsl 2)). @@ -2520,26 +2563,7 @@ dummy_call(_) -> ok. tmpmem() -> - case erlang:system_info({allocator,temp_alloc}) of - false -> undefined; - MemInfo -> - MSBCS = lists:foldl( - fun ({instance, 0, _}, Acc) -> - Acc; % Ignore instance 0 - ({instance, _, L}, Acc) -> - {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), - {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), - [MBCS,SBCS | Acc] - end, - [], - MemInfo), - lists:foldl( - fun(L, {Bl0,BlSz0}) -> - {value,{_,Bl,_,_}} = lists:keysearch(blocks, 1, L), - {value,{_,BlSz,_,_}} = lists:keysearch(blocks_size, 1, L), - {Bl0+Bl,BlSz0+BlSz} - end, {0,0}, MSBCS) - end. + erts_debug:alloc_blocks_size(temp_alloc). verify_tmpmem(MemInfo) -> %%wait_for_test_procs(), diff --git a/erts/emulator/test/nif_SUITE_data/Makefile.src b/erts/emulator/test/nif_SUITE_data/Makefile.src index de06026780..69dd2d6757 100644 --- a/erts/emulator/test/nif_SUITE_data/Makefile.src +++ b/erts/emulator/test/nif_SUITE_data/Makefile.src @@ -24,7 +24,8 @@ tsd@dll@: tester.c testcase_driver.h DRIVER_DIR = ../erl_drv_thread_SUITE_data +WSL=@WSL@ + basic.c rwlock.c tsd.c: $(DRIVER_DIR)/$@ - cat head.txt > $@ - cat $(DRIVER_DIR)/$@ | sed -e 's/erl_drv_/enif_/g' -e 's/driver_/enif_/g' -e 's/ErlDrv/ErlNif/g' >> $@ - cat tail.txt >> $@ + $(WSL) sed -e 's/erl_drv_/enif_/g' -e 's/driver_/enif_/g' -e 's/ErlDrv/ErlNif/g' $(DRIVER_DIR)/$@ > $@.tmp + $(WSL) cat head.txt $@.tmp tail.txt > $@ diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index ff47cfe500..f4bb1504b8 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -3634,7 +3634,6 @@ static ErlNifFunc nif_funcs[] = {"release_resource", 1, release_resource}, {"release_resource_from_thread", 1, release_resource_from_thread}, {"last_resource_dtor_call_nif", 0, last_resource_dtor_call_nif}, - {"make_new_resource", 2, make_new_resource}, {"check_is", 11, check_is}, {"check_is_exception", 0, check_is_exception}, {"length_test", 6, length_test}, diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h index 4b2b7550e5..90ed8da0b6 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h +++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h @@ -164,11 +164,7 @@ extern TWinDynNifCallbacks WinDynNifCallbacks; #else # define ERL_NIF_INIT_GLOB # define ERL_NIF_INIT_BODY -# if defined(VXWORKS) -# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _init(void) -# else # define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* nif_init(void) -# endif #endif diff --git a/erts/emulator/test/nofrag_SUITE.erl b/erts/emulator/test/nofrag_SUITE.erl index 8b1519ae36..d4c74579e2 100644 --- a/erts/emulator/test/nofrag_SUITE.erl +++ b/erts/emulator/test/nofrag_SUITE.erl @@ -22,6 +22,11 @@ -include_lib("common_test/include/ct.hrl"). +%% This suite alters the return values of functions which breaks certain +%% assumptions made by the compiler, so we have to turn off module-level type +%% optimization to be safe. +-compile(no_module_opt). + -export([all/0, suite/0, error_handler/1,error_handler_apply/1, error_handler_fixed_apply/1,error_handler_fun/1, diff --git a/erts/emulator/test/persistent_term_SUITE.erl b/erts/emulator/test/persistent_term_SUITE.erl index c9874e5679..6682af489a 100644 --- a/erts/emulator/test/persistent_term_SUITE.erl +++ b/erts/emulator/test/persistent_term_SUITE.erl @@ -23,6 +23,7 @@ -export([all/0,suite/0,init_per_suite/1,end_per_suite/1, basic/1,purging/1,sharing/1,get_trapping/1, + destruction/1, info/1,info_trapping/1,killed_while_trapping/1, off_heap_values/1,keys/1,collisions/1, init_restart/1, put_erase_trapping/1, @@ -38,11 +39,13 @@ suite() -> all() -> [basic,purging,sharing,get_trapping,info,info_trapping, + destruction, killed_while_trapping,off_heap_values,keys,collisions, init_restart, put_erase_trapping, killed_while_trapping_put, killed_while_trapping_erase]. init_per_suite(Config) -> + erts_debug:set_internal_state(available_internal_state, true), %% Put a term in the dict so that we know that the testcases handle %% stray terms left by stdlib or other test suites. persistent_term:put(init_per_suite, {?MODULE}), @@ -50,6 +53,7 @@ init_per_suite(Config) -> end_per_suite(Config) -> persistent_term:erase(init_per_suite), + erts_debug:set_internal_state(available_internal_state, false), Config. basic(_Config) -> @@ -152,19 +156,25 @@ purging_tester(Parent, Key) -> receive {Parent,erased} -> {'EXIT',{badarg,_}} = (catch persistent_term:get(Key)), - purging_tester_1(Term); + purging_tester_1(Term, 1); {Parent,replaced} -> {?MODULE,new} = persistent_term:get(Key), - purging_tester_1(Term) + purging_tester_1(Term, 1) end. %% Wait for the term to be copied into this process. -purging_tester_1(Term) -> +purging_tester_1(Term, Timeout) -> purging_check_term(Term), - receive after 1 -> ok end, + receive after Timeout -> ok end, case erts_debug:size_shared(Term) of 0 -> - purging_tester_1(Term); + case Timeout of + 1000 -> + flush_later_ops(), + purging_tester_1(Term, 1); + _ -> + purging_tester_1(Term, Timeout*10) + end; Size -> %% The term has been copied into this process. purging_check_term(Term), @@ -174,6 +184,83 @@ purging_tester_1(Term) -> purging_check_term({term,[<<"abc",0:777/unit:8>>]}) -> ok. +%% Make sure terms are really deallocated when overwritten or erased. +destruction(Config) -> + ok = erts_test_destructor:init(Config), + + NKeys = 100, + Keys = lists:seq(0,NKeys-1), + [begin + V = erts_test_destructor:send(self(), K), + persistent_term:put({?MODULE,K}, V) + end + || K <- Keys], + + %% Erase or overwrite all keys in "random" order. + lists:foldl(fun(_, K) -> + case erlang:phash2(K) band 1 of + 0 -> + %%io:format("erase key ~p\n", [K]), + persistent_term:erase({?MODULE,K}); + 1 -> + %%io:format("replace key ~p\n", [K]), + persistent_term:put({?MODULE,K}, value) + end, + (K + 13) rem NKeys + end, + 17, Keys), + + destruction_1(Keys). + +destruction_1(Keys) -> + erlang:garbage_collect(), + + %% Receive all destruction messages + MsgLst = destruction_recv(length(Keys), [], 2), + ok = case lists:sort(MsgLst) of + Keys -> + ok; + _ -> + io:format("GOT ~p\n", [MsgLst]), + io:format("MISSING ~p\n", [Keys -- MsgLst]), + error + end, + + %% Cleanup all remaining + [persistent_term:erase({?MODULE,K}) || K <- Keys], + ok. + +destruction_recv(0, Acc, _) -> + Acc; +destruction_recv(N, Acc, Flush) -> + receive M -> + destruction_recv(N-1, [M | Acc], Flush) + after 1000 -> + io:format("TIMEOUT. Missing ~p destruction messages.\n", [N]), + case Flush of + 0 -> + Acc; + _ -> + io:format("Try flush last literal area cleanup...\n"), + flush_later_ops(), + destruction_recv(N, Acc, Flush-1) + end + end. + +%% Both persistent_term itself and erts_literal_are_collector use +%% erts_schedule_thr_prgr_later_cleanup_op() to schedule purge and deallocation +%% of literals. To avoid waiting forever on sleeping schedulers we flush +%% all later ops to make these cleanup jobs go through. +flush_later_ops() -> + try + erts_debug:set_internal_state(wait, thread_progress) + catch + error:system_limit -> + ok % already ongoing; called by other process + end, + ok. + + %% Test that sharing is preserved when storing terms. sharing(_Config) -> @@ -517,17 +604,12 @@ colliding_keys() -> %% Verify that the keys still collide (this will fail if the %% internal hash function has been changed). - erts_debug:set_internal_state(available_internal_state, true), - try - case erlang:system_info(wordsize) of - 8 -> - verify_colliding_keys(L); - 4 -> - %% Not guaranteed to collide on a 32-bit system. - ok - end - after - erts_debug:set_internal_state(available_internal_state, false) + case erlang:system_info(wordsize) of + 8 -> + verify_colliding_keys(L); + 4 -> + %% Not guaranteed to collide on a 32-bit system. + ok end, L. @@ -611,19 +693,25 @@ chk({Info, _Initial} = Chk) -> ok = persistent_term:put(Key, {term,Info}), Term = persistent_term:get(Key), true = persistent_term:erase(Key), - chk_not_stuck(Term), + chk_not_stuck(Term, 1), [persistent_term:erase(K) || {K, _} <- pget(Chk)], ok. -chk_not_stuck(Term) -> +chk_not_stuck(Term, Timeout) -> %% Hash tables to be deleted are put onto a queue. %% Make sure that the queue isn't stuck by a table with %% a non-zero ref count. case erts_debug:size_shared(Term) of 0 -> - erlang:yield(), - chk_not_stuck(Term); + receive after Timeout -> ok end, + case Timeout of + 1000 -> + flush_later_ops(), + chk_not_stuck(Term, 1); + _ -> + chk_not_stuck(Term, Timeout*10) + end; _ -> ok end. @@ -633,7 +721,6 @@ pget({_, Initial}) -> killed_while_trapping_put(_Config) -> - erts_debug:set_internal_state(available_internal_state, true), repeat( fun() -> NrOfPutsInChild = 10000, @@ -647,10 +734,9 @@ killed_while_trapping_put(_Config) -> do_erases(NrOfPutsInChild) end, 10), - erts_debug:set_internal_state(available_internal_state, false). + ok. killed_while_trapping_erase(_Config) -> - erts_debug:set_internal_state(available_internal_state, true), repeat( fun() -> NrOfErases = 2500, @@ -664,15 +750,14 @@ killed_while_trapping_erase(_Config) -> do_erases(NrOfErases) end, 10), - erts_debug:set_internal_state(available_internal_state, false). + ok. put_erase_trapping(_Config) -> NrOfItems = 5000, - erts_debug:set_internal_state(available_internal_state, true), do_puts(NrOfItems, first), do_puts(NrOfItems, second), do_erases(NrOfItems), - erts_debug:set_internal_state(available_internal_state, false). + ok. do_puts(0, _) -> ok; do_puts(NrOfPuts, ValuePrefix) -> diff --git a/erts/emulator/test/persistent_term_SUITE_data/Makefile.src b/erts/emulator/test/persistent_term_SUITE_data/Makefile.src new file mode 100644 index 0000000000..29b7fcb647 --- /dev/null +++ b/erts/emulator/test/persistent_term_SUITE_data/Makefile.src @@ -0,0 +1,8 @@ + +NIF_LIBS = erts_test_destructor@dll@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ + +$(NIF_LIBS): erts_test_destructor.c diff --git a/erts/emulator/test/persistent_term_SUITE_data/erts_test_destructor.c b/erts/emulator/test/persistent_term_SUITE_data/erts_test_destructor.c new file mode 100644 index 0000000000..808334f1c4 --- /dev/null +++ b/erts/emulator/test/persistent_term_SUITE_data/erts_test_destructor.c @@ -0,0 +1,83 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2019. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ +#include <erl_nif.h> + +#include <stdio.h> + + +static ErlNifResourceType* resource_type; +static void resource_dtor(ErlNifEnv* env, void* obj); + +typedef struct { + ErlNifPid to; + ERL_NIF_TERM msg; + ErlNifEnv* msg_env; +} DtorSender; + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + resource_type = enif_open_resource_type(env,NULL,"DtorSender",resource_dtor, + ERL_NIF_RT_CREATE, NULL); + return 0; +} + +static ERL_NIF_TERM is_loaded_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_make_atom(env, "true"); +} + +static ERL_NIF_TERM send_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + DtorSender *p; + ErlNifPid pid; + ERL_NIF_TERM res; + + p = enif_alloc_resource(resource_type, sizeof(DtorSender)); + + if (!enif_get_local_pid(env, argv[0], &p->to)) { + p->msg_env = NULL; + enif_release_resource(p); + return enif_make_badarg(env); + } + p->msg_env = enif_alloc_env(); + p->msg = enif_make_copy(p->msg_env, argv[1]); + res = enif_make_resource(env, p); + enif_release_resource(p); + return res; +} + +static void resource_dtor(ErlNifEnv* env, void* obj) +{ + DtorSender *p = (DtorSender*)obj; + + if (p->msg_env) { + enif_send(env, &p->to, p->msg_env, p->msg); + enif_free(p->msg_env); + } +} + + +static ErlNifFunc nif_funcs[] = +{ + {"is_loaded", 0, is_loaded_nif}, + {"send", 2, send_nif} +}; + +ERL_NIF_INIT(erts_test_destructor,nif_funcs,load,NULL,NULL,NULL) diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index eb9b94a316..8a67bf7512 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1052,7 +1052,9 @@ huge_env(Config) when is_list(Config) -> %% Test to spawn program with command payload buffer %% just around pipe capacity (9f779819f6bda734c5953468f7798) pipe_limit_env(Config) when is_list(Config) -> + WSL = os:getenv("WSLENV") =/= false, Cmd = case os:type() of + {win32,_} when WSL -> "cmd.exe /q /c wsl true"; {win32,_} -> "cmd /q /c true"; _ -> "true" end, @@ -1706,7 +1708,11 @@ spawn_executable(Config) when is_list(Config) -> ok. unregister_name(Config) when is_list(Config) -> - true = register(crash, open_port({spawn, "sleep 100"}, [])), + Cmd = case os:getenv("WSLENV") of + false -> "sleep 5"; + _ -> "wsl.exe sleep 5" + end, + true = register(crash, open_port({spawn, Cmd}, [])), true = unregister(crash). test_bat_file(Dir) -> diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 0e1c15e160..a6210a3ca2 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -63,13 +63,24 @@ system_task_failed_enqueue/1, gc_request_when_gc_disabled/1, gc_request_blast_when_gc_disabled/1, - otp_16436/1]). + otp_16436/1, + spawn_huge_arglist/1, + spawn_request_bif/1, + spawn_request_monitor_demonitor/1, + spawn_request_monitor_child_exit/1, + spawn_request_link_child_exit/1, + spawn_request_link_parent_exit/1, + spawn_request_abandon_bif/1, + dist_spawn_monitor/1, + spawn_old_node/1, + spawn_new_node/1, + spawn_request_reply_option/1]). -export([prio_server/2, prio_client/2, init/1, handle_event/2]). -export([init_per_testcase/2, end_per_testcase/2]). -export([hangaround/2, processes_bif_test/0, do_processes/1, - processes_term_proc_list_test/1]). + processes_term_proc_list_test/1, huge_arglist_child/255]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -90,7 +101,19 @@ all() -> bump_reductions, low_prio, yield, yield2, otp_4725, bad_register, garbage_collect, process_info_messages, process_flag_badarg, process_flag_heap_size, - spawn_opt_heap_size, spawn_opt_max_heap_size, otp_6237, + spawn_opt_heap_size, spawn_opt_max_heap_size, + spawn_huge_arglist, + spawn_request_bif, + spawn_request_monitor_demonitor, + spawn_request_monitor_child_exit, + spawn_request_link_child_exit, + spawn_request_link_parent_exit, + spawn_request_abandon_bif, + dist_spawn_monitor, + spawn_old_node, + spawn_new_node, + spawn_request_reply_option, + otp_6237, {group, processes_bif}, {group, otp_7738}, garb_other_running, {group, system_task}]. @@ -2250,7 +2273,7 @@ max_heap_size_test(Option, Size, Kill, ErrorLogger) when is_map(Option); is_integer(Option) -> max_heap_size_test([{max_heap_size, Option}], Size, Kill, ErrorLogger); max_heap_size_test(Option, Size, Kill, ErrorLogger) -> - OomFun = fun F() -> timer:sleep(5),[lists:seq(1,1000)|F()] end, + OomFun = fun () -> oom_fun([]) end, Pid = spawn_opt(OomFun, Option), {max_heap_size, MHSz} = erlang:process_info(Pid, max_heap_size), ct:log("Default: ~p~nOption: ~p~nProc: ~p~n", @@ -2293,6 +2316,13 @@ max_heap_size_test(Option, Size, Kill, ErrorLogger) -> %% Make sure that there are no unexpected messages. receive_unexpected(). +oom_fun(Acc0) -> + %% This is tail-recursive since the compiler is smart enough to figure + %% out that a body-recursive variant never returns, and loops forever + %% without keeping the list alive. + timer:sleep(5), + oom_fun([lists:seq(1, 1000) | Acc0]). + receive_error_messages(Pid) -> receive {error, _, {emulator, _, [Pid|_]}} -> @@ -2327,6 +2357,959 @@ handle_event(Event, Pid) -> Pid ! Event, {ok, Pid}. +huge_arglist_child(A0, A1, A2, A3, A4, A5, A6, A7, A8, A9, + A10, A11, A12, A13, A14, A15, A16, A17, A18, A19, + A20, A21, A22, A23, A24, A25, A26, A27, A28, A29, + A30, A31, A32, A33, A34, A35, A36, A37, A38, A39, + A40, A41, A42, A43, A44, A45, A46, A47, A48, A49, + A50, A51, A52, A53, A54, A55, A56, A57, A58, A59, + A60, A61, A62, A63, A64, A65, A66, A67, A68, A69, + A70, A71, A72, A73, A74, A75, A76, A77, A78, A79, + A80, A81, A82, A83, A84, A85, A86, A87, A88, A89, + A90, A91, A92, A93, A94, A95, A96, A97, A98, A99, + A100, A101, A102, A103, A104, A105, A106, A107, A108, A109, + A110, A111, A112, A113, A114, A115, A116, A117, A118, A119, + A120, A121, A122, A123, A124, A125, A126, A127, A128, A129, + A130, A131, A132, A133, A134, A135, A136, A137, A138, A139, + A140, A141, A142, A143, A144, A145, A146, A147, A148, A149, + A150, A151, A152, A153, A154, A155, A156, A157, A158, A159, + A160, A161, A162, A163, A164, A165, A166, A167, A168, A169, + A170, A171, A172, A173, A174, A175, A176, A177, A178, A179, + A180, A181, A182, A183, A184, A185, A186, A187, A188, A189, + A190, A191, A192, A193, A194, A195, A196, A197, A198, A199, + A200, A201, A202, A203, A204, A205, A206, A207, A208, A209, + A210, A211, A212, A213, A214, A215, A216, A217, A218, A219, + A220, A221, A222, A223, A224, A225, A226, A227, A228, A229, + A230, A231, A232, A233, A234, A235, A236, A237, A238, A239, + A240, A241, A242, A243, A244, A245, A246, A247, A248, A249, + A250, A251, A252, A253, A254) -> + receive go -> ok end, + exit([A0, A1, A2, A3, A4, A5, A6, A7, A8, A9, + A10, A11, A12, A13, A14, A15, A16, A17, A18, A19, + A20, A21, A22, A23, A24, A25, A26, A27, A28, A29, + A30, A31, A32, A33, A34, A35, A36, A37, A38, A39, + A40, A41, A42, A43, A44, A45, A46, A47, A48, A49, + A50, A51, A52, A53, A54, A55, A56, A57, A58, A59, + A60, A61, A62, A63, A64, A65, A66, A67, A68, A69, + A70, A71, A72, A73, A74, A75, A76, A77, A78, A79, + A80, A81, A82, A83, A84, A85, A86, A87, A88, A89, + A90, A91, A92, A93, A94, A95, A96, A97, A98, A99, + A100, A101, A102, A103, A104, A105, A106, A107, A108, A109, + A110, A111, A112, A113, A114, A115, A116, A117, A118, A119, + A120, A121, A122, A123, A124, A125, A126, A127, A128, A129, + A130, A131, A132, A133, A134, A135, A136, A137, A138, A139, + A140, A141, A142, A143, A144, A145, A146, A147, A148, A149, + A150, A151, A152, A153, A154, A155, A156, A157, A158, A159, + A160, A161, A162, A163, A164, A165, A166, A167, A168, A169, + A170, A171, A172, A173, A174, A175, A176, A177, A178, A179, + A180, A181, A182, A183, A184, A185, A186, A187, A188, A189, + A190, A191, A192, A193, A194, A195, A196, A197, A198, A199, + A200, A201, A202, A203, A204, A205, A206, A207, A208, A209, + A210, A211, A212, A213, A214, A215, A216, A217, A218, A219, + A220, A221, A222, A223, A224, A225, A226, A227, A228, A229, + A230, A231, A232, A233, A234, A235, A236, A237, A238, A239, + A240, A241, A242, A243, A244, A245, A246, A247, A248, A249, + A250, A251, A252, A253, A254]). + +spawn_huge_arglist(Config) when is_list(Config) -> + %% Huge in two different ways; encoded size and + %% length... + ArgListHead = [make_ref(), + lists:duplicate(1000000, $a), + <<1:8388608>>, + processes(), + erlang:ports(), + {hej, hopp}, + <<17:8388608>>, + lists:duplicate(3000000, $x), + #{ a => 1, b => 2, c => 3, d => 4, e => 5}], + ArgList = ArgListHead ++ lists:seq(1, 255 - length(ArgListHead)), + + io:format("size(term_to_binary(ArgList)) = ~p~n", + [size(term_to_binary(ArgList))]), + + io:format("Testing spawn with huge argument list on local node...~n", []), + spawn_huge_arglist_test(true, node(), ArgList), + io:format("Testing spawn with huge argument list on local node with Node...~n", []), + spawn_huge_arglist_test(false, node(), ArgList), + {ok, Node} = start_node(Config), + _ = rpc:call(Node, ?MODULE, module_info, []), + io:format("Testing spawn with huge argument list on remote node ~p...~n", [Node]), + spawn_huge_arglist_test(false, Node, ArgList), + stop_node(Node), + ok. + +spawn_huge_arglist_test(Local, Node, ArgList) -> + + R1 = case Local of + true -> + spawn_request(?MODULE, huge_arglist_child, ArgList, [monitor]); + false -> + spawn_request(Node, ?MODULE, huge_arglist_child, ArgList, [monitor]) + end, + receive + {spawn_reply, R1, ok, Pid1} -> + Pid1 ! go, + receive + {'DOWN', R1, process, Pid1, Reason1} -> + ArgList = Reason1 + end + end, + + {Pid2, R2} = case Local of + true -> + spawn_monitor(?MODULE, huge_arglist_child, ArgList); + false -> + spawn_monitor(Node, ?MODULE, huge_arglist_child, ArgList) + end, + Node = node(Pid2), + Pid2 ! go, + receive + {'DOWN', R2, process, Pid2, Reason2} -> + ArgList = Reason2 + end, + + {Pid3, R3} = case Local of + true -> + spawn_opt(?MODULE, huge_arglist_child, ArgList, [monitor]); + false -> + spawn_opt(Node, ?MODULE, huge_arglist_child, ArgList, [monitor]) + end, + Node = node(Pid3), + Pid3 ! go, + receive + {'DOWN', R3, process, Pid3, Reason3} -> + ArgList = Reason3 + end, + + OldTA = process_flag(trap_exit, true), + Pid4 = case Local of + true -> + spawn_link(?MODULE, huge_arglist_child, ArgList); + false -> + spawn_link(Node, ?MODULE, huge_arglist_child, ArgList) + end, + Node = node(Pid4), + Pid4 ! go, + receive + {'EXIT', Pid4, Reason4} -> + ArgList = Reason4 + end, + + true = process_flag(trap_exit, OldTA), + + Pid5 = case Local of + true -> + spawn(?MODULE, huge_arglist_child, ArgList); + false -> + spawn(Node, ?MODULE, huge_arglist_child, ArgList) + end, + Node = node(Pid5), + R5 = erlang:monitor(process, Pid5), + Pid5 ! go, + receive + {'DOWN', R5, process, Pid5, Reason5} -> + ArgList = Reason5 + end, + ok. + +spawn_request_bif(Config) when is_list(Config) -> + io:format("Testing spawn_request() on local node...~n", []), + spawn_request_bif_test(true, node()), + io:format("Testing spawn_request() on local node with Node...~n", []), + spawn_request_bif_test(false, node()), + {ok, Node} = start_node(Config), + io:format("Testing spawn_request() on remote node ~p...~n", [Node]), + spawn_request_bif_test(false, Node), + stop_node(Node), + ok. + +spawn_request_bif_test(Local, Node) -> + + Me = self(), + + process_flag(trap_exit, true), + + T1 = {test, 1}, + F1 = fun () -> exit({exit, T1}) end, + R1 = if Local -> + spawn_request(F1, [{reply_tag, T1}, monitor, link]); + true -> + spawn_request(Node, F1, [{reply_tag, T1}, monitor, link]) + end, + receive + {T1, R1, ok, P1} -> + receive + {'DOWN', R1, process, P1, {exit, T1}} -> + ok + end, + receive + {'EXIT', P1, {exit, T1}} -> + ok + end + end, + + R1b = if Local -> + spawn_request(F1, [monitor, link]); + true -> + spawn_request(Node, F1, [monitor, link]) + end, + receive + {spawn_reply, R1b, ok, P1b} -> + receive + {'DOWN', R1b, process, P1b, {exit, T1}} -> + ok + end, + receive + {'EXIT', P1b, {exit, T1}} -> + ok + end + end, + + Ref1c = make_ref(), + F1c = fun () -> Me ! Ref1c end, + R1c = if Local -> + spawn_request(F1c); + true -> + spawn_request(Node, F1c) + end, + receive + {spawn_reply, R1c, ok, _P1c} -> + receive Ref1c -> ok end + end, + + R1e = if Local -> + spawn_request(F1, [monitors, links, {reply_tag, T1}]); + true -> + spawn_request(Node, F1, [monitors, links, {reply_tag, T1}]) + end, + receive + {T1, R1e, error, BadOpt1} -> + badopt = BadOpt1, + ok + end, + ok = try + BadF = fun (X) -> exit({X,T1}) end, + if Local -> + spawn_request(BadF, [monitor, {reply_tag, T1}, link]); + true -> + spawn_request(Node, BadF, [monitor, {reply_tag, T1}, link]) + end, + nok + catch + error:badarg -> ok + end, + ok = try + spawn_request(<<"node">>, F1, [monitor, link], T1), + nok + catch + error:badarg -> ok + end, + + T2 = {test, 2}, + M2 = erlang, + F2 = exit, + Reason2 = {exit, T2}, + Args2 = [Reason2], + R2 = if Local -> + spawn_request(M2, F2, Args2, [monitor, link, {reply_tag, T2}]); + true -> + spawn_request(Node, M2, F2, Args2, [monitor, link, {reply_tag, T2}]) + end, + receive + {T2, R2, ok, P2} -> + receive + {'DOWN', R2, process, P2, Reason2} -> + ok + end, + receive + {'EXIT', P2, Reason2} -> + ok + end + end, + + R2b = if Local -> + spawn_request(M2, F2, Args2, [monitor, link]); + true -> + spawn_request(Node, M2, F2, Args2, [monitor, link]) + end, + receive + {spawn_reply, R2b, ok, P2b} -> + receive + {'DOWN', R2b, process, P2b, Reason2} -> + ok + end, + receive + {'EXIT', P2b, Reason2} -> + ok + end + end, + + Ref2c = make_ref(), + R2c = if Local -> + spawn_request(erlang, send, [Me, Ref2c]); + true -> + spawn_request(Node, erlang, send, [Me, Ref2c]) + end, + receive + {spawn_reply, R2c, ok, _P2c} -> + receive Ref2c -> ok end + end, + + R2e = if Local -> + spawn_request(M2, F2, Args2, [monitors, {reply_tag, T2}, links]); + true -> + spawn_request(Node, M2, F2, Args2, [monitors, {reply_tag, T2}, links]) + end, + receive + {T2, R2e, error, BadOpt2} -> + badopt = BadOpt2, + ok + end, + + R2eb = if Local -> + spawn_request(M2, F2, Args2, [monitors, links]); + true -> + spawn_request(Node, M2, F2, Args2, [monitors, links]) + end, + receive + {spawn_reply, R2eb, error, BadOpt2b} -> + badopt = BadOpt2b, + ok + end, + + ok = try + if Local -> + spawn_request(M2, F2, [Args2|oops], [monitor, link, {reply_tag, T2}]); + true -> + spawn_request(Node, M2, F2, [Args2|oops], [monitor, link, {reply_tag, T2}]) + end, + nok + catch + error:badarg -> ok + end, + ok = try + if Local -> + spawn_request(M2, F2, [Args2|oops], [monitor, {reply_tag, blupp}, link]); + true -> + spawn_request(Node, M2, F2, [Args2|oops], [monitor, {reply_tag, blupp}, link]) + end, + nok + catch + error:badarg -> ok + end, + ok = try + if Local -> + spawn_request(M2, F2, [Args2|oops]); + true -> + spawn_request(Node, M2, F2, [Args2|oops]) + end, + nok + catch + error:badarg -> ok + end, + ok = try + if Local -> + spawn_request(M2, <<"exit">>, Args2, [monitor, {reply_tag, T2}, link]); + true -> + spawn_request(Node, M2, <<"exit">>, Args2, [monitor, {reply_tag, T2}, link]) + end, + nok + catch + error:badarg -> ok + end, + ok = try + if Local -> + spawn_request(M2, <<"exit">>, Args2, [monitor, link]); + true -> + spawn_request(Node, M2, <<"exit">>, Args2, [monitor, link]) + end, + nok + catch + error:badarg -> ok + end, + ok = try + if Local -> + spawn_request(M2, <<"exit">>, Args2); + true -> + spawn_request(Node, M2, <<"exit">>, Args2) + end, + nok + catch + error:badarg -> ok + end, + ok = try + if Local -> + spawn_request(<<"erlang">>, F2, Args2, [{reply_tag, T2}, monitor, link]); + true -> + spawn_request(Node, <<"erlang">>, F2, Args2, [{reply_tag, T2}, monitor, link]) + end, + nok + catch + error:badarg -> ok + end, + ok = try + if Local -> + spawn_request(<<"erlang">>, F2, Args2, [monitor, link]); + true -> + spawn_request(Node, <<"erlang">>, F2, Args2, [monitor, link]) + end, + nok + catch + error:badarg -> ok + end, + ok = try + if Local -> + spawn_request(<<"erlang">>, F2, Args2); + true -> + spawn_request(Node, <<"erlang">>, F2, Args2) + end, + nok + catch + error:badarg -> ok + end, + ok = try + spawn_request(<<"node">>, M2, F2, Args2, [{reply_tag, T2}, monitor, link]), + nok + catch + error:badarg -> ok + end, + ok = try + spawn_request(<<"node">>, M2, F2, Args2, [monitor, link]), + nok + catch + error:badarg -> ok + end, + ok = try + spawn_request(<<"node">>, M2, F2, Args2), + nok + catch + error:badarg -> ok + end, + ok. + + +spawn_request_monitor_demonitor(Config) when is_list(Config) -> + {ok, Node} = start_node(Config), + BlockFun = fun () -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(block, 1000), + ok + end, + + %% Block receiver node... + spawn_request(Node, BlockFun, [{priority,max}, link]), + receive after 100 -> ok end, + + erlang:display(spawning), + erlang:yield(), + R = spawn_request(Node, timer, sleep, [10000], [monitor]), + %% Should not be possible to demonitor + %% before operation has succeeded... + erlang:display(premature_demonitor), + {monitors, []} = process_info(self(), monitors), + false = erlang:demonitor(R, [info]), %% Should be ignored by VM... + erlang:display(wait_success), + receive + {spawn_reply, R, ok, P} -> + erlang:display(demonitor), + {monitors, [{process,P}]} = process_info(self(), monitors), + true = erlang:demonitor(R, [info]), + {monitors, []} = process_info(self(), monitors), + exit(P, kill) + end, + erlang:display(done), + stop_node(Node), + ok. + +spawn_request_monitor_child_exit(Config) when is_list(Config) -> + %% Early child exit... + Tag = {a, tag}, + R1 = spawn_request(nonexisting_module, nonexisting_function, [], [monitor, {reply_tag, Tag}]), + receive + {Tag, R1, ok, P1} -> + receive + {'DOWN', R1, process, P1, Reason1} -> + {undef, _} = Reason1 + end + end, + {ok, Node} = start_node(Config), + R2 = spawn_request(Node, nonexisting_module, nonexisting_function, [], [{reply_tag, Tag}, monitor]), + receive + {Tag, R2, ok, P2} -> + receive + {'DOWN', R2, process, P2, Reason2} -> + {undef, _} = Reason2 + end + end, + stop_node(Node), + ok. + +spawn_request_link_child_exit(Config) when is_list(Config) -> + %% Early child exit... + process_flag(trap_exit, true), + Tag = {a, tag}, + R1 = spawn_request(nonexisting_module, nonexisting_function, [], [{reply_tag, Tag}, link]), + receive + {Tag, R1, ok, P1} -> + receive + {'EXIT', P1, Reason1} -> + {undef, _} = Reason1 + end + end, + {ok, Node} = start_node(Config), + R2 = spawn_request(Node, nonexisting_module, nonexisting_function, [], [link, {reply_tag, Tag}]), + receive + {Tag, R2, ok, P2} -> + receive + {'EXIT', P2, Reason2} -> + {undef, _} = Reason2 + end + end, + stop_node(Node), + ok. + +spawn_request_link_parent_exit(Config) when is_list(Config) -> + C1 = spawn_request_link_parent_exit_test(node()), + {ok, Node} = start_node(Config), + C2 = spawn_request_link_parent_exit_test(Node), + stop_node(Node), + {comment, C1 ++ " " ++ C2}. + +spawn_request_link_parent_exit_test(Node) -> + %% Early parent exit... + Tester = self(), + + verify_nc(node()), + + %% Ensure code loaded on other node... + _ = rpc:call(Node, ?MODULE, module_info, []), + + ChildFun = fun () -> + Child = self(), + spawn_opt(fun () -> + process_flag(trap_exit, true), + receive + {'EXIT', Child, Reason} -> + Tester ! {parent_exit, Reason} + end + end, [link,{priority,max}]), + receive after infinity -> ok end + end, + ParentFun = case node() == Node of + true -> + fun (Wait) -> + spawn_request(ChildFun, [link,{priority,max}]), + receive after Wait -> ok end, + exit(kaboom) + end; + false -> + fun (Wait) -> + spawn_request(Node, ChildFun, [link,{priority,max}]), + receive after Wait -> ok end, + exit(kaboom) + end + end, + lists:foreach(fun (N) -> + spawn(fun () -> ParentFun(N rem 10) end) + end, + lists:seq(1, 1000)), + N = gather_parent_exits(kaboom, false), + Comment = case node() == Node of + true -> + C = "Got " ++ integer_to_list(N) ++ " node local kabooms!", + erlang:display(C), + C; + false -> + C = "Got " ++ integer_to_list(N) ++ " node remote kabooms!", + erlang:display(C), + true = N /= 0, + C + end, + Comment. + +spawn_request_abandon_bif(Config) when is_list(Config) -> + {ok, Node} = start_node(Config), + false = spawn_request_abandon(make_ref()), + false = spawn_request_abandon(spawn_request(fun () -> ok end)), + false = spawn_request_abandon(rpc:call(Node, erlang, make_ref, [])), + try + noreturn = spawn_request_abandon(self()) + catch + error:badarg -> + ok + end, + try + noreturn = spawn_request_abandon(4711) + catch + error:badarg -> + ok + end, + + verify_nc(node()), + + %% Ensure code loaded on other node... + _ = rpc:call(Node, ?MODULE, module_info, []), + + + TotOps = 1000, + Tester = self(), + + ChildFun = fun () -> + Child = self(), + spawn_opt(fun () -> + process_flag(trap_exit, true), + receive + {'EXIT', Child, Reason} -> + Tester ! {parent_exit, Reason} + end + end, [link,{priority,max}]), + receive after infinity -> ok end + end, + ParentFun = fun (Wait, Opts) -> + ReqId = spawn_request(Node, ChildFun, Opts), + receive after Wait -> ok end, + case spawn_request_abandon(ReqId) of + true -> + ok; + false -> + receive + {spawn_reply, ReqId, error, _} -> + exit(spawn_failed); + {spawn_reply, ReqId, ok, Pid} -> + unlink(Pid), + exit(Pid, bye) + after + 0 -> + exit(missing_spawn_reply) + end + end + end, + %% Parent exit early... + lists:foreach(fun (N) -> + spawn_opt(fun () -> + ParentFun(N rem 50, [link]) + end, [link,{priority,max}]) + end, + lists:seq(1, TotOps)), + NoA1 = gather_parent_exits(abandoned, true), + %% Parent exit late... + lists:foreach(fun (N) -> + spawn_opt(fun () -> + ParentFun(N rem 50, [link]), + receive + {spawn_reply, _, _, _} -> + exit(unexpected_spawn_reply) + after + 1000 -> ok + end + end, [link,{priority,max}]) + end, + lists:seq(1, TotOps)), + NoA2 = gather_parent_exits(abandoned, true), + %% Parent exit early... + lists:foreach(fun (N) -> + spawn_opt(fun () -> + ParentFun(N rem 50, []) + end, [link,{priority,max}]) + end, + lists:seq(1, TotOps)), + 0 = gather_parent_exits(abandoned, true), + %% Parent exit late... + lists:foreach(fun (N) -> + spawn_opt(fun () -> + ParentFun(N rem 50, []), + receive + {spawn_reply, _, _, _} -> + exit(unexpected_spawn_reply) + after + 1000 -> ok + end + end, [link,{priority,max}]) + end, + lists:seq(1, TotOps)), + 0 = gather_parent_exits(abandoned, true), + stop_node(Node), + C = "Got " ++ integer_to_list(NoA1) ++ " and " + ++ integer_to_list(NoA2) ++ " abandoneds of 2*" + ++ integer_to_list(TotOps) ++ " ops!", + erlang:display(C), + true = NoA1 /= 0, + true = NoA1 /= TotOps, + true = NoA2 /= 0, + true = NoA2 /= TotOps, + {comment, C}. + +gather_parent_exits(Reason, AllowOther) -> + receive after 2000 -> ok end, + gather_parent_exits(Reason, AllowOther, 0). + +gather_parent_exits(Reason, AllowOther, N) -> + receive + {parent_exit, Reason} -> + gather_parent_exits(Reason, AllowOther, N+1); + {parent_exit, _} = ParentExit -> + case AllowOther of + false -> + ct:fail(ParentExit); + true -> + gather_parent_exits(Reason, AllowOther, N) + end + after 0 -> + N + end. +dist_spawn_monitor(Config) when is_list(Config) -> + {ok, Node} = start_node(Config), + R1 = spawn_request(Node, erlang, exit, [hej], [monitor]), + receive + {spawn_reply, R1, ok, P1} -> + receive + {'DOWN', R1, process, P1, Reason1} -> + hej = Reason1 + end + end, + {P2, Mon2} = spawn_monitor(Node, erlang, exit, [hej]), + receive + {'DOWN', Mon2, process, P2, Reason2} -> + hej = Reason2 + end, + {P3, Mon3} = spawn_opt(Node, erlang, exit, [hej], [monitor]), + receive + {'DOWN', Mon3, process, P3, Reason3} -> + hej = Reason3 + end, + stop_node(Node), + ok. + +spawn_old_node(Config) when is_list(Config) -> + Cookie = atom_to_list(erlang:get_cookie()), + Rel = "22_latest", + case test_server:is_release_available(Rel) of + false -> + {skipped, "No OTP 22 available"}; + true -> + {ok, OldNode} = test_server:start_node(make_nodename(Config), + peer, + [{args, " -setcookie "++Cookie}, + {erl, [{release, Rel}]}]), + try + %% Spawns triggering a new connection; which + %% will trigger hopeful data transcoding + %% of spawn requests... + io:format("~n~nDoing initial connect tests...~n", []), + spawn_old_node_test(OldNode, true), + %% Spawns on an already existing connection... + io:format("~n~nDoing already connected tests...~n", []), + spawn_old_node_test(OldNode, false) + after + test_server:stop_node(OldNode) + end, + ok + end. + +spawn_new_node(Config) when is_list(Config) -> + Cookie = atom_to_list(erlang:get_cookie()), + %% Test that the same operations as in spawn_old_node test + %% works as expected on current OTP... + {ok, CurrNode} = test_server:start_node(make_nodename(Config), + peer, + [{args, " -setcookie "++Cookie}]), + try + %% Spawns triggering a new connection; which + %% will trigger hopeful data transcoding + %% of spawn requests... + io:format("~n~nDoing initial connect tests...~n", []), + spawn_current_node_test(CurrNode, true), + io:format("~n~nDoing already connected tests...~n", []), + %% Spawns on an already existing connection... + spawn_current_node_test(CurrNode, false) + after + test_server:stop_node(CurrNode) + end. + +disconnect_node(Node, Disconnect) -> + case Disconnect of + false -> + ok; + true -> + monitor_node(Node, true), + erlang:disconnect_node(Node), + receive {nodedown, Node} -> ok end + end. + +spawn_old_node_test(Node, Disconnect) -> + io:format("Testing spawn_request() on old node...", []), + disconnect_node(Node, Disconnect), + R1 = spawn_request(Node, erlang, exit, [hej], [monitor, {reply_tag, a_tag}]), + receive + {a_tag, R1, Err, Notsup} -> + error = Err, + notsup = Notsup, + ok + end, + io:format("Testing spawn_monitor() on old node...", []), + disconnect_node(Node, Disconnect), + try + spawn_monitor(Node, erlang, exit, [hej]) + catch + error:notsup -> + ok + end, + io:format("Testing spawn_opt() with monitor on old node...", []), + disconnect_node(Node, Disconnect), + try + spawn_opt(Node, erlang, exit, [hej], [monitor]) + catch + error:badarg -> + ok + end, + io:format("Testing spawn_opt() with link on old node...", []), + disconnect_node(Node, Disconnect), + process_flag(trap_exit, true), + P1 = spawn_opt(Node, erlang, exit, [hej], [link]), + Node = node(P1), + receive + {'EXIT', P1, hej} -> + ok + end, + io:format("Testing spawn_link() on old node...", []), + disconnect_node(Node, Disconnect), + P2 = spawn_link(Node, erlang, exit, [hej]), + Node = node(P2), + receive + {'EXIT', P2, hej} -> + ok + end. + +spawn_current_node_test(Node, Disconnect) -> + io:format("Testing spawn_request() on new node...", []), + disconnect_node(Node, Disconnect), + R1 = spawn_request(Node, erlang, exit, [hej], [monitor, {reply_tag, a_tag}]), + receive + {a_tag, R1, ok, P1} -> + Node = node(P1), + receive + {'DOWN', R1, process, P1, hej} -> ok + end + end, + io:format("Testing spawn_monitor() on new node...", []), + disconnect_node(Node, Disconnect), + {P2, M2} = spawn_monitor(Node, erlang, exit, [hej]), + receive + {'DOWN', M2, process, P2, hej} -> ok + end, + Node = node(P2), + io:format("Testing spawn_opt() with monitor on new node...", []), + disconnect_node(Node, Disconnect), + {P3, M3} = spawn_opt(Node, erlang, exit, [hej], [monitor]), + receive + {'DOWN', M3, process, P3, hej} -> ok + end, + Node = node(P3), + io:format("Testing spawn_opt() with link on new node...", []), + disconnect_node(Node, Disconnect), + process_flag(trap_exit, true), + P4 = spawn_opt(Node, erlang, exit, [hej], [link]), + Node = node(P4), + receive + {'EXIT', P4, hej} -> + ok + end, + io:format("Testing spawn_link() on new node...", []), + disconnect_node(Node, Disconnect), + P5 = spawn_link(Node, erlang, exit, [hej]), + Node = node(P5), + receive + {'EXIT', P5, hej} -> + ok + end. + +spawn_request_reply_option(Config) when is_list(Config) -> + spawn_request_reply_option_test(node()), + {ok, Node} = start_node(Config), + spawn_request_reply_option_test(Node). + +spawn_request_reply_option_test(Node) -> + io:format("Testing on node: ~p~n", [Node]), + Parent = self(), + Done1 = make_ref(), + RID1 = spawn_request(Node, fun () -> Parent ! Done1 end, [{reply, yes}]), + receive Done1 -> ok end, + receive + {spawn_reply, RID1, ok, _} -> ok + after 0 -> + ct:fail(missing_spawn_reply) + end, + Done2 = make_ref(), + RID2 = spawn_request(Node, fun () -> Parent ! Done2 end, [{reply, success_only}]), + receive Done2 -> ok end, + receive + {spawn_reply, RID2, ok, _} -> ok + after 0 -> + ct:fail(missing_spawn_reply) + end, + Done3 = make_ref(), + RID3 = spawn_request(Node, fun () -> Parent ! Done3 end, [{reply, error_only}]), + receive Done3 -> ok end, + receive + {spawn_reply, RID3, _, _} -> + ct:fail(unexpected_spawn_reply) + after 0 -> + ok + end, + Done4 = make_ref(), + RID4 = spawn_request(Node, fun () -> Parent ! Done4 end, [{reply, no}]), + receive Done4 -> ok end, + receive + {spawn_reply, RID4, _, _} -> + ct:fail(unexpected_spawn_reply) + after 0 -> + ok + end, + RID5 = spawn_request(Node, fun () -> ok end, [{reply, yes}, bad_option]), + receive + {spawn_reply, RID5, error, badopt} -> ok + end, + RID6 = spawn_request(Node, fun () -> ok end, [{reply, success_only}, bad_option]), + receive + {spawn_reply, RID6, error, badopt} -> ct:fail(unexpected_spawn_reply) + after 1000 -> ok + end, + RID7 = spawn_request(Node, fun () -> ok end, [{reply, error_only}, bad_option]), + receive + {spawn_reply, RID7, error, badopt} -> ok + end, + RID8 = spawn_request(Node, fun () -> ok end, [{reply, no}, bad_option]), + receive + {spawn_reply, RID8, error, badopt} -> ct:fail(unexpected_spawn_reply) + after 1000 -> ok + end, + case Node == node() of + true -> + ok; + false -> + stop_node(Node), + RID9 = spawn_request(Node, fun () -> ok end, [{reply, yes}]), + receive + {spawn_reply, RID9, error, noconnection} -> ok + end, + RID10 = spawn_request(Node, fun () -> ok end, [{reply, success_only}]), + receive + {spawn_reply, RID10, error, noconnection} -> ct:fail(unexpected_spawn_reply) + after 1000 -> ok + end, + RID11 = spawn_request(Node, fun () -> ok end, [{reply, error_only}]), + receive + {spawn_reply, RID11, error, noconnection} -> ok + end, + RID12 = spawn_request(Node, fun () -> ok end, [{reply, no}]), + receive + {spawn_reply, RID12, error, noconnection} -> ct:fail(unexpected_spawn_reply) + after 1000 -> ok + end, + ok + end. + processes_term_proc_list(Config) when is_list(Config) -> Tester = self(), @@ -2897,24 +3880,50 @@ tok_loop(hopp) -> tok_loop(hej). id(I) -> I. + +make_nodename(Config) when is_list(Config) -> + list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))). start_node(Config) -> start_node(Config, ""). start_node(Config, Args) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), - Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(proplists:get_value(testcase, Config)) - ++ "-" - ++ integer_to_list(erlang:system_time(second)) - ++ "-" - ++ integer_to_list(erlang:unique_integer([positive]))), + Name = make_nodename(Config), test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). stop_node(Node) -> + verify_nc(node()), + verify_nc(Node), test_server:stop_node(Node). +verify_nc(Node) -> + P = self(), + Ref = make_ref(), + Pid = spawn(Node, + fun() -> + R = erts_test_utils:check_node_dist(fun(E) -> E end), + P ! {Ref, R} + end), + MonRef = monitor(process, Pid), + receive + {Ref, ok} -> + demonitor(MonRef,[flush]), + ok; + {Ref, Error} -> + ct:log("~s",[Error]), + ct:fail(failed_nc_refc_check); + {'DOWN', MonRef, _, _, _} = Down -> + ct:log("~p",[Down]), + ct:fail(crashed_nc_refc_check) + end. + enable_internal_state() -> case catch erts_debug:get_internal_state(available_internal_state) of true -> true; diff --git a/erts/emulator/test/property_test/phash2_properties.erl b/erts/emulator/test/property_test/phash2_properties.erl new file mode 100644 index 0000000000..b1f3207c56 --- /dev/null +++ b/erts/emulator/test/property_test/phash2_properties.erl @@ -0,0 +1,63 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-2019. 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(phash2_properties). + +-ifdef(PROPER). + +-include_lib("proper/include/proper.hrl"). +-export([prop_phash2_same_with_same_input/0, + prop_phash2_same_with_same_long_input/0, + prop_phash2_same_in_different_versions/1, + prop_phash2_same_in_different_versions_with_long_input/1]). +-proptest([proper]). + +%%-------------------------------------------------------------------- +%% Properties -------------------------------------------------------- +%%-------------------------------------------------------------------- + +prop_phash2_same_with_same_input() -> + ?FORALL(T, any(), erlang:phash2(T) =:= erlang:phash2(T)). + +prop_phash2_same_with_same_long_input() -> + ?FORALL(T, any(), + begin + BigTerm = lists:duplicate(10000, T), + erlang:phash2(BigTerm) =:= erlang:phash2(BigTerm) + end). + +prop_phash2_same_in_different_versions(DifferntVersionNode) -> + ?FORALL(T, any(), + erlang:phash2(T) =:= rpc:call(DifferntVersionNode,erlang,phash2,[T])). + +prop_phash2_same_in_different_versions_with_long_input(DifferntVersionNode) -> + ?FORALL(T, any(), + begin + BigTerm = lists:duplicate(10000, T), + RpcRes = rpc:call(DifferntVersionNode,erlang,phash2,[BigTerm]), + LocalRes = erlang:phash2(BigTerm), + RpcRes =:= LocalRes + end). + +%%-------------------------------------------------------------------- +%% Generators ------------------------------------------------------- +%%-------------------------------------------------------------------- + +-endif. diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 59cf66d277..f477af1b5b 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -995,62 +995,81 @@ sct_cmd(Config) when is_list(Config) -> {"db", thread_no_node_processor_spread}]). sbt_cmd(Config) when is_list(Config) -> - Bind = try - OldVal = erlang:system_flag(scheduler_bind_type, default_bind), - erlang:system_flag(scheduler_bind_type, OldVal), - go_for_it - catch - error:notsup -> notsup; - error:_ -> go_for_it - end, - case Bind of - notsup -> - {skipped, "Binding of schedulers not supported"}; - go_for_it -> - CpuTCmd = case erlang:system_info({cpu_topology,detected}) of - undefined -> - case os:type() of - linux -> - case erlang:system_info(logical_processors) of - 1 -> - "+sctL0"; - N when is_integer(N) -> - NS = integer_to_list(N-1), - "+sctL0-"++NS++"p0-"++NS; - _ -> - false - end; - _ -> - false - end; - _ -> - "" - end, - case CpuTCmd of - false -> - {skipped, "Don't know how to create cpu topology"}; - _ -> - case erlang:system_info(logical_processors) of - LP when is_integer(LP) -> - OldRelFlags = clear_erl_rel_flags(), - try - lists:foreach(fun ({ClBt, Bt}) -> - sbt_test(Config, - CpuTCmd, - ClBt, - Bt, - LP) - end, - ?BIND_TYPES) - after - restore_erl_rel_flags(OldRelFlags) - end, - ok; - _ -> - {skipped, - "Don't know the amount of logical processors"} - end - end + case sbt_check_prereqs() of + {skipped, _Reason}=Skipped -> + Skipped; + ok -> + case sbt_make_topology_args() of + false -> + {skipped, "Don't know how to create cpu topology"}; + CpuTCmd -> + LP = erlang:system_info(logical_processors), + OldRelFlags = clear_erl_rel_flags(), + try + lists:foreach(fun ({ClBt, Bt}) -> + sbt_test(Config, CpuTCmd, + ClBt, Bt, LP) + end, + ?BIND_TYPES) + after + restore_erl_rel_flags(OldRelFlags) + end, + ok + end + end. + +sbt_make_topology_args() -> + case erlang:system_info({cpu_topology,detected}) of + undefined -> + case os:type() of + linux -> + case erlang:system_info(logical_processors) of + 1 -> + "+sctL0"; + N -> + NS = integer_to_list(N - 1), + "+sctL0-"++NS++"p0-"++NS + end; + _ -> + false + end; + _ -> + "" + end. + +sbt_check_prereqs() -> + try + Available = erlang:system_info(logical_processors_available), + Quota = erlang:system_info(cpu_quota), + if + Quota =:= unknown; Quota >= Available -> + ok; + Quota < Available -> + throw({skipped, "Test requires that CPU quota is greater than " + "the number of available processors."}) + end, + + try + OldVal = erlang:system_flag(scheduler_bind_type, default_bind), + erlang:system_flag(scheduler_bind_type, OldVal) + catch + error:notsup -> + throw({skipped, "Scheduler binding not supported."}); + error:_ -> + %% ?! + ok + end, + + case erlang:system_info(logical_processors) of + Count when is_integer(Count) -> + ok; + unknown -> + throw({skipped, "Can't detect number of logical processors."}) + end, + + ok + catch + throw:{skip,_Reason}=Skip -> Skip end. sbt_test(Config, CpuTCmd, ClBt, Bt, LP) -> @@ -1112,28 +1131,48 @@ scheduler_threads(Config) when is_list(Config) -> {Sched, HalfSchedOnln, _} = get_sstate(Config, "+SP:50"), %% Configure 2x scheduler threads only {TwiceSched, SchedOnln, _} = get_sstate(Config, "+SP 200"), - case {erlang:system_info(logical_processors), - erlang:system_info(logical_processors_available)} of - {LProc, LProcAvail} when is_integer(LProc), is_integer(LProcAvail) -> - %% Test resetting the scheduler counts - ResetCmd = "+S "++FourSched++":"++FourSchedOnln++" +S 0:0", - {LProc, LProcAvail, _} = get_sstate(Config, ResetCmd), - %% Test negative +S settings, but only for SMP-enabled emulators - case {LProc > 1, LProcAvail > 1} of - {true, true} -> - SchedMinus1 = LProc-1, - SchedOnlnMinus1 = LProcAvail-1, - {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1"), - {LProc, SchedOnlnMinus1, _} = get_sstate(Config, "+S :-1"), - {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1:-1"), - ok; - _ -> - {comment, "Skipped reduced amount of schedulers test due to too few logical processors"} - end; - _ -> %% Skipped when missing info about logical processors... - {comment, "Skipped reset amount of schedulers test, and reduced amount of schedulers test due to too unknown amount of logical processors"} + + LProc = erlang:system_info(logical_processors), + LProcAvail = erlang:system_info(logical_processors_available), + Quota = erlang:system_info(cpu_quota), + + if + not is_integer(LProc); not is_integer(LProcAvail) -> + {comment, "Skipped reset amount of schedulers test, and reduced " + "amount of schedulers test due to too unknown amount of " + "logical processors"}; + is_integer(LProc); is_integer(LProcAvail) -> + ExpectedOnln = st_expected_onln(LProcAvail, Quota), + + st_reset(Config, LProc, ExpectedOnln, FourSched, FourSchedOnln), + + if + LProc =:= 1; LProcAvail =:= 1 -> + {comment, "Skipped reduced amount of schedulers test due " + "to too few logical processors"}; + LProc > 1, LProcAvail > 1 -> + st_reduced(Config, LProc, ExpectedOnln) + end end. +st_reset(Config, LProc, ExpectedOnln, FourSched, FourSchedOnln) -> + %% Test resetting # of schedulers. + ResetCmd = "+S "++FourSched++":"++FourSchedOnln++" +S 0:0", + {LProc, ExpectedOnln, _} = get_sstate(Config, ResetCmd), + ok. + +st_reduced(Config, LProc, ExpectedOnln) -> + %% Test negative +S settings + SchedMinus1 = LProc-1, + SchedOnlnMinus1 = ExpectedOnln-1, + {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1"), + {LProc, SchedOnlnMinus1, _} = get_sstate(Config, "+S :-1"), + {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1:-1"), + ok. + +st_expected_onln(LProcAvail, unknown) -> LProcAvail; +st_expected_onln(LProcAvail, Quota) -> min(LProcAvail, Quota). + dirty_scheduler_threads(Config) when is_list(Config) -> case erlang:system_info(dirty_cpu_schedulers) of 0 -> {skipped, "No dirty scheduler support"}; diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl index 8afe4e4ac1..6fa19c47d4 100644 --- a/erts/emulator/test/send_term_SUITE.erl +++ b/erts/emulator/test/send_term_SUITE.erl @@ -156,27 +156,11 @@ receive_any() -> end. chk_temp_alloc() -> - case erlang:system_info({allocator,temp_alloc}) of - false -> - %% Temp alloc is not enabled - ok; - TIL -> - %% Verify that we havn't got anything allocated by temp_alloc - lists:foreach( - fun ({instance, _, TI}) -> - {value, {mbcs, MBCInfo}} - = lists:keysearch(mbcs, 1, TI), - {value, {blocks, 0, _, _}} - = lists:keysearch(blocks, 1, MBCInfo), - {value, {sbcs, SBCInfo}} - = lists:keysearch(sbcs, 1, TI), - {value, {blocks, 0, _, _}} - = lists:keysearch(blocks, 1, SBCInfo) - end, - TIL), - ok + %% Verify that we haven't got any outstanding temp_alloc allocations. + case erts_debug:alloc_blocks_size(temp_alloc) of + undefined -> ok; + 0 -> ok end. - %% Start/stop drivers. start_driver(Config, Name) -> diff --git a/erts/emulator/test/small_SUITE.erl b/erts/emulator/test/small_SUITE.erl index 00a02e5560..7dbe1fb4f4 100644 --- a/erts/emulator/test/small_SUITE.erl +++ b/erts/emulator/test/small_SUITE.erl @@ -78,6 +78,15 @@ sp2_1(N, MinS, MaxS) when N > 0 -> [N | sp2_1(N bsl 1, MinS, MaxS)]. arith_test(A, B, MinS, MaxS) -> + try arith_test_1(A, B, MinS, MaxS) of + ok -> ok + catch + error:Reason:Stk -> + ct:fail("arith_test failed with ~p~n\tA = ~p~n\tB = ~p\n\t~p", + [Reason, A, B, Stk]) + end. + +arith_test_1(A, B, MinS, MaxS) -> verify_kind(A + B, MinS, MaxS), verify_kind(B + A, MinS, MaxS), verify_kind(A - B, MinS, MaxS), @@ -97,6 +106,9 @@ arith_test(A, B, MinS, MaxS) -> true = B =:= 0 orelse ((A * B) div id(B) =:= A), true = A =:= 0 orelse ((B * A) div id(A) =:= B), + true = B =:= 0 orelse (((A div id(B)) * id(B) + A rem id(B)) =:= A), + true = A =:= 0 orelse (((B div id(A)) * id(A) + B rem id(A)) =:= B), + ok. %% Verifies that N is a small when it should be diff --git a/erts/emulator/test/socket_SUITE.erl b/erts/emulator/test/socket_SUITE.erl index dd1f3b1086..b074ff4bea 100644 --- a/erts/emulator/test/socket_SUITE.erl +++ b/erts/emulator/test/socket_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2019. All Rights Reserved. +%% Copyright Ericsson AB 2018-2020. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -95,6 +95,25 @@ api_b_sendmsg_and_recvmsg_tcpL/1, api_b_sendmsg_and_recvmsg_sctp4/1, + %% *** API socket from FD *** + api_ffd_open_wod_and_info_udp4/1, + api_ffd_open_wod_and_info_udp6/1, + api_ffd_open_wod_and_info_tcp4/1, + api_ffd_open_wod_and_info_tcp6/1, + api_ffd_open_wd_and_info_udp4/1, + api_ffd_open_wd_and_info_udp6/1, + api_ffd_open_wd_and_info_tcp4/1, + api_ffd_open_wd_and_info_tcp6/1, + api_ffd_open_and_open_wod_and_send_udp4/1, + api_ffd_open_and_open_wod_and_send_udp6/1, + api_ffd_open_and_open_wd_and_send_udp4/1, + api_ffd_open_and_open_wd_and_send_udp6/1, + api_ffd_open_connect_and_open_wod_and_send_tcp4/1, + api_ffd_open_connect_and_open_wod_and_send_tcp6/1, + api_ffd_open_connect_and_open_wd_and_send_tcp4/1, + api_ffd_open_connect_and_open_wd_and_send_tcp6/1, + + %% *** API async *** api_a_connect_tcp4/1, api_a_connect_tcp6/1, @@ -682,6 +701,7 @@ groups() -> [{api, [], api_cases()}, {api_misc, [], api_misc_cases()}, {api_basic, [], api_basic_cases()}, + {api_from_fd, [], api_from_fd_cases()}, {api_async, [], api_async_cases()}, {api_options, [], api_options_cases()}, {api_options_otp, [], api_options_otp_cases()}, @@ -813,6 +833,26 @@ api_basic_cases() -> api_b_sendmsg_and_recvmsg_sctp4 ]. +api_from_fd_cases() -> + [ + api_ffd_open_wod_and_info_udp4, + api_ffd_open_wod_and_info_udp6, + api_ffd_open_wod_and_info_tcp4, + api_ffd_open_wod_and_info_tcp6, + api_ffd_open_wd_and_info_udp4, + api_ffd_open_wd_and_info_udp6, + api_ffd_open_wd_and_info_tcp4, + api_ffd_open_wd_and_info_tcp6, + api_ffd_open_and_open_wod_and_send_udp4, + api_ffd_open_and_open_wod_and_send_udp6, + api_ffd_open_and_open_wd_and_send_udp4, + api_ffd_open_and_open_wd_and_send_udp6, + api_ffd_open_connect_and_open_wod_and_send_tcp4, + api_ffd_open_connect_and_open_wod_and_send_tcp6, + api_ffd_open_connect_and_open_wd_and_send_tcp4, + api_ffd_open_connect_and_open_wd_and_send_tcp6 + ]. + api_async_cases() -> [ api_a_connect_tcp4, @@ -4237,6 +4277,1890 @@ api_b_send_and_recv_sctp(_InitState) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% API FROM FD %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) a socket from an already existing +%% file descriptor (FD) and info of an IPv4 UDP (dgram) socket. +%% With some extra checks... +%% IPv4 +%% Without dup +api_ffd_open_wod_and_info_udp4(suite) -> + []; +api_ffd_open_wod_and_info_udp4(doc) -> + []; +api_ffd_open_wod_and_info_udp4(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_wod_and_info_udp4, + fun() -> + InitState = #{domain => inet, + type => dgram, + protocol => udp, + dup => false}, + ok = api_ffd_open_and_info(InitState) + end). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) a socket from an already existing +%% file descriptor (FD) and info of an IPv6 UDP (dgram) socket. +%% With some extra checks... +%% IPv6 +%% Without dup +api_ffd_open_wod_and_info_udp6(suite) -> + []; +api_ffd_open_wod_and_info_udp6(doc) -> + []; +api_ffd_open_wod_and_info_udp6(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_wod_and_info_udp6, + fun() -> has_support_ipv6() end, + fun() -> + InitState = #{domain => inet6, + type => dgram, + protocol => udp, + dup => false}, + ok = api_ffd_open_and_info(InitState) + end). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) a socket from an already existing +%% file descriptor (FD) and info of an IPv4 UDP (dgram) socket. +%% With some extra checks... +%% IPv4 +%% With dup +api_ffd_open_wd_and_info_udp4(suite) -> + []; +api_ffd_open_wd_and_info_udp4(doc) -> + []; +api_ffd_open_wd_and_info_udp4(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_wd_open_and_info_udp4, + fun() -> + InitState = #{domain => inet, + type => dgram, + protocol => udp, + dup => true}, + ok = api_ffd_open_and_info(InitState) + end). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) a socket from an already existing +%% file descriptor (FD) and info of an IPv4 UDP (dgram) socket. +%% With some extra checks... +%% IPv6 +%% With dup +api_ffd_open_wd_and_info_udp6(suite) -> + []; +api_ffd_open_wd_and_info_udp6(doc) -> + []; +api_ffd_open_wd_and_info_udp6(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_wd_open_and_info_udp6, + fun() -> has_support_ipv6() end, + fun() -> + InitState = #{domain => inet, + type => dgram, + protocol => udp, + dup => true}, + ok = api_ffd_open_and_info(InitState) + end). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) a socket from an already existing +%% file descriptor (FD) and info of an IPv4 TCP (stream) socket. +%% With some extra checks... +%% IPv6 +%% Without dup +api_ffd_open_wod_and_info_tcp4(suite) -> + []; +api_ffd_open_wod_and_info_tcp4(doc) -> + []; +api_ffd_open_wod_and_info_tcp4(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_wod_and_info_tcp4, + fun() -> + InitState = #{domain => inet, + type => stream, + protocol => tcp, + dup => false}, + ok = api_ffd_open_and_info(InitState) + end). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) a socket from an already existing +%% file descriptor (FD) and info of an IPv6 TCP (stream) socket. +%% With some extra checks... +%% IPv6 +%% Without dup +api_ffd_open_wod_and_info_tcp6(suite) -> + []; +api_ffd_open_wod_and_info_tcp6(doc) -> + []; +api_ffd_open_wod_and_info_tcp6(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_wod_and_info_tcp6, + fun() -> has_support_ipv6() end, + fun() -> + InitState = #{domain => inet6, + type => stream, + protocol => tcp, + dup => false}, + ok = api_ffd_open_and_info(InitState) + end). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) a socket from an already existing +%% file descriptor (FD) and info of an IPv4 TCP (stream) socket. +%% With some extra checks... +%% IPv6 +%% With dup +api_ffd_open_wd_and_info_tcp4(suite) -> + []; +api_ffd_open_wd_and_info_tcp4(doc) -> + []; +api_ffd_open_wd_and_info_tcp4(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_wd_and_info_tcp4, + fun() -> + InitState = #{domain => inet, + type => stream, + protocol => tcp, + dup => true}, + ok = api_ffd_open_and_info(InitState) + end). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) a socket from an already existing +%% file descriptor (FD) and info of an IPv6 TCP (stream) socket. +%% With some extra checks... +%% IPv6 +%% With dup +api_ffd_open_wd_and_info_tcp6(suite) -> + []; +api_ffd_open_wd_and_info_tcp6(doc) -> + []; +api_ffd_open_wd_and_info_tcp6(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_wd_and_info_tcp6, + fun() -> has_support_ipv6() end, + fun() -> + InitState = #{domain => inet6, + type => stream, + protocol => tcp, + dup => true}, + ok = api_ffd_open_and_info(InitState) + end). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +api_ffd_open_and_info(InitState) -> + Seq = + [ + #{desc => "open", + cmd => fun(#{domain := Domain, + type := Type, + protocol := Protocol} = State) -> + case socket:open(Domain, Type, Protocol) of + {ok, Sock1} -> + {ok, State#{sock1 => Sock1}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "get socket (1) FD", + cmd => fun(#{sock1 := Sock1} = State) -> + case socket:getopt(Sock1, otp, fd) of + {ok, FD} -> + ?SEV_IPRINT("FD: ~w", [FD]), + {ok, State#{fd => FD}}; + {error, Reason} = ERROR -> + ?SEV_EPRINT("failed get FD: " + "~n ~p", [Reason]), + ERROR + end + end}, + #{desc => "check if we need to provide protocol or not", + cmd => fun(#{sock1 := Sock1} = State) -> + case socket:getopt(Sock1, socket, protocol) of + {ok, _} -> + ?SEV_IPRINT("protocol accessible"), + {ok, State#{provide_protocol => false}}; + {error, Reason} -> + ?SEV_IPRINT("failed get protocol: " + "~n ~p", [Reason]), + {ok, State#{provide_protocol => true}} + end + end}, + #{desc => "open with FD", + cmd => fun(#{fd := FD, + dup := DUP, + provide_protocol := true, + protocol := Protocol} = State) -> + case socket:open(FD, #{dup => DUP, + protocol => Protocol}) of + {ok, Sock2} -> + ?SEV_IPRINT("socket 2 open"), + {ok, State#{sock2 => Sock2}}; + {error, Reason} = ERROR -> + ?SEV_EPRINT("failed open socket with FD (~w): " + "~n ~p", [FD, Reason]), + ERROR + end; + (#{fd := FD, + dup := DUP, + provide_protocol := false} = State) -> + case socket:open(FD, #{dup => DUP}) of + {ok, Sock2} -> + ?SEV_IPRINT("socket 2 open"), + {ok, State#{sock2 => Sock2}}; + {error, Reason} = ERROR -> + ?SEV_EPRINT("failed open socket with FD (~w): " + "~n ~p", [FD, Reason]), + ERROR + end + end}, + #{desc => "get socket (1) info", + cmd => fun(#{sock1 := Sock} = State) -> + %% socket:setopt(Sock, otp, debug, true), + Info = socket:info(Sock), + %% socket:setopt(Sock, otp, debug, false), + ?SEV_IPRINT("Got Info: " + "~n ~p", [Info]), + {ok, State#{info1 => Info}} + end}, + #{desc => "get socket (2) info", + cmd => fun(#{sock2 := Sock} = State) -> + %% socket:setopt(Sock, otp, debug, true), + Info = socket:info(Sock), + %% socket:setopt(Sock, otp, debug, false), + ?SEV_IPRINT("Got Info: " + "~n ~p", [Info]), + {ok, State#{info2 => Info}} + end}, + #{desc => "validate socket (1) info", + cmd => fun(#{domain := Domain, + type := Type, + protocol := Protocol, + info1 := #{domain := Domain, + type := Type, + protocol := Protocol, + ctype := normal, + counters := _, + num_readers := 0, + num_writers := 0, + num_acceptors := 0}}) -> + ok; + (#{domain := Domain, + type := Type, + protocol := Protocol, + info := Info}) -> + ?SEV_EPRINT("Unexpected Info for socket 1: " + "~n (expected) Domain: ~p" + "~n (expected) Type: ~p" + "~n (expected) Protocol: ~p" + "~n (expected) Create Type: ~p" + "~n ~p", + [Domain, Type, Protocol, normal, Info]), + {error, unexpected_infio} + end}, + #{desc => "validate socket (2) info", + cmd => fun(#{domain := Domain, + type := Type, + protocol := Protocol, + fd := _FD, + dup := false, + info2 := #{domain := Domain, + type := Type, + protocol := Protocol, + ctype := fromfd, + counters := _, + num_readers := 0, + num_writers := 0, + num_acceptors := 0}}) -> + ok; + (#{domain := Domain, + type := Type, + protocol := Protocol, + fd := _FD, + dup := false, + info := Info}) -> + ?SEV_EPRINT("Unexpected Info for socket 2: " + "~n (expected) Domain: ~p" + "~n (expected) Type: ~p" + "~n (expected) Protocol: ~p" + "~n (expected) Create Type: ~p" + "~n ~p", + [Domain, Type, Protocol, + fromfd, Info]), + {error, unexpected_info}; + (#{domain := Domain, + type := Type, + protocol := Protocol, + fd := FD, + dup := true, + info2 := #{domain := Domain, + type := Type, + protocol := Protocol, + ctype := {fromfd, FD}, + counters := _, + num_readers := 0, + num_writers := 0, + num_acceptors := 0}}) -> + ok; + (#{domain := Domain, + type := Type, + protocol := Protocol, + fd := FD, + dup := true, + info := Info}) -> + ?SEV_EPRINT("Unexpected Info for socket 2: " + "~n (expected) Domain: ~p" + "~n (expected) Type: ~p" + "~n (expected) Protocol: ~p" + "~n (expected) Create Type: ~p" + "~n ~p", + [Domain, Type, Protocol, + {fromfd, FD}, Info]), + {error, unexpected_info} + end}, + #{desc => "close socket (1)", + cmd => fun(#{sock1 := Sock} = _State) -> + socket:close(Sock) + end}, + #{desc => "close socket (2)", + cmd => fun(#{sock2 := Sock} = _State) -> + socket:close(Sock) + end}, + + %% *** We are done *** + ?SEV_FINISH_NORMAL + ], + Evaluator = ?SEV_START("tester", Seq, InitState), + ok = ?SEV_AWAIT_FINISH([Evaluator]). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open a socket (1) and then create another socket (2) from +%% its file descriptor *without* dup. +%% Exchange som data from via both "client" sockets. +%% Finally close the second socket. Ensure that the original socket +%% has not been closed (test by sending some data). +%% IPv4 UDP (dgram) socket. +%% +%% <WARNING> +%% +%% This is *not* how its intended to be used. +%% That an erlang process creating a socket and then handing over the +%% file descriptor to another erlang process. *But* its a convient way +%% to test it! +%% +%% </WARNING> +%% +api_ffd_open_and_open_wod_and_send_udp4(suite) -> + []; +api_ffd_open_and_open_wod_and_send_udp4(doc) -> + []; +api_ffd_open_and_open_wod_and_send_udp4(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_and_open_wod_and_send_udp4, + fun() -> + InitState = #{domain => inet, + type => dgram, + protocol => udp, + dup => false}, + ok = api_ffd_open_and_open_and_send_udp(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open a socket (1) and then create another socket (2) from +%% its file descriptor *without* dup. +%% Exchange som data from via both "client" sockets. +%% Finally close the second socket. Ensure that the original socket +%% has not been closed (test by sending some data). +%% IPv6 UDP (dgram) socket. +%% +%% <WARNING> +%% +%% This is *not* how its intended to be used. +%% That an erlang process creating a socket and then handing over the +%% file descriptor to another erlang process. *But* its a convient way +%% to test it! +%% +%% </WARNING> +%% +api_ffd_open_and_open_wod_and_send_udp6(suite) -> + []; +api_ffd_open_and_open_wod_and_send_udp6(doc) -> + []; +api_ffd_open_and_open_wod_and_send_udp6(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_and_open_wod_and_send_udp6, + fun() -> has_support_ipv6() end, + fun() -> + InitState = #{domain => inet6, + type => dgram, + protocol => udp, + dup => false}, + ok = api_ffd_open_and_open_and_send_udp(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open a socket (1) and then create another socket (2) from +%% its file descriptor *with* dup. +%% Exchange som data from via both "client" sockets. +%% Finally close the second socket. Ensure that the original socket +%% has not been closed (test by sending some data). +%% IPv4 UDP (dgram) socket. +%% +api_ffd_open_and_open_wd_and_send_udp4(suite) -> + []; +api_ffd_open_and_open_wd_and_send_udp4(doc) -> + []; +api_ffd_open_and_open_wd_and_send_udp4(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_and_open_wd_and_send_udp4, + fun() -> + InitState = #{domain => inet, + type => dgram, + protocol => udp, + dup => true}, + ok = api_ffd_open_and_open_and_send_udp(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open a socket (1) and then create another socket (2) from +%% its file descriptor *with* dup. +%% Exchange som data from via both "client" sockets. +%% Finally close the second socket. Ensure that the original socket +%% has not been closed (test by sending some data). +%% IPv6 UDP (dgram) socket. +%% +api_ffd_open_and_open_wd_and_send_udp6(suite) -> + []; +api_ffd_open_and_open_wd_and_send_udp6(doc) -> + []; +api_ffd_open_and_open_wd_and_send_udp6(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_and_open_wd_and_send_udp6, + fun() -> has_support_ipv6() end, + fun() -> + InitState = #{domain => inet6, + type => dgram, + protocol => udp, + dup => true}, + ok = api_ffd_open_and_open_and_send_udp(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +api_ffd_open_and_open_and_send_udp(InitState) -> + Send = fun(Sock, Data, Dest) -> + socket:sendto(Sock, Data, Dest) + end, + Recv = fun(Sock) -> + socket:recvfrom(Sock) + end, + api_ffd_open_and_open_and_send_udp2(InitState#{send => Send, + recv => Recv}). + +api_ffd_open_and_open_and_send_udp2(InitState) -> + process_flag(trap_exit, true), + ServerSeq = + [ + %% *** Wait for start order *** + #{desc => "await start (from tester)", + cmd => fun(State) -> + Tester = ?SEV_AWAIT_START(), + {ok, State#{tester => Tester}} + end}, + #{desc => "monitor tester", + cmd => fun(#{tester := Tester}) -> + _MRef = erlang:monitor(process, Tester), + ok + end}, + + %% *** Init part *** + #{desc => "which local address", + cmd => fun(#{domain := Domain} = State) -> + LSA = which_local_socket_addr(Domain), + {ok, State#{lsa => LSA}} + end}, + #{desc => "create socket", + cmd => fun(#{domain := Domain, + protocol := Proto} = State) -> + case socket:open(Domain, dgram, Proto) of + {ok, Sock} -> + {ok, State#{sock => Sock}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "bind to local address", + cmd => fun(#{sock := Sock, lsa := LSA} = State) -> + case sock_bind(Sock, LSA) of + {ok, Port} -> + ?SEV_IPRINT("bound to port: ~w", [Port]), + {ok, State#{port => Port}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready (init)", + cmd => fun(#{tester := Tester, port := Port}) -> + ?SEV_ANNOUNCE_READY(Tester, init, Port), + ok + end}, + + #{desc => "await request 1 (recv)", + cmd => fun(#{sock := Sock, recv := Recv} = State) -> + case Recv(Sock) of + {ok, {Source, ?BASIC_REQ}} -> + ?SEV_IPRINT("received request (1) from: " + "~n ~p", [Source]), + {ok, State#{source => Source}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready 1 (recv request)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_req), + ok + end}, + #{desc => "await continue 1 (with send reply)", + cmd => fun(#{tester := Tester}) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_reply) + end}, + #{desc => "send reply 1", + cmd => fun(#{sock := Sock, send := Send, source := Source}) -> + Send(Sock, ?BASIC_REP, Source) + end}, + #{desc => "announce ready 1 (send reply)", + cmd => fun(#{tester := Tester} = State) -> + ?SEV_ANNOUNCE_READY(Tester, send_reply), + {ok, maps:remove(source, State)} + end}, + + #{desc => "await request 2 (recv)", + cmd => fun(#{sock := Sock, recv := Recv} = State) -> + case Recv(Sock) of + {ok, {Source, ?BASIC_REQ}} -> + ?SEV_IPRINT("received request (2) from: " + "~n ~p", [Source]), + {ok, State#{source => Source}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready 2 (recv request)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_req), + ok + end}, + #{desc => "await continue 2 (with send reply)", + cmd => fun(#{tester := Tester}) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_reply) + end}, + #{desc => "send reply 2", + cmd => fun(#{sock := Sock, send := Send, source := Source}) -> + Send(Sock, ?BASIC_REP, Source) + end}, + #{desc => "announce ready 2 (send reply)", + cmd => fun(#{tester := Tester} = State) -> + ?SEV_ANNOUNCE_READY(Tester, send_reply), + {ok, maps:remove(source, State)} + end}, + + #{desc => "await request 3 (recv)", + cmd => fun(#{sock := Sock, recv := Recv} = State) -> + case Recv(Sock) of + {ok, {Source, ?BASIC_REQ}} -> + ?SEV_IPRINT("received request (2) from: " + "~n ~p", [Source]), + {ok, State#{source => Source}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready 3 (recv request)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_req), + ok + end}, + #{desc => "await continue 3 (with send reply)", + cmd => fun(#{tester := Tester}) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_reply) + end}, + #{desc => "send reply 3", + cmd => fun(#{sock := Sock, send := Send, source := Source}) -> + Send(Sock, ?BASIC_REP, Source) + end}, + #{desc => "announce ready 3 (send reply)", + cmd => fun(#{tester := Tester} = State) -> + ?SEV_ANNOUNCE_READY(Tester, send_reply), + {ok, maps:remove(source, State)} + end}, + + %% *** Termination *** + #{desc => "await terminate", + cmd => fun(#{tester := Tester} = State) -> + case ?SEV_AWAIT_TERMINATE(Tester, tester) of + ok -> + {ok, maps:remove(tester, State)}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "close socket", + cmd => fun(#{sock := Sock} = State) -> + ok = socket:close(Sock), + {ok, maps:remove(sock, State)} + end}, + + %% *** We are done *** + ?SEV_FINISH_NORMAL + ], + + + Client1Seq = + [ + %% *** Wait for start order *** + #{desc => "await start (from tester)", + cmd => fun(State) -> + {Tester, Port} = ?SEV_AWAIT_START(), + {ok, State#{tester => Tester, server_port => Port}} + end}, + #{desc => "monitor tester", + cmd => fun(#{tester := Tester}) -> + _MRef = erlang:monitor(process, Tester), + ok + end}, + + %% *** The init part *** + #{desc => "which server (local) address", + cmd => fun(#{domain := Domain, server_port := Port} = State) -> + LSA = which_local_socket_addr(Domain), + SSA = LSA#{port => Port}, + {ok, State#{local_sa => LSA, server_sa => SSA}} + end}, + #{desc => "create socket", + cmd => fun(#{domain := Domain, + protocol := Proto} = State) -> + case socket:open(Domain, dgram, Proto) of + {ok, Sock} -> + {ok, State#{sock => Sock}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "bind to local address", + cmd => fun(#{sock := Sock, local_sa := LSA} = _State) -> + case sock_bind(Sock, LSA) of + {ok, _Port} -> + ok; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "get socket FD", + cmd => fun(#{sock := Sock} = State) -> + case socket:getopt(Sock, otp, fd) of + {ok, FD} -> + ?SEV_IPRINT("FD: ~w", [FD]), + {ok, State#{fd => FD}}; + {error, Reason} = ERROR -> + ?SEV_EPRINT("failed get FD: " + "~n ~p", [Reason]), + ERROR + end + end}, + #{desc => "announce ready (init)", + cmd => fun(#{tester := Tester, + fd := FD}) -> + ?SEV_ANNOUNCE_READY(Tester, init, FD), + ok + end}, + + %% *** The actual test *** + #{desc => "await continue (send request 1)", + cmd => fun(#{tester := Tester} = _State) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_req) + end}, + #{desc => "send request 1 (to server)", + cmd => fun(#{sock := Sock, send := Send, server_sa := SSA}) -> + Send(Sock, ?BASIC_REQ, SSA) + end}, + #{desc => "announce ready (send request 1)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, send_req), + ok + end}, + #{desc => "await recv reply 1 (from server)", + cmd => fun(#{sock := Sock, recv := Recv}) -> + {ok, {_, ?BASIC_REP}} = Recv(Sock), + ok + end}, + #{desc => "announce ready (recv reply 1)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_reply), + ok + end}, + + #{desc => "await continue (send request 3)", + cmd => fun(#{tester := Tester} = _State) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_req) + end}, + #{desc => "send request 3 (to server)", + cmd => fun(#{sock := Sock, send := Send, server_sa := SSA}) -> + Send(Sock, ?BASIC_REQ, SSA) + end}, + #{desc => "announce ready (send request 3)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, send_req), + ok + end}, + #{desc => "await recv reply 3 (from server)", + cmd => fun(#{sock := Sock, recv := Recv}) -> + {ok, {_, ?BASIC_REP}} = Recv(Sock), + ok + end}, + #{desc => "announce ready (recv reply 3)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_reply), + ok + end}, + + %% *** Termination *** + #{desc => "await terminate", + cmd => fun(#{tester := Tester} = State) -> + case ?SEV_AWAIT_TERMINATE(Tester, tester) of + ok -> + {ok, maps:remove(tester, State)}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "close socket", + cmd => fun(#{sock := Sock} = State) -> + ok = socket:close(Sock), + {ok, maps:remove(sock, State)} + end}, + + %% *** We are done *** + ?SEV_FINISH_NORMAL + ], + + + Client2Seq = + [ + %% *** Wait for start order *** + #{desc => "await start (from tester)", + cmd => fun(State) -> + {Tester, {Port, FD}} = ?SEV_AWAIT_START(), + {ok, State#{tester => Tester, + server_port => Port, + fd => FD}} + end}, + #{desc => "monitor tester", + cmd => fun(#{tester := Tester}) -> + _MRef = erlang:monitor(process, Tester), + ok + end}, + + %% *** The init part *** + #{desc => "which server (local) address", + cmd => fun(#{domain := Domain, server_port := Port} = State) -> + LSA = which_local_socket_addr(Domain), + SSA = LSA#{port => Port}, + {ok, State#{server_sa => SSA}} + end}, + #{desc => "create socket", + cmd => fun(#{fd := FD, + dup := DUP} = State) -> + case socket:open(FD, #{dup => DUP}) of + {ok, Sock} -> + {ok, State#{sock => Sock}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready (init)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, init), + ok + end}, + + %% *** The actual test *** + #{desc => "await continue (send request 2)", + cmd => fun(#{tester := Tester} = _State) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_req) + end}, + #{desc => "send request 2 (to server)", + cmd => fun(#{sock := Sock, send := Send, server_sa := SSA}) -> + Send(Sock, ?BASIC_REQ, SSA) + end}, + #{desc => "announce ready (send request 2)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, send_req), + ok + end}, + #{desc => "await recv reply 2 (from server)", + cmd => fun(#{sock := Sock, recv := Recv}) -> + {ok, {_, ?BASIC_REP}} = Recv(Sock), + ok + end}, + #{desc => "announce ready (recv reply 2)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_reply), + ok + end}, + + %% *** Termination *** + #{desc => "await terminate", + cmd => fun(#{tester := Tester} = State) -> + case ?SEV_AWAIT_TERMINATE(Tester, tester) of + ok -> + {ok, maps:remove(tester, State)}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "close socket", + cmd => fun(#{sock := Sock} = State) -> + ok = socket:close(Sock), + {ok, maps:remove(sock, State)} + end}, + + %% *** We are done *** + ?SEV_FINISH_NORMAL + ], + + + TesterSeq = + [ + %% *** Init part *** + #{desc => "monitor server", + cmd => fun(#{server := Pid} = _State) -> + _MRef = erlang:monitor(process, Pid), + ok + end}, + #{desc => "monitor client 1", + cmd => fun(#{client1 := Pid} = _State) -> + _MRef = erlang:monitor(process, Pid), + ok + end}, + #{desc => "monitor client 2", + cmd => fun(#{client2 := Pid} = _State) -> + _MRef = erlang:monitor(process, Pid), + ok + end}, + + %% Start the server + #{desc => "order server start", + cmd => fun(#{server := Pid} = _State) -> + ?SEV_ANNOUNCE_START(Pid), + ok + end}, + #{desc => "await server ready (init)", + cmd => fun(#{server := Pid} = State) -> + {ok, Port} = ?SEV_AWAIT_READY(Pid, server, init), + {ok, State#{server_port => Port}} + end}, + + %% Start the client 1 + #{desc => "order client 1 start", + cmd => fun(#{client1 := Pid, server_port := Port} = _State) -> + ?SEV_ANNOUNCE_START(Pid, Port), + ok + end}, + #{desc => "await client 1 ready (init)", + cmd => fun(#{client1 := Pid} = State) -> + case ?SEV_AWAIT_READY(Pid, client1, init) of + {ok, FD} -> + {ok, State#{fd => FD}}; + {error, Reason} = ERROR -> + ?SEV_EPRINT("Client 1 init error: " + "~n ~p", [Reason]), + ERROR + end + end}, + + ?SEV_SLEEP(?SECS(1)), + + %% Start the client 2 + #{desc => "order client 2 start", + cmd => fun(#{client2 := Pid, + server_port := Port, + fd := FD} = _State) -> + ?SEV_ANNOUNCE_START(Pid, {Port, FD}), + ok + end}, + #{desc => "await client 2 ready (init)", + cmd => fun(#{client2 := Pid} = _State) -> + ok = ?SEV_AWAIT_READY(Pid, client2, init) + end}, + + %% *** The actual test *** + + #{desc => "order client 1 to continue (with send request 1)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Client, send_req), + ok + end}, + #{desc => "await client 1 ready (with send request 1)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client1, send_req) + end}, + #{desc => "await server ready (request recv 1)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, recv_req) + end}, + #{desc => "order server to continue (with send reply 1)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Server, send_reply), + ok + end}, + #{desc => "await server ready (with reply 1 sent)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, send_reply) + end}, + #{desc => "await client 1 ready (reply recv 1)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client1, recv_reply) + end}, + + + #{desc => "order client 2 to continue (with send request 2)", + cmd => fun(#{client2 := Client} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Client, send_req), + ok + end}, + #{desc => "await client 2 ready (with send request 2)", + cmd => fun(#{client2 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client2, send_req) + end}, + #{desc => "await server ready (request recv 2)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, recv_req) + end}, + #{desc => "order server to continue (with send reply 2)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Server, send_reply), + ok + end}, + #{desc => "await server ready (with reply 2 sent)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, send_reply) + end}, + #{desc => "await client 2 ready (reply recv 2)", + cmd => fun(#{client2 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client2, recv_reply) + end}, + + + #{desc => "order client 2 to terminate", + cmd => fun(#{client2 := Client} = _State) -> + ?SEV_ANNOUNCE_TERMINATE(Client), + ok + end}, + #{desc => "await client 2 termination", + cmd => fun(#{client2 := Client} = State) -> + ?SEV_AWAIT_TERMINATION(Client), + State1 = maps:remove(client2, State), + {ok, State1} + end}, + + + #{desc => "order client 1 to continue (with send request 3)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Client, send_req), + ok + end}, + #{desc => "await client 1 ready (with send request 3)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client1, send_req) + end}, + #{desc => "await server ready (request recv 3)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, recv_req) + end}, + #{desc => "order server to continue (with send reply 3)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Server, send_reply), + ok + end}, + #{desc => "await server ready (with reply 3 sent)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, send_reply) + end}, + #{desc => "await client 1 ready (reply recv 3)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client1, recv_reply) + end}, + + + %% *** Termination *** + #{desc => "order client 1 to terminate", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_ANNOUNCE_TERMINATE(Client), + ok + end}, + #{desc => "await client 1 termination", + cmd => fun(#{client1 := Client} = State) -> + ?SEV_AWAIT_TERMINATION(Client), + State1 = maps:remove(client1, State), + {ok, State1} + end}, + #{desc => "order server to terminate", + cmd => fun(#{server := Server} = _State) -> + ?SEV_ANNOUNCE_TERMINATE(Server), + ok + end}, + #{desc => "await server termination", + cmd => fun(#{server := Server} = State) -> + ?SEV_AWAIT_TERMINATION(Server), + State1 = maps:remove(server, State), + {ok, State1} + end}, + + %% *** We are done *** + ?SEV_FINISH_NORMAL + ], + + i("start server evaluator"), + Server = ?SEV_START("server", ServerSeq, maps:remove(dup, InitState)), + + i("start (socket origin) client 1 evaluator"), + Client1 = ?SEV_START("client-1", Client1Seq, maps:remove(dup, InitState)), + i("await evaluator(s)"), + + i("start client 2 evaluator"), + Client2 = ?SEV_START("client-2", Client2Seq, InitState), + i("await evaluator(s)"), + + i("start tester evaluator"), + TesterInitState = #{server => Server#ev.pid, + client1 => Client1#ev.pid, + client2 => Client2#ev.pid}, + Tester = ?SEV_START("tester", TesterSeq, TesterInitState), + + ok = ?SEV_AWAIT_FINISH([Server, Client1, Client2, Tester]). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open a socket (1), connect to a server and then create +%% another socket (2) from its file descriptor *without* dup. +%% Exchange som data from via both "client" sockets. +%% Finally close the second socket. Ensure that the original socket +%% has not been closed (test by sending some data). +%% IPv4 TCP (stream) socket. +%% +%% <WARNING> +%% +%% This is *not* how its intended to be used. +%% That an erlang process creating a socket and then handing over the +%% file descriptor to another erlang process. *But* its a convient way +%% to test it! +%% +%% </WARNING> +%% +api_ffd_open_connect_and_open_wod_and_send_tcp4(suite) -> + []; +api_ffd_open_connect_and_open_wod_and_send_tcp4(doc) -> + []; +api_ffd_open_connect_and_open_wod_and_send_tcp4(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_connect_and_open_wod_and_send_tcp4, + fun() -> + InitState = #{domain => inet, + type => stream, + protocol => tcp, + dup => false}, + ok = api_ffd_open_connect_and_open_and_send_tcp(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open a socket (1), connect to a server and then create +%% another socket (2) from its file descriptor *without* dup. +%% Exchange som data from via both "client" sockets. +%% Finally close the second socket. Ensure that the original socket +%% has not been closed (test by sending some data). +%% IPv6 TCP (stream) socket. +%% +%% <WARNING> +%% +%% This is *not* how its intended to be used. +%% That an erlang process creating a socket and then handing over the +%% file descriptor to another erlang process. *But* its a convient way +%% to test it! +%% +%% </WARNING> +%% +api_ffd_open_connect_and_open_wod_and_send_tcp6(suite) -> + []; +api_ffd_open_connect_and_open_wod_and_send_tcp6(doc) -> + []; +api_ffd_open_connect_and_open_wod_and_send_tcp6(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_connect_and_open_wod_and_send_tcp6, + fun() -> has_support_ipv6() end, + fun() -> + InitState = #{domain => inet6, + type => stream, + protocol => tcp, + dup => false}, + ok = api_ffd_open_connect_and_open_and_send_tcp(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open a socket (1), connect to a server and then create +%% another socket (2) from its file descriptor *with* dup. +%% Exchange som data from via both "client" sockets. +%% Finally close the second socket. Ensure that the original socket +%% has not been closed (test by sending some data). +%% IPv4 TCP (stream) socket. +api_ffd_open_connect_and_open_wd_and_send_tcp4(suite) -> + []; +api_ffd_open_connect_and_open_wd_and_send_tcp4(doc) -> + []; +api_ffd_open_connect_and_open_wd_and_send_tcp4(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_connect_and_open_wd_and_send_tcp4, + fun() -> + InitState = #{domain => inet, + type => stream, + protocol => tcp, + dup => true}, + ok = api_ffd_open_connect_and_open_and_send_tcp(InitState) + end). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open a socket (1), connect to a server and then create +%% another socket (2) from its file descriptor *with* dup. +%% Exchange som data from via both "client" sockets. +%% Finally close the second socket. Ensure that the original socket +%% has not been closed (test by sending some data). +%% IPv6 TCP (stream) socket. +api_ffd_open_connect_and_open_wd_and_send_tcp6(suite) -> + []; +api_ffd_open_connect_and_open_wd_and_send_tcp6(doc) -> + []; +api_ffd_open_connect_and_open_wd_and_send_tcp6(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(api_ffd_open_connect_and_open_wd_and_send_tcp6, + fun() -> has_support_ipv6() end, + fun() -> + InitState = #{domain => inet6, + type => stream, + protocol => tcp, + dup => true}, + ok = api_ffd_open_connect_and_open_and_send_tcp(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +api_ffd_open_connect_and_open_and_send_tcp(InitState) -> + Send = fun(Sock, Data) -> + socket:send(Sock, Data) + end, + Recv = fun(Sock) -> + socket:recv(Sock) + end, + api_ffd_open_connect_and_open_and_send_tcp2(InitState#{send => Send, + recv => Recv}). + +api_ffd_open_connect_and_open_and_send_tcp2(InitState) -> + process_flag(trap_exit, true), + ServerSeq = + [ + %% *** Wait for start order *** + #{desc => "await start (from tester)", + cmd => fun(State) -> + Tester = ?SEV_AWAIT_START(), + {ok, State#{tester => Tester}} + end}, + #{desc => "monitor tester", + cmd => fun(#{tester := Tester}) -> + _MRef = erlang:monitor(process, Tester), + ok + end}, + + %% *** Init part *** + #{desc => "which local address", + cmd => fun(#{domain := Domain} = State) -> + LSA = which_local_socket_addr(Domain), + {ok, State#{lsa => LSA}} + end}, + #{desc => "create listen socket", + cmd => fun(#{domain := Domain, + protocol := Proto} = State) -> + case socket:open(Domain, stream, Proto) of + {ok, Sock} -> + {ok, State#{lsock => Sock}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "bind to local address", + cmd => fun(#{lsock := LSock, lsa := LSA} = State) -> + case sock_bind(LSock, LSA) of + {ok, Port} -> + ?SEV_IPRINT("bound to port: ~w", [Port]), + {ok, State#{lport => Port}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "make listen socket", + cmd => fun(#{lsock := LSock}) -> + socket:listen(LSock) + end}, + #{desc => "announce ready (init)", + cmd => fun(#{tester := Tester, lport := Port}) -> + %% This is actually not used for unix domain socket + ?SEV_ANNOUNCE_READY(Tester, init, Port), + ok + end}, + + %% The actual test + #{desc => "await continue (accept)", + cmd => fun(#{tester := Tester}) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, accept) + end}, + #{desc => "await connection", + cmd => fun(#{lsock := LSock} = State) -> + case socket:accept(LSock) of + {ok, Sock} -> + ?SEV_IPRINT("accepted: ~n ~p", [Sock]), + {ok, State#{csock => Sock}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready (accept)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, accept), + ok + end}, + + #{desc => "await request 1 (recv)", + cmd => fun(#{csock := Sock, recv := Recv}) -> + case Recv(Sock) of + {ok, ?BASIC_REQ} -> + ok; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready 1 (recv request)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_req), + ok + end}, + #{desc => "await continue 1 (with send reply)", + cmd => fun(#{tester := Tester}) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_reply) + end}, + #{desc => "send reply 1", + cmd => fun(#{csock := Sock, send := Send}) -> + Send(Sock, ?BASIC_REP) + end}, + #{desc => "announce ready 1 (send reply)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, send_reply), + ok + end}, + + #{desc => "await request 2 (recv)", + cmd => fun(#{csock := Sock, recv := Recv}) -> + case Recv(Sock) of + {ok, ?BASIC_REQ} -> + ok; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready 2 (recv request)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_req), + ok + end}, + #{desc => "await continue 2 (with send reply)", + cmd => fun(#{tester := Tester}) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_reply) + end}, + #{desc => "send reply 2", + cmd => fun(#{csock := Sock, send := Send}) -> + Send(Sock, ?BASIC_REP) + end}, + #{desc => "announce ready 2 (send reply)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, send_reply), + ok + end}, + + #{desc => "await request 3 (recv)", + cmd => fun(#{csock := Sock, recv := Recv}) -> + case Recv(Sock) of + {ok, ?BASIC_REQ} -> + ok; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready 3 (recv request)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_req), + ok + end}, + #{desc => "await continue 3 (with send reply)", + cmd => fun(#{tester := Tester}) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_reply) + end}, + #{desc => "send reply 3", + cmd => fun(#{csock := Sock, send := Send}) -> + Send(Sock, ?BASIC_REP) + end}, + #{desc => "announce ready 3 (send reply)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, send_reply), + ok + end}, + + %% *** Termination *** + #{desc => "await terminate", + cmd => fun(#{tester := Tester} = State) -> + case ?SEV_AWAIT_TERMINATE(Tester, tester) of + ok -> + {ok, maps:remove(tester, State)}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "close connection socket", + cmd => fun(#{csock := Sock} = State) -> + ok = socket:close(Sock), + {ok, maps:remove(csock, State)} + end}, + #{desc => "close listen socket", + cmd => fun(#{lsock := LSock} = State) -> + case socket:close(LSock) of + ok -> + {ok, maps:remove(lsock, State)}; + {error, _} = ERROR -> + ERROR + end + end}, + + %% *** We are done *** + ?SEV_FINISH_NORMAL + ], + + + Client1Seq = + [ + %% *** Wait for start order *** + #{desc => "await start (from tester)", + cmd => fun(State) -> + {Tester, Port} = ?SEV_AWAIT_START(), + {ok, State#{tester => Tester, server_port => Port}} + end}, + #{desc => "monitor tester", + cmd => fun(#{tester := Tester}) -> + _MRef = erlang:monitor(process, Tester), + ok + end}, + + %% *** The init part *** + #{desc => "which server (local) address", + cmd => fun(#{domain := Domain, server_port := Port} = State) -> + LSA = which_local_socket_addr(Domain), + SSA = LSA#{port => Port}, + {ok, State#{local_sa => LSA, server_sa => SSA}} + end}, + #{desc => "create socket", + cmd => fun(#{domain := Domain, + protocol := Proto} = State) -> + case socket:open(Domain, stream, Proto) of + {ok, Sock} -> + {ok, State#{sock => Sock}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "bind to local address", + cmd => fun(#{sock := Sock, local_sa := LSA} = _State) -> + case sock_bind(Sock, LSA) of + {ok, _Port} -> + ok; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready (init)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, init), + ok + end}, + + + #{desc => "await continue (connect)", + cmd => fun(#{tester := Tester} = _State) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, connect) + end}, + #{desc => "connect to server", + cmd => fun(#{sock := Sock, server_sa := SSA}) -> + socket:connect(Sock, SSA) + end}, + #{desc => "get socket FD", + cmd => fun(#{sock := Sock} = State) -> + case socket:getopt(Sock, otp, fd) of + {ok, FD} -> + ?SEV_IPRINT("FD: ~w", [FD]), + {ok, State#{fd => FD}}; + {error, Reason} = ERROR -> + ?SEV_EPRINT("failed get FD: " + "~n ~p", [Reason]), + ERROR + end + end}, + #{desc => "announce ready (connect)", + cmd => fun(#{tester := Tester, + fd := FD}) -> + ?SEV_ANNOUNCE_READY(Tester, connect, FD), + ok + end}, + + + %% *** The actual test *** + #{desc => "await continue (send request 1)", + cmd => fun(#{tester := Tester} = _State) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_req) + end}, + #{desc => "send request 1 (to server)", + cmd => fun(#{sock := Sock, send := Send}) -> + Send(Sock, ?BASIC_REQ) + end}, + #{desc => "announce ready (send request 1)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, send_req), + ok + end}, + #{desc => "await recv reply 1 (from server)", + cmd => fun(#{sock := Sock, recv := Recv}) -> + {ok, ?BASIC_REP} = Recv(Sock), + ok + end}, + #{desc => "announce ready (recv reply 1)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_reply), + ok + end}, + + #{desc => "await continue (send request 3)", + cmd => fun(#{tester := Tester} = _State) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_req) + end}, + #{desc => "send request 3 (to server)", + cmd => fun(#{sock := Sock, send := Send}) -> + Send(Sock, ?BASIC_REQ) + end}, + #{desc => "announce ready (send request 3)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, send_req), + ok + end}, + #{desc => "await recv reply 3 (from server)", + cmd => fun(#{sock := Sock, recv := Recv}) -> + {ok, ?BASIC_REP} = Recv(Sock), + ok + end}, + #{desc => "announce ready (recv reply 3)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_reply), + ok + end}, + + %% *** Termination *** + #{desc => "await terminate", + cmd => fun(#{tester := Tester} = State) -> + case ?SEV_AWAIT_TERMINATE(Tester, tester) of + ok -> + {ok, maps:remove(tester, State)}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "close socket", + cmd => fun(#{sock := Sock} = State) -> + ok = socket:close(Sock), + {ok, maps:remove(sock, State)} + end}, + + %% *** We are done *** + ?SEV_FINISH_NORMAL + ], + + + Client2Seq = + [ + %% *** Wait for start order *** + #{desc => "await start (from tester)", + cmd => fun(State) -> + {Tester, FD} = ?SEV_AWAIT_START(), + {ok, State#{tester => Tester, fd => FD}} + end}, + #{desc => "monitor tester", + cmd => fun(#{tester := Tester}) -> + _MRef = erlang:monitor(process, Tester), + ok + end}, + + %% *** The init part *** + #{desc => "create socket", + cmd => fun(#{fd := FD, + dup := DUP} = State) -> + case socket:open(FD, #{dup => DUP}) of + {ok, Sock} -> + {ok, State#{sock => Sock}}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "announce ready (init)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, init), + ok + end}, + + %% *** The actual test *** + #{desc => "await continue (send request 2)", + cmd => fun(#{tester := Tester} = _State) -> + ?SEV_AWAIT_CONTINUE(Tester, tester, send_req) + end}, + #{desc => "send request 2 (to server)", + cmd => fun(#{sock := Sock, send := Send}) -> + Send(Sock, ?BASIC_REQ) + end}, + #{desc => "announce ready (send request 2)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, send_req), + ok + end}, + #{desc => "await recv reply 2 (from server)", + cmd => fun(#{sock := Sock, recv := Recv}) -> + {ok, ?BASIC_REP} = Recv(Sock), + ok + end}, + #{desc => "announce ready (recv reply 2)", + cmd => fun(#{tester := Tester}) -> + ?SEV_ANNOUNCE_READY(Tester, recv_reply), + ok + end}, + + %% *** Termination *** + #{desc => "await terminate", + cmd => fun(#{tester := Tester} = State) -> + case ?SEV_AWAIT_TERMINATE(Tester, tester) of + ok -> + {ok, maps:remove(tester, State)}; + {error, _} = ERROR -> + ERROR + end + end}, + #{desc => "close socket", + cmd => fun(#{sock := Sock} = State) -> + ok = socket:close(Sock), + {ok, maps:remove(sock, State)} + end}, + + %% *** We are done *** + ?SEV_FINISH_NORMAL + ], + + + TesterSeq = + [ + %% *** Init part *** + #{desc => "monitor server", + cmd => fun(#{server := Pid} = _State) -> + _MRef = erlang:monitor(process, Pid), + ok + end}, + #{desc => "monitor client 1", + cmd => fun(#{client1 := Pid} = _State) -> + _MRef = erlang:monitor(process, Pid), + ok + end}, + #{desc => "monitor client 2", + cmd => fun(#{client2 := Pid} = _State) -> + _MRef = erlang:monitor(process, Pid), + ok + end}, + + %% Start the server + #{desc => "order server start", + cmd => fun(#{server := Pid} = _State) -> + ?SEV_ANNOUNCE_START(Pid), + ok + end}, + #{desc => "await server ready (init)", + cmd => fun(#{server := Pid} = State) -> + {ok, Port} = ?SEV_AWAIT_READY(Pid, server, init), + {ok, State#{server_port => Port}} + end}, + + %% Start the client 1 + #{desc => "order client 1 start", + cmd => fun(#{client1 := Pid, server_port := Port} = _State) -> + ?SEV_ANNOUNCE_START(Pid, Port), + ok + end}, + #{desc => "await client 1 ready (init)", + cmd => fun(#{client1 := Pid} = _State) -> + ok = ?SEV_AWAIT_READY(Pid, client1, init) + end}, + + #{desc => "order server to continue (with accept)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Server, accept), + ok + end}, + ?SEV_SLEEP(?SECS(1)), + #{desc => "order client 1 to continue (with connect)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Client, connect), + ok + end}, + #{desc => "await client 1 ready (connect)", + cmd => fun(#{client1 := Pid} = State) -> + {ok, FD} = ?SEV_AWAIT_READY(Pid, client1, connect), + {ok, State#{fd => FD}} + end}, + #{desc => "await server ready (accept)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, accept) + end}, + + %% Start the client 2 + #{desc => "order client 2 start", + cmd => fun(#{client2 := Pid, fd := FD} = _State) -> + ?SEV_ANNOUNCE_START(Pid, FD), + ok + end}, + #{desc => "await client 2 ready (init)", + cmd => fun(#{client2 := Pid} = _State) -> + ok = ?SEV_AWAIT_READY(Pid, client2, init) + end}, + + %% *** The actual test *** + + #{desc => "order client 1 to continue (with send request 1)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Client, send_req), + ok + end}, + #{desc => "await client 1 ready (with send request 1)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client1, send_req) + end}, + #{desc => "await server ready (request recv 1)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, recv_req) + end}, + #{desc => "order server to continue (with send reply 1)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Server, send_reply), + ok + end}, + #{desc => "await server ready (with reply 1 sent)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, send_reply) + end}, + #{desc => "await client 1 ready (reply recv 1)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client1, recv_reply) + end}, + + + #{desc => "order client 2 to continue (with send request 2)", + cmd => fun(#{client2 := Client} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Client, send_req), + ok + end}, + #{desc => "await client 2 ready (with send request 2)", + cmd => fun(#{client2 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client2, send_req) + end}, + #{desc => "await server ready (request recv 2)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, recv_req) + end}, + #{desc => "order server to continue (with send reply 2)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Server, send_reply), + ok + end}, + #{desc => "await server ready (with reply 2 sent)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, send_reply) + end}, + #{desc => "await client 2 ready (reply recv 2)", + cmd => fun(#{client2 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client2, recv_reply) + end}, + + + #{desc => "order client 2 to terminate", + cmd => fun(#{client2 := Client} = _State) -> + ?SEV_ANNOUNCE_TERMINATE(Client), + ok + end}, + #{desc => "await client 2 termination", + cmd => fun(#{client2 := Client} = State) -> + ?SEV_AWAIT_TERMINATION(Client), + State1 = maps:remove(client2, State), + {ok, State1} + end}, + + + #{desc => "order client 1 to continue (with send request 3)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Client, send_req), + ok + end}, + #{desc => "await client 1 ready (with send request 3)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client1, send_req) + end}, + #{desc => "await server ready (request recv 3)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, recv_req) + end}, + #{desc => "order server to continue (with send reply 3)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_ANNOUNCE_CONTINUE(Server, send_reply), + ok + end}, + #{desc => "await server ready (with reply 3 sent)", + cmd => fun(#{server := Server} = _State) -> + ?SEV_AWAIT_READY(Server, server, send_reply) + end}, + #{desc => "await client 1 ready (reply recv 3)", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_AWAIT_READY(Client, client1, recv_reply) + end}, + + + %% *** Termination *** + #{desc => "order client 1 to terminate", + cmd => fun(#{client1 := Client} = _State) -> + ?SEV_ANNOUNCE_TERMINATE(Client), + ok + end}, + #{desc => "await client 1 termination", + cmd => fun(#{client1 := Client} = State) -> + ?SEV_AWAIT_TERMINATION(Client), + State1 = maps:remove(client1, State), + {ok, State1} + end}, + #{desc => "order server to terminate", + cmd => fun(#{server := Server} = _State) -> + ?SEV_ANNOUNCE_TERMINATE(Server), + ok + end}, + #{desc => "await server termination", + cmd => fun(#{server := Server} = State) -> + ?SEV_AWAIT_TERMINATION(Server), + State1 = maps:remove(server, State), + {ok, State1} + end}, + + %% *** We are done *** + ?SEV_FINISH_NORMAL + ], + + i("start server evaluator"), + Server = ?SEV_START("server", ServerSeq, maps:remove(dup, InitState)), + + i("start (socket origin) client 1 evaluator"), + Client1 = ?SEV_START("client-1", Client1Seq, maps:remove(dup, InitState)), + i("await evaluator(s)"), + + i("start client 2 evaluator"), + Client2 = ?SEV_START("client-2", Client2Seq, InitState), + i("await evaluator(s)"), + + i("start tester evaluator"), + TesterInitState = #{server => Server#ev.pid, + client1 => Client1#ev.pid, + client2 => Client2#ev.pid}, + Tester = ?SEV_START("tester", TesterSeq, TesterInitState), + + ok = ?SEV_AWAIT_FINISH([Server, Client1, Client2, Tester]). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% API ASYNC %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Basically establish a TCP connection via an async connect. IPv4. diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index c2d5cd7023..cd60187809 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -664,7 +664,7 @@ dist_procs_trace(Config) when is_list(Config) -> Proc1 ! {trap_exit_please, true}, Proc3 = receive {spawned, Proc1, P3} -> P3 end, io:format("Proc3 = ~p ~n", [Proc3]), - {trace, Proc1, getting_linked, Proc3} = receive_first_trace(), + {trace, Proc1, link, Proc3} = receive_first_trace(), Reason3 = make_ref(), Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, @@ -958,15 +958,14 @@ do_system_monitor_long_schedule() -> {Self,L} when is_list(L) -> ok after 1000 -> - ct:fail(no_trace_of_pid) + ct:fail(no_trace_of_pid) end, "ok" = erlang:port_control(Port,1,[]), - "ok" = erlang:port_control(Port,2,[]), receive {Port,LL} when is_list(LL) -> ok after 1000 -> - ct:fail(no_trace_of_port) + ct:fail(no_trace_of_port) end, port_close(Port), erlang:system_monitor(undefined), diff --git a/erts/emulator/test/trace_SUITE_data/Makefile.src b/erts/emulator/test/trace_SUITE_data/Makefile.src new file mode 100644 index 0000000000..645107d7b0 --- /dev/null +++ b/erts/emulator/test/trace_SUITE_data/Makefile.src @@ -0,0 +1,3 @@ +all: slow_drv@dll@ + +@SHLIB_RULES@ diff --git a/erts/emulator/test/trace_SUITE_data/slow_drv.c b/erts/emulator/test/trace_SUITE_data/slow_drv.c new file mode 100644 index 0000000000..4f7c93a69e --- /dev/null +++ b/erts/emulator/test/trace_SUITE_data/slow_drv.c @@ -0,0 +1,102 @@ +#ifdef __WIN32__ +#include <windows.h> +#endif + +#include <stdio.h> +#include "erl_driver.h" + +typedef struct _erl_drv_data { + ErlDrvPort erlang_port; +} EchoDrvData; + +static EchoDrvData slow_drv_data, *slow_drv_data_p; + +static EchoDrvData *slow_drv_start(ErlDrvPort port, char *command); +static void slow_drv_stop(EchoDrvData *data_p); +static void slow_drv_output(ErlDrvData drv_data, char *buf, + ErlDrvSizeT len); +static ErlDrvSSizeT slow_drv_control(ErlDrvData drv_data, unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen); +static void slow_drv_timeout(ErlDrvData drv_data); +static void slow_drv_finish(void); + +static ErlDrvEntry slow_drv_entry = { + NULL, /* init */ + slow_drv_start, + slow_drv_stop, + slow_drv_output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "slow_drv", + slow_drv_finish, + NULL, /* handle */ + slow_drv_control, /* control */ + slow_drv_timeout, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, + NULL, + NULL + +}; + +DRIVER_INIT(slow_drv) +{ + slow_drv_data_p = NULL; + return &slow_drv_entry; +} + +static EchoDrvData *slow_drv_start(ErlDrvPort port, char *command) +{ + if (slow_drv_data_p != NULL) { + return ERL_DRV_ERROR_GENERAL; + } + slow_drv_data_p = &slow_drv_data; + slow_drv_data_p->erlang_port = port; + return slow_drv_data_p; +} + +static void slow_drv_stop(EchoDrvData *data_p) { + slow_drv_data_p = NULL; +} + +static void slow_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { + EchoDrvData* data_p = (EchoDrvData *) drv_data; + driver_output(data_p->erlang_port, buf, len); +} + +static ErlDrvSSizeT slow_drv_control(ErlDrvData drv_data, unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) +{ + EchoDrvData* data_p = (EchoDrvData *) drv_data; + memcpy(*rbuf,"ok",2); + if (command == 1) { + driver_set_timer(data_p->erlang_port, 0); + } else { + slow_drv_timeout(drv_data); + } + return 2; +} + +static void slow_drv_timeout(ErlDrvData drv_data) +{ + /* Sleep for 150 msec */ +#ifdef __WIN32__ + Sleep(150); +#else + usleep(150000); +#endif +} + +static void slow_drv_finish() { + slow_drv_data_p = NULL; +} diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl index 4732d42296..03efb92e2e 100644 --- a/erts/emulator/test/trace_call_time_SUITE.erl +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -307,8 +307,7 @@ combo(Config) when is_list(Config) -> 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, [], [local]), 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, MetaMs, [{meta,MetaTracer}]), - %% not implemented - %2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_count]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_count]), 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]), %% @@ -337,9 +336,7 @@ combo(Config) when is_list(Config) -> {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfoBif), {value,{meta, MetaTracer}} = lists:keysearch(meta, 1, TraceInfoBif), {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfoBif), - %% not implemented - {value,{call_count,false}} = lists:keysearch(call_count, 1, TraceInfoBif), - %{value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfoBif), + {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfoBif), {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfoBif), %% @@ -408,8 +405,12 @@ bif(Config) when is_list(Config) -> %% 2 = erlang:trace_pattern({erlang, binary_to_term, '_'}, true, [call_time]), 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), + 1 = erlang:trace_pattern({?MODULE, with_bif, 1}, true, [call_time]), Pid = setup(), - {L, T1} = execute(Pid, fun() -> with_bif(M) end), + {L, Tot1} = execute(Pid, fun() -> with_bif(M) end), + + {call_time,[{Pid,_,S,Us}]} = erlang:trace_info({?MODULE,with_bif,1}, call_time), + T1 = Tot1 - (S*1000000 + Us), ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M - 1, 0, 0}], T1/2), ok = check_trace_info({erlang, term_to_binary, 1}, [{Pid, M - 1, 0, 0}], T1/2), @@ -418,9 +419,9 @@ bif(Config) when is_list(Config) -> 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, false, [call_time]), - {L, T2} = execute(Pid, fun() -> with_bif(M) end), + {L, _T2} = execute(Pid, fun() -> with_bif(M) end), - ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M*2 - 2, 0, 0}], T1/2 + T2), + ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M*2 - 2, 0, 0}], T1), ok = check_trace_info({erlang, term_to_binary, 1}, false, none), %% @@ -439,12 +440,14 @@ nif(Config) when is_list(Config) -> 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]), 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]), Pid = setup(), - {_, T1} = execute(Pid, fun() -> with_nif(M) end), + {_, Tot1} = execute(Pid, fun() -> with_nif(M) end), + + {call_time,[{Pid,_,S,Us}]} = erlang:trace_info({?MODULE,with_nif,1}, call_time), + T1 = Tot1 - (S*1000000 + Us), % the nif is called M - 1 times, the last time the function with 'with_nif' % returns ok and does not call the nif. - ok = check_trace_info({?MODULE, nif_dec, 1}, [{Pid, M-1, 0, 0}], T1/2), - ok = check_trace_info({?MODULE, with_nif, 1}, [{Pid, M, 0, 0}], T1/2), + ok = check_trace_info({?MODULE, nif_dec, 1}, [{Pid, M-1, 0, 0}], T1), %% P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), @@ -482,6 +485,8 @@ called_function(Config) when is_list(Config) -> %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% dead_tracer(Config) when is_list(Config) -> + TracedMFAs = dead_tracer_mfas(), + Self = self(), FirstTracer = tracer(), StartTracing = fun() -> turn_on_tracing(Self) end, @@ -496,14 +501,14 @@ dead_tracer(Config) when is_list(Config) -> erlang:yield(), %% Collect and check that we only get call_time info for the current process. - Info1 = collect_all_info(), + Info1 = collect_all_info(TracedMFAs), [] = other_than_self(Info1), io:format("~p\n", [Info1]), %% Note that we have not turned off tracing for the current process, %% but that the tracer has terminated. No more call_time information should be recorded. [1,2,3] = seq(1, 3, fun(I) -> I + 1 end), - [] = collect_all_info(), + [] = collect_all_info(TracedMFAs), %% When we start a second tracer process, that tracer process must %% not inherit the tracing flags and the dead tracer (even though @@ -512,7 +517,7 @@ dead_tracer(Config) when is_list(Config) -> tell_tracer(SecondTracer, StartTracing), Seq20 = lists:seq(1, 20), Seq20 = seq(1, 20, fun(I) -> I + 1 end), - Info2 = collect_all_info(), + Info2 = collect_all_info(TracedMFAs), io:format("~p\n", [Info2]), [] = other_than_self(Info2), SecondTracer ! quit, @@ -548,9 +553,21 @@ turn_on_tracing(Pid) -> _ = now(), ok. -collect_all_info() -> - collect_all_info([{?MODULE,F,A} || {F,A} <- module_info(functions)] ++ - erlang:system_info(snifs)). +%% We want to trace functions local to this module as well as all BIFs, and for +%% the latter we need to ensure that their modules are loaded. +dead_tracer_mfas() -> + Modules = [M || {M,_F,_A} <- erlang:system_info(snifs)], + Whitelist0 = gb_sets:from_list(Modules), + Whitelist = case code:ensure_modules_loaded(Modules) of + {error, Reasons} -> + Blacklist = gb_sets:from_list([M || {M, _} <- Reasons]), + gb_sets:subtract(Whitelist0, Blacklist); + ok -> + Whitelist0 + end, + EligibleSNIFs = [MFA || {M,_F,_A}=MFA <- erlang:system_info(snifs), + gb_sets:is_element(M, Whitelist)], + [{?MODULE,F,A} || {F,A} <- module_info(functions)] ++ EligibleSNIFs. collect_all_info([MFA|T]) -> CallTime = erlang:trace_info(MFA, call_time), @@ -669,21 +686,29 @@ seq_r(Start, Stop, Succ, R) -> seq_r(Succ(Start), Stop, Succ, [Start | R]). % Check call time tracing data and print mismatches -check_trace_info(Mfa, [{Pid, C,_,_}] = Expect, Time) -> - case erlang:trace_info(Mfa, call_time) of - % Time tests are somewhat problematic. We want to know if Time (EXPECTED_TIME) and S*1000000 + Us (ACTUAL_TIME) - % is the same. - % If the ratio EXPECTED_TIME/ACTUAL_TIME is ~ 1 or if EXPECTED_TIME - ACTUAL_TIME is near zero, the test is ok. - {call_time,[{Pid,C,S,Us}]} when S >= 0, Us >= 0, abs(1 - Time/(S*1000000 + Us)) < ?R_ERROR; abs(Time - S*1000000 - Us) < ?US_ERROR -> +check_trace_info(Mfa, [{Pid, ExpectedC,_,_}] = Expect, Time) -> + {call_time,[{Pid,C,S,Us}]} = erlang:trace_info(Mfa, call_time), + {Mod, Name, Arity} = Mfa, + IsBuiltin = erlang:is_builtin(Mod, Name, Arity), + if + %% Call count on BIFs may exceed number of calls as they often trap to + %% themselves. + IsBuiltin, C >= ExpectedC, S >= 0, Us >= 0, + abs(1 - Time/(S*1000000 + Us)) < ?R_ERROR; + abs(Time - S*1000000 - Us) < ?US_ERROR -> + ok; + not IsBuiltin, C =:= ExpectedC, S >= 0, Us >= 0, + abs(1 - Time/(S*1000000 + Us)) < ?R_ERROR; + abs(Time - S*1000000 - Us) < ?US_ERROR -> ok; - {call_time,[{Pid,C,S,Us}]} -> + true -> Sum = S*1000000 + Us, - io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~w s. ~w us. = ~w us. - ~w -> delta ~w (ratio ~.2f, should be 1.0)~n", - [Mfa, Expect, Time, S, Us, Sum, Time, Sum - Time, Time/Sum]), - time_error; - Other -> - io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~p~n", [ Mfa, Expect, Time, Other]), - time_count_error + io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~w " + "s. ~w us. = ~w us. - ~w -> delta ~w (ratio ~.2f, " + "should be 1.0)~n", + [Mfa, Expect, Time, + S, Us, Sum, Time, Sum - Time, Time/Sum]), + time_error end; check_trace_info(Mfa, Expect, _) -> case erlang:trace_info(Mfa, call_time) of @@ -748,7 +773,8 @@ setup() -> setup([]). setup(Opts) -> - Pid = spawn_link(fun() -> loop() end), + Pid = spawn_opt(fun() -> loop() end, + [link, {max_heap_size, 10000}]), 1 = erlang:trace(Pid, true, [call|Opts]), Pid. @@ -772,9 +798,12 @@ loop() -> quit -> ok; {Pid, execute, Fun } when is_function(Fun) -> + %% Make sure we always run with the same amount of reductions. + erlang:yield(), Pid ! {self(), answer, erlang:apply(Fun, [])}, loop(); {Pid, execute, {M, F, A}} -> + erlang:yield(), Pid ! {self(), answer, erlang:apply(M, F, A)}, loop() end. diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl index ad802352b9..699964b4fb 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -1111,12 +1111,14 @@ x_exc_body(ExcOpts, {M,F}=Func, Args, Apply) -> end, {value,Value} catch - Thrown when Nocatch -> + throw:Thrown:Stk when Nocatch -> + put(get_stacktrace, Stk), CR = {error,{nocatch,Thrown}}, x_exc_exception(Rtt, M, F, Args, Arity, CR), expect({eft,{?MODULE,exc,2},CR}), CR; - Class:Reason -> + Class:Reason:Stk -> + put(get_stacktrace, Stk), CR = {Class,Reason}, x_exc_exception(Rtt, M, F, Args, Arity, CR), expect({eft,{?MODULE,exc,2},CR}), @@ -1157,7 +1159,8 @@ x_exc_exception(_Rtt, M, F, _, Arity, CR) -> expect({eft,{M,F,Arity},CR}). x_exc_stacktrace() -> - x_exc_stacktrace(erlang:get_stacktrace()). + x_exc_stacktrace(get(get_stacktrace)). + %% Truncate stacktrace to below exc/2 x_exc_stacktrace([{?MODULE,x_exc,4,_}|_]) -> []; x_exc_stacktrace([{?MODULE,x_exc_func,4,_}|_]) -> []; |