diff options
Diffstat (limited to 'erts/emulator/test')
33 files changed, 2941 insertions, 1152 deletions
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index b1374950b2..a4c02da626 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 1997-2010. 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% # @@ -61,7 +61,7 @@ MODULES= \ exception_SUITE \ float_SUITE \ fun_SUITE \ - fun_r11_SUITE \ + fun_r12_SUITE \ gc_SUITE \ guard_SUITE \ hash_SUITE \ @@ -75,12 +75,12 @@ MODULES= \ node_container_SUITE \ nofrag_SUITE \ num_bif_SUITE \ - obsolete_SUITE \ op_SUITE \ port_SUITE \ port_bif_SUITE \ process_SUITE \ pseudoknot_SUITE \ + receive_SUITE \ ref_SUITE \ register_SUITE \ save_calls_SUITE \ @@ -100,6 +100,7 @@ MODULES= \ trace_local_SUITE \ trace_meta_SUITE \ trace_call_count_SUITE \ + trace_call_time_SUITE \ scheduler_SUITE \ old_scheduler_SUITE \ z_SUITE \ @@ -117,7 +118,8 @@ NO_OPT= bs_bincomp \ bs_match_int \ bs_match_tail \ bs_match_misc \ - bs_utf + bs_utf \ + guard NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE) diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index cc1626630b..228ff15341 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -1,26 +1,26 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1998-2010. 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(beam_SUITE). -export([all/1, packed_registers/1, apply_last/1, apply_last_bif/1, - buildo_mucho/1, heap_sizes/1, big_lists/1]). + buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1]). -export([applied/2]). @@ -279,3 +279,26 @@ b() -> _} -> ok end. + +fconv(Config) when is_list(Config) -> + ?line do_fconv(atom), + ?line do_fconv(nil), + ?line do_fconv(tuple_literal), + ?line 3.0 = do_fconv(1.0, 2.0), + ok. + +do_fconv(Type) -> + try + do_fconv(Type, 1.0), + test_server:fail() + catch + error:badarith -> + ok + end. + +do_fconv(atom, Float) when is_float(Float) -> + Float + a; +do_fconv(nil, Float) when is_float(Float) -> + Float + []; +do_fconv(tuple_literal, Float) when is_float(Float) -> + Float + {a,b}. diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index cfbc5dfe81..b4ef0e6d5a 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. 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% %% @@ -22,12 +22,13 @@ -include("test_server.hrl"). -export([all/1,init_per_testcase/2,fin_per_testcase/2, + types/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]). all(suite) -> - [t_list_to_existing_atom,os_env,otp_7526, + [types,t_list_to_existing_atom,os_env,otp_7526, atom_to_binary,binary_to_atom,binary_to_existing_atom, min_max]. @@ -39,6 +40,73 @@ fin_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). +types(Config) when is_list(Config) -> + c:l(erl_bif_types), + case erlang:function_exported(erl_bif_types, module_info, 0) of + false -> + %% Fail cleanly. + ?line ?t:fail("erl_bif_types not compiled"); + true -> + types_1() + end. + +types_1() -> + ?line List0 = erlang:system_info(snifs), + + %% Ignore missing type information for hipe BIFs. + ?line List = [MFA || {M,_,_}=MFA <- List0, M =/= hipe_bifs], + + case [MFA || MFA <- List, not known_types(MFA)] of + [] -> + types_2(List); + BadTypes -> + io:put_chars("No type information:\n"), + io:format("~p\n", [lists:sort(BadTypes)]), + ?line ?t:fail({length(BadTypes),bifs_without_types}) + end. + +types_2(List) -> + BadArity = [MFA || {M,F,A}=MFA <- List, + begin + Types = erl_bif_types:arg_types(M, F, A), + length(Types) =/= A + end], + case BadArity of + [] -> + types_3(List); + [_|_] -> + io:put_chars("Bifs with bad arity\n"), + io:format("~p\n", [BadArity]), + ?line ?t:fail({length(BadArity),bad_arity}) + end. + +types_3(List) -> + BadSmokeTest = [MFA || {M,F,A}=MFA <- List, + begin + try erl_bif_types:type(M, F, A) of + Type -> + %% Test that type is returned. + not erl_types:is_erl_type(Type) + catch + Class:Error -> + io:format("~p: ~p ~p\n", + [MFA,Class,Error]), + true + end + end], + case BadSmokeTest of + [] -> + ok; + [_|_] -> + io:put_chars("Bifs with failing calls to erlang_bif_types:type/3 " + "(or with bogus return values):\n"), + io:format("~p\n", [BadSmokeTest]), + ?line ?t:fail({length(BadSmokeTest),bad_smoke_test}) + end. + +known_types({M,F,A}) -> + erl_bif_types:is_known(M, F, A). + t_list_to_existing_atom(Config) when is_list(Config) -> ?line all = list_to_existing_atom("all"), ?line ?MODULE = list_to_existing_atom(?MODULE_STRING), @@ -308,6 +376,18 @@ min_max(Config) when is_list(Config) -> ?line 42.0 = erlang:min(42.0, 42), ?line 42.0 = erlang:max(42.0, 42), + %% And now (R14) they are also autoimported! + ?line a = min(id(a), a), + ?line a = min(id(a), b), + ?line a = min(id(b), a), + ?line b = min(id(b), b), + ?line a = max(id(a), a), + ?line b = max(id(a), b), + ?line b = max(id(b), a), + ?line b = max(id(b), b), + + ?line 42.0 = min(42.0, 42), + ?line 42.0 = max(42.0, 42), ok. diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index db2b3e10db..77d2579848 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -55,7 +55,6 @@ otp_5484/1,otp_5933/1, ordering/1,unaligned_order/1,gc_test/1, bit_sized_binary_sizes/1, - bitlevel_roundtrip/1, otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1, otp_8180/1]). @@ -70,7 +69,7 @@ all(suite) -> bad_binary_to_term_2,safe_binary_to_term2, bad_binary_to_term, bad_terms, t_hash, bad_size, bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, - gc_test, bit_sized_binary_sizes, bitlevel_roundtrip, otp_6817, otp_8117, + gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep,obsolete_funs,robustness,otp_8180]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> @@ -439,11 +438,11 @@ terms(Config) when is_list(Config) -> ok end, Term = binary_to_term(Bin), - Term = erlang:binary_to_term(Bin, [safe]), + Term = binary_to_term(Bin, [safe]), Unaligned = make_unaligned_sub_binary(Bin), Term = binary_to_term(Unaligned), - Term = erlang:binary_to_term(Unaligned, []), - Term = erlang:binary_to_term(Bin, [safe]), + Term = binary_to_term(Unaligned, []), + Term = binary_to_term(Bin, [safe]), BinC = erlang:term_to_binary(Term, [compressed]), Term = binary_to_term(BinC), true = size(BinC) =< size(Bin), @@ -543,7 +542,7 @@ bad_bin_to_term(BadBin) -> {'EXIT',{badarg,_}} = (catch binary_to_term(BadBin)). bad_bin_to_term(BadBin,Opts) -> - {'EXIT',{badarg,_}} = (catch erlang:binary_to_term(BadBin,Opts)). + {'EXIT',{badarg,_}} = (catch binary_to_term(BadBin,Opts)). safe_binary_to_term2(doc) -> "Test safety options for binary_to_term/2"; safe_binary_to_term2(Config) when is_list(Config) -> @@ -554,7 +553,7 @@ safe_binary_to_term2(Config) when is_list(Config) -> BadRef = <<131,114,0,3,BadHostAtom/binary,0,<<0,0,0,255>>/binary, Empty/binary,Empty/binary>>, ?line bad_bin_to_term(BadRef, [safe]), % good ref, with a bad atom - ?line fullsweep_after = erlang:binary_to_term(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom + ?line fullsweep_after = binary_to_term(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom BadExtFun = <<131,113,100,0,4,98,108,117,101,100,0,4,109,111,111,110,97,3>>, ?line bad_bin_to_term(BadExtFun, [safe]), ok. @@ -1150,35 +1149,6 @@ bsbs_1(A) -> Bin = binary_to_term(<<131,$M,5:32,A,0,0,0,0,0>>), BinSize = bit_size(Bin). -bitlevel_roundtrip(Config) when is_list(Config) -> - case ?t:is_release_available("r11b") of - true -> bitlevel_roundtrip_1(); - false -> {skip,"No R11B found"} - end. - -bitlevel_roundtrip_1() -> - Name = bitlevelroundtrip, - ?line N = list_to_atom(atom_to_list(Name) ++ "@" ++ hostname()), - ?line ?t:start_node(Name, slave, [{erl,[{release,"r11b"}]}]), - - ?line {<<128>>,1} = roundtrip(N, <<1:1>>), - ?line {<<64>>,2} = roundtrip(N, <<1:2>>), - ?line {<<16#E0>>,3} = roundtrip(N, <<7:3>>), - ?line {<<16#70>>,4} = roundtrip(N, <<7:4>>), - ?line {<<16#10>>,5} = roundtrip(N, <<2:5>>), - ?line {<<16#8>>,6} = roundtrip(N, <<2:6>>), - ?line {<<16#2>>,7} = roundtrip(N, <<1:7>>), - ?line {<<8,128>>,1} = roundtrip(N, <<8,1:1>>), - ?line {<<42,248>>,5} = roundtrip(N, <<42,31:5>>), - - ?line ?t:stop_node(N), - ok. - -roundtrip(Node, Term) -> - {badrpc,{'EXIT',Res}} = rpc:call(Node, erlang, exit, [Term]), - io:format("<<~p bits>> => ~w", [bit_size(Term),Res]), - Res. - deep(Config) when is_list(Config) -> ?line deep_roundtrip(lists:foldl(fun(E, A) -> [E,A] diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl index 9b16170293..7350aef4ec 100644 --- a/erts/emulator/test/busy_port_SUITE.erl +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. 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% %% @@ -182,7 +182,7 @@ system_monitor(Config) when is_list(Config) -> ?line Master ! {Owner, {command, "u"}}, ?line {Busy,beta} = rec(Void), ?line Void = rec(Void), - ?line NewMonitor = erlang:system_monitor(OldMonitor), + ?line _NewMonitor = erlang:system_monitor(OldMonitor), ?line OldMonitor = erlang:system_monitor(), ?line OldMonitor = erlang:system_monitor(OldMonitor), %% @@ -361,7 +361,6 @@ soft_busy_driver(Config) when is_list(Config) -> hs_test(Config, false). hs_test(Config, HardBusy) when is_list(Config) -> - ?line Me = self(), ?line DrvName = case HardBusy of true -> 'hard_busy_drv'; false -> 'soft_busy_drv' @@ -479,7 +478,7 @@ hs_busy_pcmd(Prt, Opts, StartFun, EndFun) -> Tester ! {self(), doing_port_command}, Start = os:timestamp(), Res = try {return, - erlang:port_command(Prt, [], Opts)} + port_command(Prt, [], Opts)} catch Exception:Error -> {Exception, Error} end, End = os:timestamp(), diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index 13f17e972c..d9e961be2f 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2008-2010. 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% %% @@ -24,10 +24,10 @@ -include("test_server.hrl"). -export([all/1,init_per_testcase/2,fin_per_testcase/2, - basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1]). + basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1]). all(suite) -> - [basic, packet_size, neg, http, line, ssl]. + [basic, packet_size, neg, http, line, ssl, otp_8536]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Seed = {S1,S2,S3} = now(), @@ -304,6 +304,10 @@ http(Config) when is_list(Config) -> {ok, {http_request, 'GET', ResB, {1,1}}, Rest} = decode_pkt(http_bin,Bin) end, lists:foreach(UriF, http_uri_variants()), + + %% Response with empty phrase + ?line {ok,{http_response,{1,1},200,[]},<<>>} = decode_pkt(http, <<"HTTP/1.1 200\r\n">>, []), + ?line {ok,{http_response,{1,1},200,<<>>},<<>>} = decode_pkt(http_bin, <<"HTTP/1.1 200\r\n">>, []), ok. http_with_bin(http) -> @@ -504,6 +508,27 @@ ssl(Config) when is_list(Config) -> F(v2hello), ok. +otp_8536(doc) -> ["Corrupt sub-binary-strings from httph_bin"]; +otp_8536(Config) when is_list(Config) -> + lists:foreach(fun otp_8536_do/1, lists:seq(1,50)), + ok. + +otp_8536_do(N) -> + Data = <<"some data 123">>, + Letters = <<"bcdefghijklmnopqrstuvwxyzyxwvutsrqponmlkjihgfedcba">>, + <<HdrTail:N/binary,_/binary>> = Letters, + Hdr = <<$A, HdrTail/binary>>, + Bin = <<Hdr/binary, ": ", Data/binary, "\r\n\r\n">>, + + io:format("Bin='~p'\n",[Bin]), + ?line {ok,{http_header,0,Hdr2,undefined,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">>, []), + + %% Now check that we got the expected binaries + {Hdr, Data} = {Hdr2, Data2}. + decode_pkt(Type,Bin) -> decode_pkt(Type,Bin,[]). decode_pkt(Type,Bin,Opts) -> diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 8f48d8a992..7c19274696 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -1,23 +1,24 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. 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(distribution_SUITE). +-compile(r12). %% Tests distribution and the tcp driver. diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c index 9e1e5e72c2..b571cb30e6 100644 --- a/erts/emulator/test/driver_SUITE_data/chkio_drv.c +++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c @@ -17,7 +17,7 @@ */ #ifndef UNIX -#if !defined(__WIN32__) && !defined(_OSE_) && !defined(VXWORKS) +#if !defined(__WIN32__) && !defined(VXWORKS) #define UNIX 1 #endif #endif diff --git a/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c b/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c index 25d4b17001..6afa46b3a2 100644 --- a/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c +++ b/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c @@ -17,7 +17,7 @@ */ #ifndef UNIX -#if !defined(__WIN32__) && !defined(_OSE_) && !defined(VXWORKS) +#if !defined(__WIN32__) && !defined(VXWORKS) #define UNIX 1 #endif #endif diff --git a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c index c7a42aa687..e49de388b4 100644 --- a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c +++ b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c @@ -29,7 +29,7 @@ */ #ifndef UNIX -#if !defined(__WIN32__) && !defined(_OSE_) && !defined(VXWORKS) +#if !defined(__WIN32__) && !defined(VXWORKS) #define UNIX 1 #endif #endif diff --git a/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c index c80e492e3f..e7d9a294fa 100644 --- a/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c +++ b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c @@ -17,7 +17,7 @@ */ #ifndef UNIX -#if !defined(__WIN32__) && !defined(_OSE_) && !defined(VXWORKS) +#if !defined(__WIN32__) && !defined(VXWORKS) #define UNIX 1 #endif #endif diff --git a/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c b/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c index f429a5b51e..3a5b5af13a 100644 --- a/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c +++ b/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c @@ -28,7 +28,7 @@ */ #ifndef UNIX -#if !defined(__WIN32__) && !defined(_OSE_) && !defined(VXWORKS) +#if !defined(__WIN32__) && !defined(VXWORKS) #define UNIX 1 #endif #endif diff --git a/erts/emulator/test/fun_r11_SUITE.erl b/erts/emulator/test/fun_r12_SUITE.erl index 61ba816cc8..9262731dcb 100644 --- a/erts/emulator/test/fun_r11_SUITE.erl +++ b/erts/emulator/test/fun_r12_SUITE.erl @@ -1,24 +1,24 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% --module(fun_r11_SUITE). --compile(r11). +-module(fun_r12_SUITE). +-compile(r12). -export([all/1,init_per_testcase/2,fin_per_testcase/2,dist_old_release/1]). @@ -37,36 +37,36 @@ fin_per_testcase(_Case, Config) -> ok. dist_old_release(Config) when is_list(Config) -> - case ?t:is_release_available("r11b") of + case ?t:is_release_available("r12b") of true -> do_dist_old(Config); - false -> {skip,"No R11B found"} + false -> {skip,"No R12B found"} end. do_dist_old(Config) when is_list(Config) -> ?line Pa = filename:dirname(code:which(?MODULE)), - Name = fun_dist_r11, + Name = fun_dist_r12, ?line {ok,Node} = ?t:start_node(Name, peer, [{args,"-pa "++Pa}, - {erl,[{release,"r11b"}]}]), + {erl,[{release,"r12b"}]}]), ?line Pid = spawn_link(Node, fun() -> receive Fun when is_function(Fun) -> - R11BFun = fun(H) -> cons(H, [b,c]) end, - Fun(Fun, R11BFun) + R12BFun = fun(H) -> cons(H, [b,c]) end, + Fun(Fun, R12BFun) end end), Self = self(), - Fun = fun(F, R11BFun) -> + Fun = fun(F, R12BFun) -> {pid,Self} = erlang:fun_info(F, pid), {module,?MODULE} = erlang:fun_info(F, module), - Self ! {ok,F,R11BFun} + Self ! {ok,F,R12BFun} end, ?line Pid ! Fun, ?line receive - {ok,Fun,R11BFun} -> - ?line [a,b,c] = R11BFun(a); + {ok,Fun,R12BFun} -> + ?line [a,b,c] = R12BFun(a); Other -> ?line ?t:fail({bad_message,Other}) end, diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl index 23482a20d7..8fef36dfaf 100644 --- a/erts/emulator/test/guard_SUITE.erl +++ b/erts/emulator/test/guard_SUITE.erl @@ -1,33 +1,34 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. 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(guard_SUITE). -export([all/1, bad_arith/1, bad_tuple/1, test_heap_guards/1, guard_bifs/1, - type_tests/1]). + type_tests/1,guard_bif_binary_part/1]). -include("test_server.hrl"). -export([init/3]). -import(lists, [member/2]). -all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, type_tests]. +all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, + type_tests, guard_bif_binary_part]. bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly."; bad_arith(Config) when is_list(Config) -> @@ -136,6 +137,170 @@ init(Fun, Args, Filler) -> dummy(_) -> ok. +-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))). +mask_error({'EXIT',{Err,_}}) -> + Err; +mask_error(Else) -> + Else. + +guard_bif_binary_part(doc) -> + ["Test the binary_part/2,3 guard BIF's extensively"]; +guard_bif_binary_part(Config) when is_list(Config) -> + %% Overflow tests that need to be unoptimized + ?line badarg = + ?MASK_ERROR( + binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + -16#7FFFFFFFFFFFFFFF-1})), + ?line badarg = + ?MASK_ERROR( + binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + 16#7FFFFFFFFFFFFFFF})), + F = fun(X) -> + Master = self(), + {Pid,Ref} = spawn_monitor( fun() -> + A = lists:duplicate(X,a), + B = [do_binary_part_guard() | A], + Master ! {self(),hd(B)}, + ok + end), + receive + {Pid,ok} -> + erlang:demonitor(Ref,[flush]), + ok; + Error -> + Error + end + end, + [ ok = F(N) || N <- lists:seq(1,10000) ], + ok. + + +do_binary_part_guard() -> + ?line 1 = bptest(<<1,2,3>>), + ?line 2 = bptest(<<2,1,3>>), + ?line error = bptest(<<1>>), + ?line error = bptest(<<>>), + ?line error = bptest(apa), + ?line 3 = bptest(<<2,3,3>>), + % With one variable (pos) + ?line 1 = bptest(<<1,2,3>>,1), + ?line 2 = bptest(<<2,1,3>>,1), + ?line error = bptest(<<1>>,1), + ?line error = bptest(<<>>,1), + ?line error = bptest(apa,1), + ?line 3 = bptest(<<2,3,3>>,1), + % With one variable (length) + ?line 1 = bptesty(<<1,2,3>>,1), + ?line 2 = bptesty(<<2,1,3>>,1), + ?line error = bptesty(<<1>>,1), + ?line error = bptesty(<<>>,1), + ?line error = bptesty(apa,1), + ?line 3 = bptesty(<<2,3,3>>,2), + % With one variable (whole tuple) + ?line 1 = bptestx(<<1,2,3>>,{1,1}), + ?line 2 = bptestx(<<2,1,3>>,{1,1}), + ?line error = bptestx(<<1>>,{1,1}), + ?line error = bptestx(<<>>,{1,1}), + ?line error = bptestx(apa,{1,1}), + ?line 3 = bptestx(<<2,3,3>>,{1,2}), + % With two variables + ?line 1 = bptest(<<1,2,3>>,1,1), + ?line 2 = bptest(<<2,1,3>>,1,1), + ?line error = bptest(<<1>>,1,1), + ?line error = bptest(<<>>,1,1), + ?line error = bptest(apa,1,1), + ?line 3 = bptest(<<2,3,3>>,1,2), + % Direct (autoimported) call, these will be evaluated by the compiler... + ?line <<2>> = binary_part(<<1,2,3>>,1,1), + ?line <<1>> = binary_part(<<2,1,3>>,1,1), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)), + ?line <<3,3>> = binary_part(<<2,3,3>>,1,2), + % Direct call through apply + ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), + ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), + ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), + % Constant propagation + ?line Bin = <<1,2,3>>, + ?line ok = if + binary_part(Bin,1,1) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ?line ok = if + binary_part(Bin,{1,1}) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ok. + + +bptest(B) when length(B) =:= 1337 -> + 1; +bptest(B) when binary_part(B,{1,1}) =:= <<2>> -> + 1; +bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> -> + 2; +bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> -> + 3; +bptest(_) -> + error. + +bptest(B,A) when length(B) =:= A -> + 1; +bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> -> + 1; +bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> -> + 2; +bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> -> + 3; +bptest(_,_) -> + error. + +bptestx(B,A) when length(B) =:= A -> + 1; +bptestx(B,A) when binary_part(B,A) =:= <<2>> -> + 1; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> -> + 2; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> -> + 3; +bptestx(_,_) -> + error. + +bptesty(B,A) when length(B) =:= A -> + 1; +bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> -> + 1; +bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> -> + 2; +bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> -> + 3; +bptesty(_,_) -> + error. + +bptest(B,A,_C) when length(B) =:= A -> + 1; +bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> -> + 1; +bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> -> + 2; +bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> -> + 3; +bptest(_,_,_) -> + error. + + guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments)."; guard_bifs(Config) when is_list(Config) -> ?line Big = -237849247829874297658726487367328971246284736473821617265433, diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index 85bdb8bff8..f5d1871bfb 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -480,14 +480,14 @@ otp_5292_test() -> S2 = md5([md5(hash_int(S, E, PH)) || {Start, N, Sz} <- d(), {S, E} <- int(Start, N, Sz)]), ?line Comment = case S1 of - <<43,186,76,102,87,4,110,245,203,177,206,6,130,69,43,99>> -> + <<4,248,208,156,200,131,7,1,173,13,239,173,112,81,16,174>> -> ?line big = erlang:system_info(endian), "Big endian machine"; - <<21,206,139,15,149,28,167,81,98,225,132,254,49,125,174,195>> -> + <<180,28,33,231,239,184,71,125,76,47,227,241,78,184,176,233>> -> ?line little = erlang:system_info(endian), "Little endian machine" end, - ?line <<140,37,79,80,26,242,130,22,20,229,123,240,223,244,43,99>> = S2, + ?line <<124,81,198,121,174,233,19,137,10,83,33,80,226,111,238,99>> = S2, ?line 2 = erlang:hash(1, (1 bsl 27) -1), ?line {'EXIT', _} = (catch erlang:hash(1, (1 bsl 27))), {comment, Comment}. @@ -507,7 +507,7 @@ hash_int(Start, End, F) -> {Start, End, md5(HL)}. md5(T) -> - erlang:md5(term_to_binary(T)). + erlang:md5(term_to_binary(T)). bit_level_binaries() -> ?line [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 522caec8f1..f45cfa3e4a 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -20,23 +20,39 @@ -module(nif_SUITE). %%-define(line_trace,true). -%%-define(CHECK(Exp,Got), ?line check(Exp,Got,?LINE)). --define(CHECK(Exp,Got), ?line Exp = Got). +-define(CHECK(Exp,Got), check(Exp,Got,?LINE)). +%%-define(CHECK(Exp,Got), ?line Exp = Got). -include("test_server.hrl"). --export([all/1, fin_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1, +-export([all/1, + %%init_per_testcase/2, + fin_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1, types/1, many_args/1, binaries/1, get_string/1, get_atom/1, api_macros/1, - from_array/1, iolist_as_binary/1, resource/1, resource_takeover/1, - threading/1, neg/1]). + from_array/1, iolist_as_binary/1, resource/1, resource_binary/1, resource_takeover/1, + threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, is_checks/1, + get_length/1, make_atom/1, make_string/1]). -export([many_args_100/100]). + + +%% -export([lib_version/0,call_history/0,hold_nif_mod_priv_data/1,nif_mod_call_history/0, +%% list_seq/1,type_test/0,tuple_2_list/1,is_identical/2,compare/2, +%% clone_bin/1,make_sub_bin/3,string_to_bin/2,atom_to_bin/2,macros/1, +%% tuple_2_list_and_tuple/1,iolist_2_bin/1,get_resource_type/1,alloc_resource/2, +%% make_resource/1,get_resource/2,release_resource/1,last_resource_dtor_call/0, +%% make_new_resource/2,make_new_resource_binary/1,send_list_seq/2,send_new_blob/2, +%% alloc_msgenv/0,clear_msgenv/1,grow_blob/2,send_blob/2,send_blob_thread/3, +%% join_send_thread/1]). + + -define(nif_stub,nif_stub_error(?LINE)). all(suite) -> [basic, reload, upgrade, heap_frag, types, many_args, binaries, get_string, - get_atom, api_macros, from_array, iolist_as_binary, resource, - resource_takeover, threading, neg]. + get_atom, api_macros, from_array, iolist_as_binary, resource, resource_binary, + resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks, + get_length, make_atom, make_string]. %%init_per_testcase(_Case, Config) -> %% ?line Dog = ?t:timetrap(?t:seconds(60*60*24)), @@ -473,12 +489,51 @@ resource_new_do2(Type) -> {{PtrA,BinA}, {ResB,PtrB,BinB}}. resource_neg(TypeA) -> + resource_neg_do(TypeA), + + catch exit(42), % dummy exception to purge saved stacktraces from earlier exception + erlang:garbage_collect(), + ?line {_,_,2} = last_resource_dtor_call(), + ok. + +resource_neg_do(TypeA) -> TypeB = get_resource_type(1), - Aptr = alloc_resource(TypeA, <<"Arnold">>), - Bptr = alloc_resource(TypeB, <<"Bobo">>), - ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeA, Bptr)), - ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeB, Aptr)), + ResA = make_new_resource(TypeA, <<"Arnold">>), + ResB= make_new_resource(TypeB, <<"Bobo">>), + ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeA, ResB)), + ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeB, ResA)), ok. + +resource_binary(doc) -> ["Test enif_make_resource_binary"]; +resource_binary(suite) -> []; +resource_binary(Config) when is_list(Config) -> + ?line ensure_lib_loaded(Config, 1), + ?line {Ptr,Bin} = resource_binary_do(), + erlang:garbage_collect(), + Last = last_resource_dtor_call(), + ?CHECK({Ptr,Bin,1}, Last), + ok. + +resource_binary_do() -> + Bin = <<"Hej Hopp i lingonskogen">>, + ?line {Ptr,ResBin1} = make_new_resource_binary(Bin), + ?line ResBin1 = Bin, + ?line ResInfo = {Ptr,_} = get_resource(binary_resource_type,ResBin1), + + Papa = self(), + Forwarder = spawn_link(fun() -> forwarder(Papa) end), + io:format("sending to forwarder pid=~p\n",[Forwarder]), + Forwarder ! ResBin1, + ResBin2 = receive_any(), + ?line ResBin2 = ResBin1, + ?line ResInfo = get_resource(binary_resource_type,ResBin2), + Forwarder ! terminate, + ?line {Forwarder, 1} = receive_any(), + erlang:garbage_collect(), + ?line ResInfo = get_resource(binary_resource_type,ResBin1), + ?line ResInfo = get_resource(binary_resource_type,ResBin2), + ResInfo. + -define(RT_CREATE,1). -define(RT_TAKEOVER,2). @@ -743,7 +798,282 @@ threading(Config) when is_list(Config) -> ?line ok = tester:load_nif_lib(Config, "tsd"), ?line ok = tester:run(). + +send(doc) -> ["Test NIF message sending"]; +send(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + N = 1500, + List = lists:seq(1,N), + ?line {ok,1} = send_list_seq(N, self), + ?line {ok,1} = send_list_seq(N, self()), + ?line List = receive_any(), + ?line List = receive_any(), + Papa = self(), + spawn_link(fun() -> ?line {ok,1} = send_list_seq(N, Papa) end), + ?line List = receive_any(), + + ?line {ok, 1, BlobS} = send_new_blob(self(), other_term()), + ?line BlobR = receive_any(), + io:format("Sent ~p\nGot ~p\n", [BlobS, BlobR]), + ?line BlobR = BlobS, + + %% send to dead pid + {DeadPid, DeadMon} = spawn_monitor(fun() -> void end), + ?line {'DOWN', DeadMon, process, DeadPid, normal} = receive_any(), + {ok,0} = send_list_seq(7, DeadPid), + ok. + +send2(doc) -> ["More NIF message sending"]; +send2(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + send2_do1(fun send_blob_dbg/2), + ok. + +send_threaded(doc) -> ["Send msg from user thread"]; +send_threaded(Config) when is_list(Config) -> + case erlang:system_info(smp_support) of + true -> + send2_do1(fun(ME,To) -> send_blob_thread_dbg(ME,To,join) end), + send2_do1(fun(ME,To) -> send_blob_thread_and_join(ME,To) end), + ok; + false -> + {skipped,"No threaded send on non-SMP"} + end. + + +send2_do1(SendBlobF) -> + io:format("sending to self=~p\n",[self()]), + send2_do2(SendBlobF, self()), + + Papa = self(), + Forwarder = spawn_link(fun() -> forwarder(Papa) end), + io:format("sending to forwarder pid=~p\n",[Forwarder]), + send2_do2(SendBlobF, Forwarder), + Forwarder ! terminate, + ?line {Forwarder, 4} = receive_any(), + ok. + +send2_do2(SendBlobF, To) -> + MsgEnv = alloc_msgenv(), + repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []), + ?line {ok,1,Blob0} = SendBlobF(MsgEnv, To), + ?line Blob1 = receive_any(), + ?line Blob1 = Blob0, + clear_msgenv(MsgEnv), + repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []), + ?line {ok,1,Blob2} = SendBlobF(MsgEnv, To), + ?line Blob3 = receive_any(), + ?line Blob3 = Blob2, + + clear_msgenv(MsgEnv), + repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []), + + clear_msgenv(MsgEnv), + repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []), + ?line {ok,1,Blob4} = SendBlobF(MsgEnv, To), + ?line Blob5 = receive_any(), + ?line Blob5 = Blob4, + + clear_msgenv(MsgEnv), + clear_msgenv(MsgEnv), + repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []), + ?line {ok,1,Blob6} = SendBlobF(MsgEnv, To), + ?line Blob7 = receive_any(), + ?line Blob7 = Blob6, + + ok. + + +send_blob_thread_and_join(MsgEnv, To) -> + ?line {ok,Blob} = send_blob_thread_dbg(MsgEnv, To, no_join), + ?line {ok,SendRes} = join_send_thread(MsgEnv), + {ok,SendRes,Blob}. + +send_blob_dbg(MsgEnv, To) -> + Ret = send_blob(MsgEnv, To), + %%io:format("send_blob to ~p returned ~p\n",[To,Ret]), + Ret. + +send_blob_thread_dbg(MsgEnv, To, Join) -> + Ret = send_blob_thread(MsgEnv, To, Join), + %%io:format("send_blob_thread to ~p Join=~p returned ~p\n",[To,Join,Ret]), + Ret. + + +forwarder(To) -> + forwarder(To, 0). +forwarder(To, N) -> + case receive_any() of + terminate -> + To ! {self(), N}; + Msg -> + To ! Msg, + forwarder(To, N+1) + end. + +other_term() -> + {fun(X,Y) -> X*Y end, make_ref()}. + +send3(doc) -> ["Message sending stress test"]; +send3(Config) when is_list(Config) -> + %% Let a number of processes send random message blobs between each other + %% using enif_send. Kill and spawn new ones randomly to keep a ~constant + %% number of workers running. + Seed = now(), + io:format("seed: ~p\n",[Seed]), + random:seed(Seed), + ets:new(nif_SUITE,[named_table,public]), + ?line true = ets:insert(nif_SUITE,{send3,0,0,0,0}), + timer:send_after(10000, timeout), % Run for 10 seconds + SpawnCnt = send3_controller(0, [], [], 20), + ?line [{_,Rcv,SndOk,SndFail,Balance}] = ets:lookup(nif_SUITE,send3), + io:format("spawns=~p received=~p, sent=~p send-failure=~p balance=~p\n", + [SpawnCnt,Rcv,SndOk,SndFail,Balance]), + ets:delete(nif_SUITE). + +send3_controller(SpawnCnt, [], _, infinity) -> + SpawnCnt; +send3_controller(SpawnCnt0, Mons0, Pids0, Tick) -> + receive + timeout -> + io:format("Timeout. Sending 'halt' to ~p\n",[Pids0]), + lists:foreach(fun(P) -> P ! {halt,self()} end, Pids0), + lists:foreach(fun(P) -> receive {halted,P} -> ok end end, Pids0), + QTot = lists:foldl(fun(P,QSum) -> + {message_queue_len,QLen} = + erlang:process_info(P,message_queue_len), + QSum + QLen + end, 0, Pids0), + io:format("Total queue length ~p\n",[QTot]), + lists:foreach(fun(P) -> P ! die end, Pids0), + send3_controller(SpawnCnt0, Mons0, [], infinity); + {'DOWN', MonRef, process, _Pid, _} -> + Mons1 = lists:delete(MonRef, Mons0), + %%io:format("Got DOWN from ~p. Monitors left: ~p\n",[Pid,Mons1]), + send3_controller(SpawnCnt0, Mons1, Pids0, Tick) + after Tick -> + Max = 20, + N = length(Pids0), + PidN = random:uniform(Max), + %%io:format("N=~p PidN=~p Pids0=~p\n", [N,PidN,Pids0]), + case PidN > N of + true -> + {NewPid,Mon} = spawn_opt(fun send3_proc/0, [link,monitor]), + lists:foreach(fun(P) -> P ! {is_born,NewPid} end, Pids0), + ?line Balance = ets:lookup_element(nif_SUITE,send3,5), + Inject = (Balance =< 0), + case Inject of + true -> ok; + false -> ets:update_element(nif_SUITE,send3,{5,-1}) + end, + NewPid ! {pids,Pids0,Inject}, + send3_controller(SpawnCnt0+1, [Mon|Mons0], [NewPid|Pids0], Tick); + false -> + KillPid = lists:nth(PidN,Pids0), + KillPid ! die, + Pids1 = lists:delete(KillPid, Pids0), + lists:foreach(fun(P) -> P ! {is_dead,KillPid} end, Pids1), + send3_controller(SpawnCnt0, Mons0, Pids1, Tick) + end + end. + +send3_proc() -> + %%io:format("Process ~p spawned\n",[self()]), + send3_proc([self()], {0,0,0}, {1,2,3,4,5}). +send3_proc(Pids0, Counters={Rcv,SndOk,SndFail}, State0) -> + %%io:format("~p: Pids0=~p", [self(), Pids0]), + %%timer:sleep(10), + receive + {pids, Pids1, Inject} -> + %%io:format("~p: got ~p Inject=~p\n", [self(), Pids1, Inject]), + ?line Pids0 = [self()], + Pids2 = [self() | Pids1], + case Inject of + true -> send3_proc_send(Pids2, Counters, State0); + false -> send3_proc(Pids2, Counters, State0) + end; + {is_born, Pid} -> + %%io:format("~p: is_born ~p, got ~p\n", [self(), Pid, Pids0]), + send3_proc([Pid | Pids0], Counters, State0); + {is_dead, Pid} -> + Pids1 = lists:delete(Pid,Pids0), + %%io:format("~p: is_dead ~p, got ~p\n", [self(), Pid, Pids1]), + send3_proc(Pids1, Counters, State0); + {blob, Blob0} -> + %%io:format("~p: blob ~p\n", [self(), Blob0]), + State1 = send3_new_state(State0, Blob0), + send3_proc_send(Pids0, {Rcv+1,SndOk,SndFail}, State1); + die -> + %%io:format("Process ~p terminating, stats = ~p\n",[self(),Counters]), + {message_queue_len,Dropped} = erlang:process_info(self(),message_queue_len), + _R = ets:update_counter(nif_SUITE,send3, + [{2,Rcv},{3,SndOk},{4,SndFail},{5,1-Dropped}]), + %%io:format("~p: dies R=~p\n", [self(), R]), + ok; + {halt,Papa} -> + Papa ! {halted,self()}, + io:format("~p halted\n",[self()]), + receive die -> ok end, + io:format("~p dying\n",[self()]) + end. + +send3_proc_send(Pids, {Rcv,SndOk,SndFail}, State0) -> + To = lists:nth(random:uniform(length(Pids)),Pids), + Blob = send3_make_blob(), + State1 = send3_new_state(State0,Blob), + case send3_send(To, Blob) of + true -> + send3_proc(Pids, {Rcv,SndOk+1,SndFail}, State1); + false -> + send3_proc(Pids, {Rcv,SndOk,SndFail+1}, State1) + end. + + +send3_make_blob() -> + case random:uniform(20)-1 of + 0 -> {term,[]}; + N -> + MsgEnv = alloc_msgenv(), + repeat(N bsr 1, + fun(_) -> grow_blob(MsgEnv,other_term(),random:uniform(1 bsl 20)) + end, void), + case (N band 1) of + 0 -> {term,copy_blob(MsgEnv)}; + 1 -> {msgenv,MsgEnv} + end + end. + +send3_send(Pid, Msg) -> + %% 90% enif_send and 10% normal bang + case random:uniform(10) of + 1 -> send3_send_bang(Pid,Msg); + _ -> send3_send_nif(Pid,Msg) + end. +send3_send_nif(Pid, {term,Blob}) -> + %%io:format("~p send term nif\n",[self()]), + send_term(Pid, {blob, Blob}) =:= 1; +send3_send_nif(Pid, {msgenv,MsgEnv}) -> + %%io:format("~p send blob nif\n",[self()]), + send3_blob(MsgEnv, Pid, blob) =:= 1. + +send3_send_bang(Pid, {term,Blob}) -> + %%io:format("~p send term bang\n",[self()]), + Pid ! {blob, Blob}, + true; +send3_send_bang(Pid, {msgenv,MsgEnv}) -> + %%io:format("~p send blob bang\n",[self()]), + Pid ! {blob, copy_blob(MsgEnv)}, + true. + +send3_new_state(State, Blob) -> + case random:uniform(5+2) of + N when N =< 5-> setelement(N, State, Blob); + _ -> State % Don't store blob + end. + neg(doc) -> ["Negative testing of load_nif"]; neg(Config) when is_list(Config) -> TmpMem = tmpmem(), @@ -759,7 +1089,17 @@ neg(Config) when is_list(Config) -> ?line verify_tmpmem(TmpMem), ?line ok. +is_checks(doc) -> ["Test all enif_is functions"]; +is_checks(Config) when is_list(Config) -> + ?line ensure_lib_loaded(Config, 1), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}). +get_length(doc) -> ["Test all enif_get_length functions"]; +get_length(Config) when is_list(Config) -> + ?line ensure_lib_loaded(Config, 1), + ?line ok = length_test(hejsan, "hejsan", [], [], not_a_list). ensure_lib_loaded(Config) -> ensure_lib_loaded(Config, 1). @@ -773,6 +1113,23 @@ ensure_lib_loaded(Config, Ver) -> ok end. +make_atom(Config) when is_list(Config) -> + ?line ensure_lib_loaded(Config, 1), + An0Atom = an0atom, + An0Atom0 = 'an\000atom\000', + ?line Atoms = make_atoms(), + ?line 7 = size(Atoms), + ?line Atoms = {An0Atom,An0Atom,An0Atom,An0Atom0,An0Atom,An0Atom,An0Atom0}. + +make_string(Config) when is_list(Config) -> + ?line ensure_lib_loaded(Config, 1), + ?line Strings = make_strings(), + ?line 5 = size(Strings), + A0String = "a0string", + A0String0 = [$a,0,$s,$t,$r,$i,$n,$g,0], + AStringWithAccents = [$E,$r,$l,$a,$n,$g,$ ,16#e4,$r,$ ,$e,$t,$t,$ ,$g,$e,$n,$e,$r,$e,$l,$l,$t,$ ,$p,$r,$o,$g,$r,$a,$m,$s,$p,$r,16#e5,$k], + ?line Strings = {A0String,A0String,A0String,A0String0, AStringWithAccents}. + tmpmem() -> case erlang:system_info({allocator,temp_alloc}) of false -> undefined; @@ -821,13 +1178,18 @@ call(Pid,Cmd) -> receive_any() -> receive M -> M end. -%% check(Exp,Got,Line) -> -%% case Got of -%% Exp -> Exp; -%% _ -> -%% io:format("CHECK at ~p: Expected ~p but got ~p\n",[Line,Exp,Got]), -%% Got -%% end. +repeat(0, _, Arg) -> + Arg; +repeat(N, Fun, Arg0) -> + repeat(N-1, Fun, Fun(Arg0)). + +check(Exp,Got,Line) -> + case Got of + Exp -> Exp; + _ -> + io:format("CHECK at ~p: Expected ~p but got ~p\n",[Line,Exp,Got]), + Got + end. %% The NIFs: @@ -855,6 +1217,23 @@ get_resource(_,_) -> ?nif_stub. release_resource(_) -> ?nif_stub. last_resource_dtor_call() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. +check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. +length_test(_,_,_,_,_) -> ?nif_stub. +make_atoms() -> ?nif_stub. +make_strings() -> ?nif_stub. +make_new_resource_binary(_) -> ?nif_stub. +send_list_seq(_,_) -> ?nif_stub. +send_new_blob(_,_) -> ?nif_stub. +alloc_msgenv() -> ?nif_stub. +clear_msgenv(_) -> ?nif_stub. +grow_blob(_,_) -> ?nif_stub. +grow_blob(_,_,_) -> ?nif_stub. +send_blob(_,_) -> ?nif_stub. +send3_blob(_,_,_) -> ?nif_stub. +send_blob_thread(_,_,_) -> ?nif_stub. +join_send_thread(_) -> ?nif_stub. +copy_blob(_) -> ?nif_stub. +send_term(_,_) -> ?nif_stub. nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 7d05a9a880..17f644829f 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1,3 +1,21 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2010. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ #include "erl_nif.h" #include <stdio.h> @@ -10,6 +28,12 @@ static int static_cntA; /* zero by default */ static int static_cntB = NIF_SUITE_LIB_VER * 100; +static ERL_NIF_TERM atom_self; +static ERL_NIF_TERM atom_ok; +static ERL_NIF_TERM atom_join; +static ERL_NIF_TERM atom_binary_resource_type; + + typedef struct { int ref_cnt; @@ -20,7 +44,7 @@ typedef struct void add_call(ErlNifEnv* env, PrivData* data, const char* func_name) { - CallInfo* call = enif_alloc(env, sizeof(CallInfo)+strlen(func_name)); + CallInfo* call = enif_alloc(sizeof(CallInfo)+strlen(func_name)); strcpy(call->func_name, func_name); call->lib_ver = NIF_SUITE_LIB_VER; call->next = data->call_history; @@ -31,7 +55,7 @@ void add_call(ErlNifEnv* env, PrivData* data, const char* func_name) call->arg_sz = 0; } -#define ADD_CALL(FUNC_NAME) add_call(env, enif_get_data(env),FUNC_NAME) +#define ADD_CALL(FUNC_NAME) add_call(env, enif_priv_data(env),FUNC_NAME) static void* resource_dtor_last = NULL; static unsigned resource_dtor_last_sz = 0; @@ -42,15 +66,24 @@ static void resource_dtor(ErlNifEnv* env, void* obj) { resource_dtor_last = obj; resource_dtor_cnt++; - resource_dtor_last_sz = enif_sizeof_resource(env, obj); + resource_dtor_last_sz = enif_sizeof_resource(obj); assert(resource_dtor_last_sz <= sizeof(resource_dtor_last_data)); memcpy(resource_dtor_last_data, obj, resource_dtor_last_sz); } +static ErlNifResourceType* msgenv_resource_type; +static void msgenv_dtor(ErlNifEnv* env, void* obj); + +static ErlNifResourceType* binary_resource_type; +static void binary_resource_dtor(ErlNifEnv* env, void* obj); +struct binary_resource { + unsigned char* data; + unsigned size; +}; + static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { - /*ERL_NIF_TERM head, tail;*/ - PrivData* data = enif_alloc(env, sizeof(PrivData)); + PrivData* data = enif_alloc(sizeof(PrivData)); assert(data != NULL); data->ref_cnt = 1; data->call_history = NULL; @@ -58,41 +91,71 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) add_call(env, data, "load"); - /* - head = load_info; - data->rt_cnt = 0; - for (head=load_info; enif_get_list_cell(env,load_info,&head,&tail); - head=tail) { - char buf[20]; - int n = enif_get_string(env,head,buf,sizeof(buf)); - assert(n > 0); - assert(i < sizeof(data->rt_arr)/sizeof(*data->rt_arr)); - data->rt_arr[data->rt_cnt++].t = enif_create_resource_type(env,buf,resource_dtor, - ERL_NIF_RT_CREATE,NULL); - } - assert(enif_is_empty_list(env,head)); - */ - data->rt_arr[0].t = enif_open_resource_type(env,"Gold",resource_dtor, + data->rt_arr[0].t = enif_open_resource_type(env,NULL,"Gold",resource_dtor, ERL_NIF_RT_CREATE,NULL); - data->rt_arr[1].t = enif_open_resource_type(env,"Silver",resource_dtor, + data->rt_arr[1].t = enif_open_resource_type(env,NULL,"Silver",resource_dtor, ERL_NIF_RT_CREATE,NULL); + binary_resource_type = enif_open_resource_type(env,NULL,"nif_SUITE.binary", + binary_resource_dtor, + ERL_NIF_RT_CREATE, NULL); + + msgenv_resource_type = enif_open_resource_type(env,NULL,"nif_SUITE.msgenv", + msgenv_dtor, + ERL_NIF_RT_CREATE, NULL); + + atom_self = enif_make_atom(env,"self"); + atom_ok = enif_make_atom(env,"ok"); + atom_join = enif_make_atom(env,"join"); + atom_binary_resource_type = enif_make_atom(env,"binary_resource_type"); + *priv_data = data; return 0; } +static void resource_takeover(ErlNifEnv* env, PrivData* priv) +{ + ErlNifResourceFlags tried; + ErlNifResourceType* rt; + rt = enif_open_resource_type(env, NULL, "Gold", resource_dtor, + ERL_NIF_RT_TAKEOVER, &tried); + assert(rt == priv->rt_arr[0].t); + assert(tried == ERL_NIF_RT_TAKEOVER); + rt = enif_open_resource_type(env, NULL, "Silver", resource_dtor, + ERL_NIF_RT_TAKEOVER, &tried); + assert(rt == priv->rt_arr[1].t); + assert(tried == ERL_NIF_RT_TAKEOVER); + + rt = enif_open_resource_type(env, NULL, "nif_SUITE.binary", binary_resource_dtor, + ERL_NIF_RT_TAKEOVER, &tried); + assert(rt != NULL); + assert(tried == ERL_NIF_RT_TAKEOVER); + assert(binary_resource_type==NULL || binary_resource_type == rt); + binary_resource_type = rt; + + rt = enif_open_resource_type(env, NULL, "nif_SUITE.msgenv", msgenv_dtor, + ERL_NIF_RT_TAKEOVER, &tried); + assert(rt != NULL); + assert(tried == ERL_NIF_RT_TAKEOVER); + assert(msgenv_resource_type==NULL || msgenv_resource_type == rt); + msgenv_resource_type = rt; +} + static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { - add_call(env, *priv_data, "reload"); + PrivData* priv = (PrivData*) *priv_data; + add_call(env, priv, "reload"); + resource_takeover(env,priv); return 0; } static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info) { - PrivData* data = *old_priv_data; - add_call(env, data, "upgrade"); - data->ref_cnt++; - *priv_data = *old_priv_data; + PrivData* priv = (PrivData*) *old_priv_data; + add_call(env, priv, "upgrade"); + priv->ref_cnt++; + *priv_data = *old_priv_data; + resource_takeover(env,priv); return 0; } @@ -101,7 +164,10 @@ static void unload(ErlNifEnv* env, void* priv_data) PrivData* data = priv_data; add_call(env, data, "unload"); if (--data->ref_cnt == 0) { - enif_free(env, priv_data); + if (data->nif_mod != NULL) { + NifModPrivData_release(data->nif_mod); + } + enif_free(priv_data); } } @@ -120,11 +186,10 @@ static ERL_NIF_TERM make_call_history(ErlNifEnv* env, CallInfo** headp) ERL_NIF_TERM func_term = enif_make_atom(env,call->func_name); ERL_NIF_TERM tpl; if (call->arg != NULL) { - ErlNifBinary arg_bin; - enif_alloc_binary(env, call->arg_sz, &arg_bin); - memcpy(arg_bin.data, call->arg, call->arg_sz); - func_term = enif_make_tuple2(env, func_term, - enif_make_binary(env, &arg_bin)); + ERL_NIF_TERM arg_bin; + memcpy(enif_make_new_binary(env, call->arg_sz, &arg_bin), + call->arg, call->arg_sz); + func_term = enif_make_tuple2(env, func_term, arg_bin); } tpl = enif_make_tuple4(env, func_term, enif_make_int(env,call->lib_ver), @@ -132,28 +197,28 @@ static ERL_NIF_TERM make_call_history(ErlNifEnv* env, CallInfo** headp) enif_make_int(env,call->static_cntB)); list = enif_make_list_cell(env, tpl, list); *headp = call->next; - enif_free(env,call); + enif_free(call); } return list; } static ERL_NIF_TERM call_history(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - PrivData* data = (PrivData*) enif_get_data(env); + PrivData* data = (PrivData*) enif_priv_data(env); return make_call_history(env,&data->call_history); } static ERL_NIF_TERM hold_nif_mod_priv_data(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - PrivData* data = (PrivData*) enif_get_data(env); + PrivData* data = (PrivData*) enif_priv_data(env); unsigned long ptr_as_ulong; if (!enif_get_ulong(env,argv[0],&ptr_as_ulong)) { return enif_make_badarg(env); } - if (data->nif_mod != NULL && --(data->nif_mod->ref_cnt) == 0) { - enif_free(env,data->nif_mod); + if (data->nif_mod != NULL) { + NifModPrivData_release(data->nif_mod); } data->nif_mod = (NifModPrivData*) ptr_as_ulong; return enif_make_int(env,++(data->nif_mod->ref_cnt)); @@ -161,7 +226,7 @@ static ERL_NIF_TERM hold_nif_mod_priv_data(ErlNifEnv* env, int argc, const ERL_N static ERL_NIF_TERM nif_mod_call_history(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - PrivData* data = (PrivData*) enif_get_data(env); + PrivData* data = (PrivData*) enif_priv_data(env); ERL_NIF_TERM ret; if (data->nif_mod == NULL) { return enif_make_string(env,"nif_mod pointer is NULL", ERL_NIF_LATIN1); @@ -337,13 +402,13 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ } } - if (!enif_make_existing_atom(env,"nif_SUITE", &atom) - || !enif_is_identical(env,atom,enif_make_atom(env,"nif_SUITE"))) { + if (!enif_make_existing_atom(env,"nif_SUITE", &atom, ERL_NIF_LATIN1) + || !enif_is_identical(atom,enif_make_atom(env,"nif_SUITE"))) { fprintf(stderr, "nif_SUITE not an atom?\r\n"); goto error; } for (i=2; i; i--) { - if (enif_make_existing_atom(env,"nif_SUITE_pink_unicorn", &atom)) { + if (enif_make_existing_atom(env,"nif_SUITE_pink_unicorn", &atom, ERL_NIF_LATIN1)) { fprintf(stderr, "pink unicorn exist?\r\n"); goto error; } @@ -351,7 +416,7 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ref1 = enif_make_ref(env); ref2 = enif_make_ref(env); if (!enif_is_ref(env,ref1) || !enif_is_ref(env,ref2) - || enif_is_identical(env,ref1,ref2) || enif_compare(env,ref1,ref2)==0) { + || enif_is_identical(ref1,ref2) || enif_compare(ref1,ref2)==0) { fprintf(stderr, "strange refs?\r\n"); goto error; } @@ -381,7 +446,7 @@ static ERL_NIF_TERM is_identical(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar if (argc != 2) { return enif_make_badarg(env); } - return enif_make_atom(env, (enif_is_identical(env,argv[0],argv[1]) ? + return enif_make_atom(env, (enif_is_identical(argv[0],argv[1]) ? "true" : "false")); } @@ -390,7 +455,7 @@ static ERL_NIF_TERM compare(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) if (argc != 2) { return enif_make_badarg(env); } - return enif_make_int(env, enif_compare(env,argv[0],argv[1])); + return enif_make_int(env, enif_compare(argv[0],argv[1])); } static ERL_NIF_TERM many_args_100(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -412,11 +477,10 @@ static ERL_NIF_TERM clone_bin(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ { ErlNifBinary ibin; if (enif_inspect_binary(env,argv[0],&ibin)) { - ErlNifBinary obin; - enif_alloc_binary(env,ibin.size,&obin); - memcpy(obin.data,ibin.data,ibin.size); - /*enif_release_binary(env,&ibin);*/ - return enif_make_binary(env,&obin); + ERL_NIF_TERM obin; + memcpy(enif_make_new_binary(env, ibin.size, &obin), + ibin.data, ibin.size); + return obin; } else { return enif_make_badarg(env); @@ -438,7 +502,7 @@ static ERL_NIF_TERM string_to_bin(ErlNifEnv* env, int argc, const ERL_NIF_TERM a unsigned size; int n; if (!enif_get_int(env,argv[1],(int*)&size) - || !enif_alloc_binary(env,size,&obin)) { + || !enif_alloc_binary(size,&obin)) { return enif_make_badarg(env); } n = enif_get_string(env, argv[0], (char*)obin.data, size, ERL_NIF_LATIN1); @@ -452,10 +516,10 @@ static ERL_NIF_TERM atom_to_bin(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg unsigned size; int n; if (!enif_get_int(env,argv[1],(int*)&size) - || !enif_alloc_binary(env,size,&obin)) { + || !enif_alloc_binary(size,&obin)) { return enif_make_badarg(env); } - n = enif_get_atom(env, argv[0], (char*)obin.data, size); + n = enif_get_atom(env, argv[0], (char*)obin.data, size, ERL_NIF_LATIN1); return enif_make_tuple(env, 2, enif_make_int(env,n), enif_make_binary(env,&obin)); } @@ -515,14 +579,14 @@ static ERL_NIF_TERM iolist_2_bin(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar static ERL_NIF_TERM last_resource_dtor_call(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - ErlNifBinary bin; ERL_NIF_TERM ret; if (resource_dtor_last != NULL) { - enif_alloc_binary(env, resource_dtor_last_sz, &bin); - memcpy(bin.data, resource_dtor_last_data, resource_dtor_last_sz); + ERL_NIF_TERM bin; + memcpy(enif_make_new_binary(env, resource_dtor_last_sz, &bin), + resource_dtor_last_data, resource_dtor_last_sz); ret = enif_make_tuple3(env, enif_make_long(env, (long)resource_dtor_last), - enif_make_binary(env, &bin), + bin, enif_make_int(env, resource_dtor_cnt)); } else { @@ -536,7 +600,7 @@ static ERL_NIF_TERM last_resource_dtor_call(ErlNifEnv* env, int argc, const ERL_ static ERL_NIF_TERM get_resource_type(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - PrivData* data = (PrivData*) enif_get_data(env); + PrivData* data = (PrivData*) enif_priv_data(env); int ix; if (!enif_get_int(env, argv[0], &ix) || ix >= 2) { @@ -552,7 +616,7 @@ static ERL_NIF_TERM alloc_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM union { void* p; long l;} data; if (!enif_get_long(env, argv[0], &type.l) || !enif_inspect_binary(env, argv[1], &data_bin) - || (data.p = enif_alloc_resource(env, type.t, data_bin.size))==NULL) { + || (data.p = enif_alloc_resource(type.t, data_bin.size))==NULL) { return enif_make_badarg(env); } @@ -577,28 +641,65 @@ static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TE ERL_NIF_TERM ret; if (!enif_get_long(env, argv[0], &type.l) || !enif_inspect_binary(env, argv[1], &data_bin) - || (data = enif_alloc_resource(env, type.t, data_bin.size))==NULL) { + || (data = enif_alloc_resource(type.t, data_bin.size))==NULL) { return enif_make_badarg(env); } ret = enif_make_resource(env, data); memcpy(data, data_bin.data, data_bin.size); - enif_release_resource(env, data); + enif_release_resource(data); return ret; } +static ERL_NIF_TERM make_new_resource_binary(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifBinary data_bin; + union { struct binary_resource* p; void* vp; long l;} br; + void* buf; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &data_bin) + || (br.vp = enif_alloc_resource(binary_resource_type, + sizeof(struct binary_resource)))==NULL + || (buf = enif_alloc(data_bin.size)) == NULL) { + + return enif_make_badarg(env); + } + memset(br.vp,0xba,sizeof(struct binary_resource)); /* avoid valgrind warning */ + br.p->data = buf; + br.p->size = data_bin.size; + memcpy(br.p->data, data_bin.data, data_bin.size); + ret = enif_make_resource_binary(env, br.vp, br.p->data, br.p->size); + enif_release_resource(br.p); + return enif_make_tuple2(env, enif_make_long(env,br.l), ret); +} + +static void binary_resource_dtor(ErlNifEnv* env, void* obj) +{ + struct binary_resource* br = (struct binary_resource*) obj; + resource_dtor(env,obj); + assert(br->data != NULL); + enif_free(br->data); + br->data = NULL; +} + static ERL_NIF_TERM get_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary data_bin; union { ErlNifResourceType* t; long l; } type; union { void* p; long l; } data; - if (!enif_get_long(env, argv[0], &type.l) + type.t = NULL; + if (enif_is_identical(argv[0], atom_binary_resource_type)) { + type.t = binary_resource_type; + } + else { + enif_get_long(env, argv[0], &type.l); + } + if (type.t == NULL || !enif_get_resource(env, argv[1], type.t, &data.p)) { return enif_make_badarg(env); } - - enif_alloc_binary(env, enif_sizeof_resource(env,data.p), &data_bin); + enif_alloc_binary(enif_sizeof_resource(data.p), &data_bin); memcpy(data_bin.data, data.p, data_bin.size); return enif_make_tuple2(env, enif_make_long(env,data.l), enif_make_binary(env, &data_bin)); @@ -610,10 +711,592 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER if (!enif_get_long(env, argv[0], &data.l)) { return enif_make_badarg(env); } - enif_release_resource(env, data.p); + enif_release_resource(data.p); return enif_make_atom(env,"ok"); } +/* + * argv[0] an atom + * argv[1] a binary + * argv[2] a ref + * argv[3] 'ok' + * argv[4] a fun + * argv[5] a pid + * argv[6] a port + * argv[7] an empty list + * argv[8] a non-empty list + * argv[9] a tuple + */ +static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM ok_atom = enif_make_atom(env, "ok"); + + if (!enif_is_atom(env, argv[0])) return enif_make_badarg(env); + if (!enif_is_binary(env, argv[1])) return enif_make_badarg(env); + if (!enif_is_ref(env, argv[2])) return enif_make_badarg(env); + if (!enif_is_identical(argv[3], ok_atom)) return enif_make_badarg(env); + if (!enif_is_fun(env, argv[4])) return enif_make_badarg(env); + if (!enif_is_pid(env, argv[5])) return enif_make_badarg(env); + if (!enif_is_port(env, argv[6])) return enif_make_badarg(env); + if (!enif_is_empty_list(env, argv[7])) return enif_make_badarg(env); + if (!enif_is_list(env, argv[7])) return enif_make_badarg(env); + if (!enif_is_list(env, argv[8])) return enif_make_badarg(env); + if (!enif_is_tuple(env, argv[9])) return enif_make_badarg(env); + + return ok_atom; +} + +/* + * argv[0] atom with length of 6 + * argv[1] list with length of 6 + * argv[2] empty list + * argv[3] not an atom + * argv[4] not a list + */ +static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + unsigned len; + + if (!enif_get_atom_length(env, argv[0], &len, ERL_NIF_LATIN1) || len != 6) + return enif_make_badarg(env); + + if (!enif_get_list_length(env, argv[1], &len) || len != 6) + return enif_make_badarg(env); + + if (!enif_get_list_length(env, argv[2], &len) || len != 0) + return enif_make_badarg(env); + + if (enif_get_atom_length(env, argv[3], &len, ERL_NIF_LATIN1)) + return enif_make_badarg(env); + + if (enif_get_list_length(env, argv[4], &len)) + return enif_make_badarg(env); + + return enif_make_atom(env, "ok"); +} + +static ERL_NIF_TERM make_atoms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM arr[7]; + ERL_NIF_TERM existingatom0a, existingatom0b; + ERL_NIF_TERM existing0atom0; + const char * const an0atom = "an0atom"; + const char an0atom0[8] = {'a','n','\0','a','t','o','m',0}; + + arr[0] = enif_make_atom(env, "an0atom"); + arr[1] = enif_make_atom_len(env, "an0atom", 7); + arr[2] = enif_make_atom_len(env, an0atom, 7); + arr[3] = enif_make_atom_len(env, an0atom0, 8); + + if (!enif_make_existing_atom(env, "an0atom", &existingatom0a, ERL_NIF_LATIN1)) + return enif_make_atom(env, "error"); + arr[4] = existingatom0a; + + if (!enif_make_existing_atom_len(env, an0atom, 7, &existingatom0b, ERL_NIF_LATIN1)) + return enif_make_atom(env, "error"); + arr[5] = existingatom0b; + + if (!enif_make_existing_atom_len(env, an0atom0, 8, &existing0atom0, ERL_NIF_LATIN1)) + return enif_make_atom(env, "error"); + arr[6] = existing0atom0; + + return enif_make_tuple7(env, + arr[0],arr[1],arr[2],arr[3],arr[4],arr[5],arr[6]); +} + +static ERL_NIF_TERM make_strings(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + const char a0string[8] = {'a','0','s','t','r','i','n','g'}; + const char a0string0[9] = {'a','\0','s','t','r','i','n','g',0}; + const char astringwith8bits[37] = {'E','r','l','a','n','g',' ',0xE4 /* 'ä' */,'r',' ','e','t','t',' ','g','e','n','e','r','e','l','l','t',' ','p','r','o','g','r','a','m','s','p','r', 0xE5 /* 'å' */,'k',0}; + + return enif_make_tuple5(env, + enif_make_string(env, "a0string", ERL_NIF_LATIN1), + enif_make_string_len(env, "a0string", 8, ERL_NIF_LATIN1), + enif_make_string_len(env, a0string, 8, ERL_NIF_LATIN1), + enif_make_string_len(env, a0string0, 9, ERL_NIF_LATIN1), + enif_make_string(env, astringwith8bits, ERL_NIF_LATIN1)); +} +static ERL_NIF_TERM send_list_seq(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid to; + ERL_NIF_TERM msg; + ErlNifEnv* msg_env; + int i, res; + + if (!enif_get_int(env, argv[0], &i)) { + return enif_make_badarg(env); + } + if (argv[1] == atom_self) { + enif_self(env, &to); + } + else if (!enif_get_local_pid(env, argv[1], &to)) { + return enif_make_badarg(env); + } + msg_env = enif_alloc_env(); + msg = enif_make_list(msg_env,0); + for ( ; i>0 ; i--) { + msg = enif_make_list_cell(msg_env, enif_make_int(msg_env, i), msg); + } + res = enif_send(env, &to, msg_env, msg); + enif_free_env(msg_env); + return enif_make_tuple2(env, atom_ok, enif_make_int(env,res)); +} + +static void fill(void* dst, unsigned bytes, int seed) +{ + unsigned char* ptr = dst; + int i; + for (i=bytes; i>0; i--) { + *ptr++ = seed; + seed += 7; + } +} + +#define MAKE_TERM_REUSE_LEN 16 +struct make_term_info +{ + ErlNifEnv* caller_env; + ErlNifEnv* dst_env; + ERL_NIF_TERM reuse[MAKE_TERM_REUSE_LEN]; + unsigned reuse_push; + unsigned reuse_pull; + ErlNifResourceType* resource_type; + ERL_NIF_TERM other_term; + ERL_NIF_TERM blob; + ErlNifPid to_pid; + ErlNifTid tid; + ErlNifCond* cond; + ErlNifMutex* mtx; + int send_it; + int send_res; + unsigned n; +}; + + +static void push_term(struct make_term_info* mti, ERL_NIF_TERM term) +{ + unsigned ix = (mti->reuse_push++) % MAKE_TERM_REUSE_LEN; + mti->reuse[ix] = term; + //enif_fprintf(stderr, "push at %u: %T\r\n", ix, term); +} +static ERL_NIF_TERM pull_term(struct make_term_info* mti) +{ + unsigned ix; + if (mti->reuse_pull >= mti->reuse_push && + mti->reuse_push < MAKE_TERM_REUSE_LEN) { + mti->reuse_pull = 0; + if (mti->reuse_push == 0) { + mti->reuse[0] = enif_make_list(mti->dst_env, 0); + } + } + ix = (mti->reuse_pull++) % MAKE_TERM_REUSE_LEN; + //enif_fprintf(stderr, "pull from %u: %T\r\n", ix, mti->reuse[ix]); + return mti->reuse[ix]; +} + +static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res); + +static ERL_NIF_TERM make_term_binary(struct make_term_info* mti, int n) +{ + ErlNifBinary bin; + enif_alloc_binary(100, &bin); + fill(bin.data, bin.size, n); + return enif_make_binary(mti->dst_env, &bin); +} + +static ERL_NIF_TERM make_term_int(struct make_term_info* mti, int n) +{ + int i; + fill(&i, sizeof(i), n); + return enif_make_int(mti->dst_env, i); +} + +static ERL_NIF_TERM make_term_ulong(struct make_term_info* mti, int n) +{ + unsigned long ul; + fill(&ul, sizeof(ul), n); + return enif_make_ulong(mti->dst_env, ul); +} + +static ERL_NIF_TERM make_term_double(struct make_term_info* mti, int n) +{ + double d = 3.141592; + return enif_make_double(mti->dst_env, d); +} +static ERL_NIF_TERM make_term_atom(struct make_term_info* mti, int n) +{ + return enif_make_atom(mti->dst_env, "make_term_n"); +} +static ERL_NIF_TERM make_term_existing_atom(struct make_term_info* mti, int n) +{ + ERL_NIF_TERM res; + int exist = enif_make_existing_atom(mti->dst_env, "nif_SUITE", &res, + ERL_NIF_LATIN1); + assert(exist); + return res; +} +static ERL_NIF_TERM make_term_string(struct make_term_info* mti, int n) +{ + return enif_make_string(mti->dst_env, "Hello!", ERL_NIF_LATIN1); +} +static ERL_NIF_TERM make_term_ref(struct make_term_info* mti, int n) +{ + return enif_make_ref(mti->dst_env); +} +static ERL_NIF_TERM make_term_sub_binary(struct make_term_info* mti, int n) +{ + ERL_NIF_TERM orig; + unsigned char* ptr = enif_make_new_binary(mti->dst_env, 10, &orig); + fill(ptr, 10, n); + return enif_make_sub_binary(mti->dst_env, orig, 3, 5); +} +static ERL_NIF_TERM make_term_uint(struct make_term_info* mti, int n) +{ + unsigned int ui; + fill(&ui, sizeof(ui), n); + return enif_make_uint(mti->dst_env, ui); +} +static ERL_NIF_TERM make_term_long(struct make_term_info* mti, int n) +{ + long l; + fill(&l, sizeof(l), n); + return enif_make_long(mti->dst_env, l); +} +static ERL_NIF_TERM make_term_tuple0(struct make_term_info* mti, int n) +{ + return enif_make_tuple(mti->dst_env, 0); +} +static ERL_NIF_TERM make_term_list0(struct make_term_info* mti, int n) +{ + return enif_make_list(mti->dst_env, 0); +} +static ERL_NIF_TERM make_term_resource(struct make_term_info* mti, int n) +{ + void* resource = enif_alloc_resource(mti->resource_type, 10); + fill(resource, 10, n); + return enif_make_resource(mti->dst_env, resource); +} +static ERL_NIF_TERM make_term_new_binary(struct make_term_info* mti, int n) +{ + ERL_NIF_TERM res; + unsigned char* ptr = enif_make_new_binary(mti->dst_env,20,&res); + fill(ptr, 20, n); + return res; +} +static ERL_NIF_TERM make_term_caller_pid(struct make_term_info* mti, int n) +{ + ErlNifPid pid; + return enif_make_pid(mti->dst_env, enif_self(mti->caller_env, &pid)); +} + +static ERL_NIF_TERM make_term_tuple(struct make_term_info* mti, int n) +{ + ERL_NIF_TERM t[3]; + t[0] = pull_term(mti); + t[1] = pull_term(mti); + t[2] = pull_term(mti); + return enif_make_tuple3(mti->dst_env, t[0], t[1], t[2]); +} +static ERL_NIF_TERM make_term_list(struct make_term_info* mti, int n) +{ + ERL_NIF_TERM t[3]; + t[0] = pull_term(mti); + t[1] = pull_term(mti); + t[2] = pull_term(mti); + return enif_make_list3(mti->dst_env, t[0], t[1], t[2]); +} +static ERL_NIF_TERM make_term_list_cell(struct make_term_info* mti, int n) +{ + ERL_NIF_TERM t[2]; + t[0] = pull_term(mti); + t[1] = pull_term(mti); + return enif_make_list_cell(mti->dst_env, t[0], t[1]); +} +static ERL_NIF_TERM make_term_tuple_from_array(struct make_term_info* mti, int n) +{ + ERL_NIF_TERM t[3]; + t[0] = pull_term(mti); + t[1] = pull_term(mti); + t[2] = pull_term(mti); + return enif_make_tuple_from_array(mti->dst_env, t, 3); +} +static ERL_NIF_TERM make_term_list_from_array(struct make_term_info* mti, int n) +{ + ERL_NIF_TERM t[3]; + t[0] = pull_term(mti); + t[1] = pull_term(mti); + t[2] = pull_term(mti); + return enif_make_list_from_array(mti->dst_env, t, 3); +} +static ERL_NIF_TERM make_term_garbage(struct make_term_info* mti, int n) +{ + (void) enif_make_string(mti->dst_env, "garbage string", ERL_NIF_LATIN1); + return pull_term(mti); +} +static ERL_NIF_TERM make_term_copy(struct make_term_info* mti, int n) +{ + return enif_make_copy(mti->dst_env, mti->other_term); +} + +typedef ERL_NIF_TERM Make_term_Func(struct make_term_info*, int); +static Make_term_Func* make_funcs[] = { + make_term_binary, + make_term_int, + make_term_ulong, + make_term_double, + make_term_atom, + make_term_existing_atom, + make_term_string, + //make_term_ref, + make_term_sub_binary, + make_term_uint, + make_term_long, + make_term_tuple0, + make_term_list0, + make_term_resource, + make_term_new_binary, + make_term_caller_pid, + make_term_tuple, + make_term_list, + make_term_list_cell, + make_term_tuple_from_array, + make_term_list_from_array, + make_term_garbage, + make_term_copy +}; +static unsigned num_of_make_funcs() +{ + return sizeof(make_funcs)/sizeof(*make_funcs); +} +static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res) +{ + if (n < num_of_make_funcs()) { + *res = make_funcs[n](mti, n); + push_term(mti, *res); + return 1; + } + return 0; +} + +static ERL_NIF_TERM make_blob(ErlNifEnv* caller_env, ErlNifEnv* dst_env, + ERL_NIF_TERM other_term) +{ + PrivData* priv = (PrivData*) enif_priv_data(caller_env); + ERL_NIF_TERM term, list; + int n = 0; + struct make_term_info mti; + mti.caller_env = caller_env; + mti.dst_env = dst_env; + mti.reuse_push = 0; + mti.reuse_pull = 0; + mti.resource_type = priv->rt_arr[0].t; + mti.other_term = other_term; + + list = enif_make_list(dst_env, 0); + while (make_term_n(&mti, n++, &term)) { + list = enif_make_list_cell(dst_env, term, list); + } + return list; +} + +static ERL_NIF_TERM send_new_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid to; + ERL_NIF_TERM msg, copy; + ErlNifEnv* msg_env; + int res; + + if (!enif_get_local_pid(env, argv[0], &to)) { + return enif_make_badarg(env); + } + msg_env = enif_alloc_env(); + msg = make_blob(env,msg_env, argv[1]); + copy = make_blob(env,env, argv[1]); + res = enif_send(env, &to, msg_env, msg); + enif_free_env(msg_env); + return enif_make_tuple3(env, atom_ok, enif_make_int(env,res), copy); +} + +static ERL_NIF_TERM alloc_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + PrivData* priv = (PrivData*) enif_priv_data(env); + struct make_term_info* mti; + ERL_NIF_TERM ret; + + mti = (struct make_term_info*) enif_alloc_resource(msgenv_resource_type, + sizeof(*mti)); + mti->caller_env = NULL; + mti->dst_env = enif_alloc_env(); + mti->reuse_push = 0; + mti->reuse_pull = 0; + mti->resource_type = priv->rt_arr[0].t; + mti->other_term = enif_make_list(mti->dst_env, 0); + mti->blob = enif_make_list(mti->dst_env, 0); + mti->mtx = enif_mutex_create("nif_SUITE:mtx"); + mti->cond = enif_cond_create("nif_SUITE:cond"); + mti->send_res = 0xcafebabe; + mti->n = 0; + ret = enif_make_resource(env, mti); + enif_release_resource(mti); + return ret; +} + +static void msgenv_dtor(ErlNifEnv* env, void* obj) +{ + struct make_term_info* mti = (struct make_term_info*) obj; + if (mti->dst_env != NULL) { + enif_free_env(mti->dst_env); + } + enif_mutex_destroy(mti->mtx); + enif_cond_destroy(mti->cond); +} + +static ERL_NIF_TERM clear_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + union { + void* vp; + struct make_term_info* p; + }mti; + if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)) { + return enif_make_badarg(env); + } + enif_clear_env(mti.p->dst_env); + mti.p->reuse_pull = 0; + mti.p->reuse_push = 0; + mti.p->blob = enif_make_list(mti.p->dst_env, 0); + return atom_ok; +} + +static ERL_NIF_TERM grow_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + union { void* vp; struct make_term_info* p; }mti; + ERL_NIF_TERM term; + if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp) + || (argc>2 && !enif_get_uint(env,argv[2], &mti.p->n))) { + return enif_make_badarg(env); + } + mti.p->caller_env = env; + mti.p->other_term = argv[1]; + mti.p->n %= num_of_make_funcs(); + make_term_n(mti.p, mti.p->n++, &term); + mti.p->blob = enif_make_list_cell(mti.p->dst_env, term, mti.p->blob); + return atom_ok; +} + +static ERL_NIF_TERM send_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + union { void* vp; struct make_term_info* p; }mti; + ErlNifPid to; + ERL_NIF_TERM copy; + int res; + if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp) + || !enif_get_local_pid(env, argv[1], &to)) { + return enif_make_badarg(env); + } + copy = enif_make_copy(env, mti.p->blob); + res = enif_send(env, &to, mti.p->dst_env, mti.p->blob); + return enif_make_tuple3(env, atom_ok, enif_make_int(env,res), copy); +} + +static ERL_NIF_TERM send3_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + union { void* vp; struct make_term_info* p; }mti; + ErlNifPid to; + ERL_NIF_TERM copy; + int res; + if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp) + || !enif_get_local_pid(env, argv[1], &to)) { + return enif_make_badarg(env); + } + mti.p->blob = enif_make_tuple2(mti.p->dst_env, + enif_make_copy(mti.p->dst_env, argv[2]), + mti.p->blob); + res = enif_send(env, &to, mti.p->dst_env, mti.p->blob); + return enif_make_int(env,res); +} + +void* threaded_sender(void *arg) +{ + + union { void* vp; struct make_term_info* p; }mti; + mti.vp = arg; + + enif_mutex_lock(mti.p->mtx); + while (!mti.p->send_it) { + enif_cond_wait(mti.p->cond, mti.p->mtx); + } + mti.p->send_it = 0; + enif_mutex_unlock(mti.p->mtx); + mti.p->send_res = enif_send(NULL, &mti.p->to_pid, mti.p->dst_env, mti.p->blob); + return NULL; +} + +static ERL_NIF_TERM send_blob_thread(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + union { void* vp; struct make_term_info* p; }mti; + ERL_NIF_TERM copy; + if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp) + || !enif_get_local_pid(env,argv[1], &mti.p->to_pid)) { + return enif_make_badarg(env); + } + copy = enif_make_copy(env, mti.p->blob); + + mti.p->send_it = enif_is_identical(argv[2],atom_join); + if (enif_thread_create("nif_SUITE:send_from_thread", &mti.p->tid, + threaded_sender, mti.p, NULL) != 0) { + return enif_make_badarg(env); + } + if (enif_is_identical(argv[2],atom_join)) { + int err = enif_thread_join(mti.p->tid, NULL); + assert(err == 0); + return enif_make_tuple3(env, atom_ok, enif_make_int(env, mti.p->send_res), copy); + } + else { + enif_keep_resource(mti.vp); + return enif_make_tuple2(env, atom_ok, copy); + } +} + +static ERL_NIF_TERM join_send_thread(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + union { void* vp; struct make_term_info* p; }mti; + int err; + if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)) { + return enif_make_badarg(env); + } + enif_mutex_lock(mti.p->mtx); + mti.p->send_it = 1; + enif_cond_signal(mti.p->cond); + enif_mutex_unlock(mti.p->mtx); + err = enif_thread_join(mti.p->tid, NULL); + assert(err == 0); + enif_release_resource(mti.vp); + return enif_make_tuple2(env, atom_ok, enif_make_int(env, mti.p->send_res)); +} + +static ERL_NIF_TERM copy_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + union { void* vp; struct make_term_info* p; }mti; + if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)) { + return enif_make_badarg(env); + } + return enif_make_copy(env, mti.p->blob); +} + +static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifEnv* menv; + ErlNifPid pid; + int ret; + if (!enif_get_local_pid(env, argv[0], &pid)) { + return enif_make_badarg(env); + } + menv = enif_alloc_env(); + ret = enif_send(env, &pid, menv, enif_make_copy(menv, argv[1])); + enif_free_env(menv); + return enif_make_int(env, ret); +} static ErlNifFunc nif_funcs[] = { @@ -640,8 +1323,25 @@ static ErlNifFunc nif_funcs[] = {"get_resource", 2, get_resource}, {"release_resource", 1, release_resource}, {"last_resource_dtor_call", 0, last_resource_dtor_call}, - {"make_new_resource", 2, make_new_resource} - + {"make_new_resource", 2, make_new_resource}, + {"check_is", 10, check_is}, + {"length_test", 5, length_test}, + {"make_atoms", 0, make_atoms}, + {"make_strings", 0, make_strings}, + {"make_new_resource", 2, make_new_resource}, + {"make_new_resource_binary", 1, make_new_resource_binary}, + {"send_list_seq", 2, send_list_seq}, + {"send_new_blob", 2, send_new_blob}, + {"alloc_msgenv", 0, alloc_msgenv}, + {"clear_msgenv", 1, clear_msgenv}, + {"grow_blob", 2, grow_blob}, + {"grow_blob", 3, grow_blob}, + {"send_blob", 2, send_blob}, + {"send3_blob", 3, send3_blob}, + {"send_blob_thread", 3, send_blob_thread}, + {"join_send_thread", 1, join_send_thread}, + {"copy_blob", 1, copy_blob}, + {"send_term", 2, send_term} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c index c075b74c57..e32d10057c 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.c +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c @@ -1,3 +1,21 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2010. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ #include "erl_nif.h" #include <string.h> #include <stdio.h> @@ -24,6 +42,11 @@ static ERL_NIF_TERM am_resource_type; static ERL_NIF_TERM am_resource_dtor_A; static ERL_NIF_TERM am_resource_dtor_B; +static NifModPrivData* priv_data(ErlNifEnv* env) +{ + return (NifModPrivData*) enif_priv_data(env); +} + static void init(ErlNifEnv* env) { am_true = enif_make_atom(env, "true"); @@ -36,7 +59,7 @@ static void init(ErlNifEnv* env) static void add_call_with_arg(ErlNifEnv* env, NifModPrivData* data, const char* func_name, const char* arg, int arg_sz) { - CallInfo* call = enif_alloc(env, sizeof(CallInfo)+strlen(func_name) + arg_sz); + CallInfo* call = (CallInfo*)enif_alloc(sizeof(CallInfo)+strlen(func_name) + arg_sz); strcpy(call->func_name, func_name); call->lib_ver = NIF_LIB_VER; call->static_cntA = ++static_cntA; @@ -60,7 +83,7 @@ static void add_call(ErlNifEnv* env, NifModPrivData* data,const char* func_name) add_call_with_arg(env, data, func_name, NULL, 0); } -#define ADD_CALL(FUNC_NAME) add_call(env, enif_priv_data(env),FUNC_NAME) +#define ADD_CALL(FUNC_NAME) add_call(env, priv_data(env),FUNC_NAME) #define STRINGIFY_(X) #X #define STRINGIFY(X) STRINGIFY_(X) @@ -69,56 +92,56 @@ static void resource_dtor_A(ErlNifEnv* env, void* a) { const char dtor_name[] = "resource_dtor_A_v" STRINGIFY(NIF_LIB_VER); - add_call_with_arg(env, enif_priv_data(env), dtor_name, - a, enif_sizeof_resource(env, a)); + add_call_with_arg(env, priv_data(env), dtor_name, (const char*)a, + enif_sizeof_resource(a)); } static void resource_dtor_B(ErlNifEnv* env, void* a) { - const char dtor_name[] = "resource_dtor_B_v" STRINGIFY(NIF_LIB_VER); + const char dtor_name[] = "resource_dtor_B_v" STRINGIFY(NIF_LIB_VER); - add_call_with_arg(env, enif_priv_data(env), dtor_name, - a, enif_sizeof_resource(env, a)); + add_call_with_arg(env, priv_data(env), dtor_name, (const char*)a, + enif_sizeof_resource(a)); } /* {resource_type, Ix|null, ErlNifResourceFlags in, "TypeName", dtor(A|B|null), ErlNifResourceFlags out}*/ static void open_resource_type(ErlNifEnv* env, ERL_NIF_TERM op_tpl) { - NifModPrivData* data = enif_priv_data(env); + NifModPrivData* data = priv_data(env); const ERL_NIF_TERM* arr; int arity; char rt_name[30]; - union { enum ErlNifResourceFlags e; int i; } flags, exp_res, got_res; + union { ErlNifResourceFlags e; int i; } flags, exp_res, got_res; unsigned ix; ErlNifResourceDtor* dtor; ErlNifResourceType* got_ptr; CHECK(enif_get_tuple(env, op_tpl, &arity, &arr)); CHECK(arity == 6); - CHECK(enif_is_identical(env, arr[0], am_resource_type)); + CHECK(enif_is_identical(arr[0], am_resource_type)); CHECK(enif_get_int(env, arr[2], &flags.i)); CHECK(enif_get_string(env, arr[3], rt_name, sizeof(rt_name), ERL_NIF_LATIN1) > 0); CHECK(enif_get_int(env, arr[5], &exp_res.i)); - if (enif_is_identical(env, arr[4], am_null)) { + if (enif_is_identical(arr[4], am_null)) { dtor = NULL; } - else if (enif_is_identical(env, arr[4], am_resource_dtor_A)) { + else if (enif_is_identical(arr[4], am_resource_dtor_A)) { dtor = resource_dtor_A; } else { - CHECK(enif_is_identical(env, arr[4], am_resource_dtor_B)); + CHECK(enif_is_identical(arr[4], am_resource_dtor_B)); dtor = resource_dtor_B; } - got_ptr = enif_open_resource_type(env, rt_name, dtor, + got_ptr = enif_open_resource_type(env, NULL, rt_name, dtor, flags.e, &got_res.e); if (enif_get_uint(env, arr[1], &ix) && ix < RT_MAX && got_ptr != NULL) { data->rt_arr[ix] = got_ptr; } else { - CHECK(enif_is_identical(env, arr[1], am_null)); + CHECK(enif_is_identical(arr[1], am_null)); CHECK(got_ptr == NULL); } CHECK(got_res.e == exp_res.e); @@ -126,7 +149,7 @@ static void open_resource_type(ErlNifEnv* env, ERL_NIF_TERM op_tpl) static void do_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info) { - NifModPrivData* data = enif_priv_data(env); + NifModPrivData* data = priv_data(env); ERL_NIF_TERM head, tail; unsigned ix; for (ix=0; ix<RT_MAX; ix++) { @@ -140,17 +163,18 @@ static void do_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info) CHECK(enif_is_empty_list(env, head)); } -static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +static int load(ErlNifEnv* env, void** priv, ERL_NIF_TERM load_info) { NifModPrivData* data; init(env); - data = enif_alloc(env, sizeof(NifModPrivData)); + data = (NifModPrivData*) enif_alloc(sizeof(NifModPrivData)); CHECK(data != NULL); - *priv_data = data; + *priv = data; data->mtx = enif_mutex_create("nif_mod_priv_data"); data->ref_cnt = 1; data->call_history = NULL; + add_call(env, data, "load"); do_load_info(env, load_info); @@ -158,39 +182,35 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) return 0; } -static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +static int reload(ErlNifEnv* env, void** priv, ERL_NIF_TERM load_info) { + NifModPrivData* data = (NifModPrivData*) *priv; init(env); - add_call(env, *priv_data, "reload"); + add_call(env, data, "reload"); do_load_info(env, load_info); return 0; } -static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info) +static int upgrade(ErlNifEnv* env, void** priv, void** old_priv_data, ERL_NIF_TERM load_info) { - NifModPrivData* data = *old_priv_data; + NifModPrivData* data = (NifModPrivData*) *old_priv_data; init(env); add_call(env, data, "upgrade"); data->ref_cnt++; - *priv_data = *old_priv_data; + *priv = *old_priv_data; do_load_info(env, load_info); return 0; } -static void unload(ErlNifEnv* env, void* priv_data) +static void unload(ErlNifEnv* env, void* priv) { - NifModPrivData* data = priv_data; + NifModPrivData* data = (NifModPrivData*) priv; + int is_last; add_call(env, data, "unload"); - enif_mutex_lock(data->mtx); - if (--data->ref_cnt == 0) { - enif_mutex_unlock(data->mtx); - enif_mutex_destroy(data->mtx); - enif_free(env, data); - } - enif_mutex_unlock(data->mtx); + NifModPrivData_release(data); } static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -202,12 +222,12 @@ static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg static ERL_NIF_TERM get_priv_data_ptr(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ADD_CALL("get_priv_data_ptr"); - return enif_make_ulong(env, (unsigned long)enif_priv_data(env)); + return enif_make_ulong(env, (unsigned long)priv_data(env)); } static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - NifModPrivData* data = (NifModPrivData*) enif_priv_data(env); + NifModPrivData* data = priv_data(env); ErlNifBinary ibin; char* a; ERL_NIF_TERM ret; @@ -216,22 +236,22 @@ static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TE || !enif_inspect_binary(env, argv[1], &ibin)) { return enif_make_badarg(env); } - a = enif_alloc_resource(env, data->rt_arr[ix], ibin.size); + a = (char*) enif_alloc_resource(data->rt_arr[ix], ibin.size); memcpy(a, ibin.data, ibin.size); ret = enif_make_resource(env, a); - enif_release_resource(env, a); + enif_release_resource(a); return ret; } static ERL_NIF_TERM get_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - NifModPrivData* data = (NifModPrivData*) enif_priv_data(env); + NifModPrivData* data = priv_data(env); ErlNifBinary obin; unsigned ix; void* a; if (!enif_get_uint(env, argv[0], &ix) || ix >= RT_MAX || !enif_get_resource(env, argv[1], data->rt_arr[ix], &a) - || !enif_alloc_binary(env, enif_sizeof_resource(env, a), &obin)) { + || !enif_alloc_binary(enif_sizeof_resource(a), &obin)) { return enif_make_badarg(env); } memcpy(obin.data, a, obin.size); diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.h b/erts/emulator/test/nif_SUITE_data/nif_mod.h index 0eaf91d6e1..cd0ecf4b54 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.h +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.h @@ -20,3 +20,15 @@ typedef struct ErlNifResourceType* rt_arr[RT_MAX]; }NifModPrivData; +#define NifModPrivData_release(NMPD) \ + do { \ + int is_last; \ + enif_mutex_lock((NMPD)->mtx); \ + is_last = (--(NMPD)->ref_cnt == 0); \ + enif_mutex_unlock((NMPD)->mtx); \ + if (is_last) { \ + enif_mutex_destroy((NMPD)->mtx); \ + enif_free((NMPD)); \ + } \ + }while (0) + diff --git a/erts/emulator/test/obsolete_SUITE.erl b/erts/emulator/test/obsolete_SUITE.erl deleted file mode 100644 index 33c4726699..0000000000 --- a/erts/emulator/test/obsolete_SUITE.erl +++ /dev/null @@ -1,123 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. 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(obsolete_SUITE). --author('[email protected]'). --compile(nowarn_obsolete_guard). - --export([all/1]). - --export([erl_threads/1]). - --include("test_server.hrl"). - --define(DEFAULT_TIMETRAP_SECS, 240). - -all(doc) -> []; -all(suite) -> - case catch erlang:system_info(wordsize) of - 4 -> [erl_threads]; - _ -> {skip, "Only expected to work on 32-bit architectures"} - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Testcases %% -%% %% - -erl_threads(suite) -> []; -erl_threads(doc) -> []; -erl_threads(Cfg) -> - ?line case erlang:system_info(threads) of - true -> - ?line drv_case(Cfg, erl_threads); - false -> - ?line {skip, "Emulator not compiled with threads support"} - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Internal functions %% -%% %% - -drv_case(Config, CaseName) -> - drv_case(Config, CaseName, ""). - -drv_case(Config, CaseName, TimeTrap) when integer(TimeTrap) -> - drv_case(Config, CaseName, "", TimeTrap); -drv_case(Config, CaseName, Command) when list(Command) -> - drv_case(Config, CaseName, Command, ?DEFAULT_TIMETRAP_SECS). - -drv_case(Config, CaseName, TimeTrap, Command) when list(Command), - integer(TimeTrap) -> - drv_case(Config, CaseName, Command, TimeTrap); -drv_case(Config, CaseName, Command, TimeTrap) when list(Config), - atom(CaseName), - list(Command), - integer(TimeTrap) -> - case ?t:os_type() of - {Family, _} when Family == unix; Family == win32 -> - ?line run_drv_case(Config, CaseName, Command, TimeTrap); - SkipOs -> - ?line {skipped, - lists:flatten(["Not run on " - | io_lib:format("~p",[SkipOs])])} - end. - -run_drv_case(Config, CaseName, Command, TimeTrap) -> - ?line Dog = test_server:timetrap(test_server:seconds(TimeTrap)), - ?line DataDir = ?config(data_dir,Config), - case erl_ddll:load_driver(DataDir, CaseName) of - ok -> ok; - {error, Error} -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - ?line ?t:fail() - end, - ?line Port = open_port({spawn, atom_to_list(CaseName)}, []), - ?line true = is_port(Port), - ?line Port ! {self(), {command, Command}}, - ?line Result = receive_drv_result(Port, CaseName), - ?line Port ! {self(), close}, - ?line receive - {Port, closed} -> - ok - end, - ?line ok = erl_ddll:unload_driver(CaseName), - ?line test_server:timetrap_cancel(Dog), - ?line Result. - -receive_drv_result(Port, CaseName) -> - ?line receive - {print, Port, CaseName, Str} -> - ?line ?t:format("~s", [Str]), - ?line receive_drv_result(Port, CaseName); - {'EXIT', Port, Error} -> - ?line ?t:fail(Error); - {'EXIT', error, Error} -> - ?line ?t:fail(Error); - {failed, Port, CaseName, Comment} -> - ?line ?t:fail(Comment); - {skipped, Port, CaseName, Comment} -> - ?line {skipped, Comment}; - {succeeded, Port, CaseName, ""} -> - ?line succeeded; - {succeeded, Port, CaseName, Comment} -> - ?line {comment, Comment} - end. diff --git a/erts/emulator/test/obsolete_SUITE_data/Makefile.src b/erts/emulator/test/obsolete_SUITE_data/Makefile.src deleted file mode 100644 index d8e2b861c0..0000000000 --- a/erts/emulator/test/obsolete_SUITE_data/Makefile.src +++ /dev/null @@ -1,33 +0,0 @@ -# ``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 via the world wide web 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. -# -# The Initial Developer of the Original Code is Ericsson Utvecklings AB. -# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -# AB. All Rights Reserved.'' -# -# $Id$ -# - -TEST_DRVS = erl_threads@dll@ -CC = @CC@ -LD = @LD@ -CFLAGS = @SHLIB_CFLAGS@ -I@erl_include@ @DEFS@ -SHLIB_EXTRA_LDLIBS = testcase_driver@obj@ - -all: $(TEST_DRVS) - -@SHLIB_RULES@ - -testcase_driver@obj@: testcase_driver.c testcase_driver.h -$(TEST_DRVS): testcase_driver@obj@ - - - diff --git a/erts/emulator/test/obsolete_SUITE_data/erl_threads.c b/erts/emulator/test/obsolete_SUITE_data/erl_threads.c deleted file mode 100644 index 27a5163121..0000000000 --- a/erts/emulator/test/obsolete_SUITE_data/erl_threads.c +++ /dev/null @@ -1,302 +0,0 @@ -/* ``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 via the world wide web 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. - * - * The Initial Developer of the Original Code is Ericsson Utvecklings AB. - * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings - * AB. All Rights Reserved.'' - * - * $Id$ - */ - -#include "testcase_driver.h" - -#ifndef __WIN32__ - -#define NO_OF_THREADS 2 - -#include <unistd.h> -#include <errno.h> - -static int die; -static int cw_passed; -static int res_tf0; -static int res_tf1; -static erl_mutex_t mtx; -static erl_cond_t cnd; -static erl_thread_t tid[NO_OF_THREADS]; -static int need_join[NO_OF_THREADS]; - -typedef struct { - int n; -} thr_arg_t; - - -static void *tf0(void *vta) -{ - int r; - - if (((thr_arg_t *) vta)->n != 0) - goto fail; - - r = erts_mutex_lock(mtx); - if (r != 0) { - erts_mutex_unlock(mtx); - goto fail; - } - - r = erts_cond_wait(cnd, mtx); - if (r != 0 || die) { - erts_mutex_unlock(mtx); - goto fail; - } - - cw_passed++; - - r = erts_cond_wait(cnd, mtx); - if (r != 0 || die) { - erts_mutex_unlock(mtx); - goto fail; - } - - cw_passed++; - - r = erts_mutex_unlock(mtx); - if (r != 0) - goto fail; - - res_tf0 = 0; - - return (void *) &res_tf0; - - fail: - return NULL; -} - - -static void *tf1(void *vta) -{ - int r; - - if (((thr_arg_t *) vta)->n != 1) - goto fail; - - r = erts_mutex_lock(mtx); - if (r != 0) { - erts_mutex_unlock(mtx); - goto fail; - } - - r = erts_cond_wait(cnd, mtx); - if (r != 0 || die) { - erts_mutex_unlock(mtx); - goto fail; - } - - cw_passed++; - - r = erts_cond_wait(cnd, mtx); - if (r != 0 || die) { - erts_mutex_unlock(mtx); - goto fail; - } - - cw_passed++; - - r = erts_mutex_unlock(mtx); - if (r != 0) - goto fail; - - res_tf1 = 1; - - erts_thread_exit((void *) &res_tf1); - - res_tf1 = 4711; - - fail: - return NULL; -} - -#endif /* #ifndef __WIN32__ */ - -void -testcase_run(TestCaseState_t *tcs) -{ -#ifdef __WIN32__ - testcase_skipped(tcs, "Nothing to test; not supported on windows."); -#else - int i, r; - void *tres[NO_OF_THREADS]; - thr_arg_t ta[NO_OF_THREADS]; - erl_thread_t t1; - - die = 0; - cw_passed = 0; - - for (i = 0; i < NO_OF_THREADS; i++) - need_join[i] = 0; - - res_tf0 = 17; - res_tf1 = 17; - - cnd = mtx = NULL; - - /* Create mutex and cond */ - mtx = erts_mutex_create(); - ASSERT(tcs, mtx); - cnd = erts_cond_create(); - ASSERT(tcs, cnd); - - /* Create the threads */ - ta[0].n = 0; - r = erts_thread_create(&tid[0], tf0, (void *) &ta[0], 0); - ASSERT(tcs, r == 0); - need_join[0] = 1; - - ta[1].n = 1; - r = erts_thread_create(&tid[1], tf1, (void *) &ta[1], 0); - ASSERT(tcs, r == 0); - need_join[1] = 1; - - /* Make sure the threads waits on cond wait */ - sleep(1); - - r = erts_mutex_lock(mtx); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - - ASSERT_CLNUP(tcs, cw_passed == 0, (void) erts_mutex_unlock(mtx)); - - - /* Let one thread pass one cond wait */ - r = erts_cond_signal(cnd); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - - r = erts_mutex_unlock(mtx); - ASSERT(tcs, r == 0); - - sleep(1); - - r = erts_mutex_lock(mtx); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - - ASSERT_CLNUP(tcs, cw_passed == 1, (void) erts_mutex_unlock(mtx)); - - - /* Let both threads pass one cond wait */ - r = erts_cond_broadcast(cnd); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - - r = erts_mutex_unlock(mtx); - ASSERT(tcs, r == 0); - - sleep(1); - - r = erts_mutex_lock(mtx); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - - ASSERT_CLNUP(tcs, cw_passed == 3, (void) erts_mutex_unlock(mtx)); - - - /* Let the thread that only have passed one cond wait pass the other one */ - r = erts_cond_signal(cnd); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - - r = erts_mutex_unlock(mtx); - ASSERT(tcs, r == 0); - - sleep(1); - - r = erts_mutex_lock(mtx); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - - ASSERT_CLNUP(tcs, cw_passed == 4, (void) erts_mutex_unlock(mtx)); - - /* Both threads should have passed both cond waits and exited; - join them and check returned values */ - - r = erts_thread_join(tid[0], &tres[0]); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - need_join[0] = 0; - - ASSERT_CLNUP(tcs, tres[0] == &res_tf0, (void) erts_mutex_unlock(mtx)); - ASSERT_CLNUP(tcs, res_tf0 == 0, (void) erts_mutex_unlock(mtx)); - - r = erts_thread_join(tid[1], &tres[1]); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - need_join[1] = 0; - - ASSERT_CLNUP(tcs, tres[1] == &res_tf1, (void) erts_mutex_unlock(mtx)); - ASSERT_CLNUP(tcs, res_tf1 == 1, (void) erts_mutex_unlock(mtx)); - - /* Test signaling when noone waits */ - - r = erts_cond_signal(cnd); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - - /* Test broadcasting when noone waits */ - - r = erts_cond_broadcast(cnd); - ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); - - /* erts_cond_timedwait() not supported anymore */ - r = erts_cond_timedwait(cnd, mtx, 1000); - ASSERT_CLNUP(tcs, r != 0, (void) erts_mutex_unlock(mtx)); - ASSERT_CLNUP(tcs, - strcmp(erl_errno_id(r), "enotsup") == 0, - (void) erts_mutex_unlock(mtx)); - - r = erts_mutex_unlock(mtx); - ASSERT(tcs, r == 0); - - r = erts_mutex_destroy(mtx); - ASSERT(tcs, r == 0); - mtx = NULL; - - r = erts_cond_destroy(cnd); - ASSERT(tcs, r == 0); - cnd = NULL; - - /* ... */ - t1 = erts_thread_self(); - - if (cw_passed == 4711) { - /* We don't want to execute this just check that the - symbol/symbols is/are defined */ - erts_thread_kill(t1); - } - -#endif /* #ifndef __WIN32__ */ -} - -char * -testcase_name(void) -{ - return "erl_threads"; -} - -void -testcase_cleanup(TestCaseState_t *tcs) -{ - int i; - for (i = 0; i < NO_OF_THREADS; i++) { - if (need_join[i]) { - erts_mutex_lock(mtx); - die = 1; - erts_cond_broadcast(cnd); - erts_mutex_unlock(mtx); - erts_thread_join(tid[1], NULL); - } - } - if (mtx) - erts_mutex_destroy(mtx); - if (cnd) - erts_cond_destroy(cnd); -} - diff --git a/erts/emulator/test/obsolete_SUITE_data/testcase_driver.c b/erts/emulator/test/obsolete_SUITE_data/testcase_driver.c deleted file mode 100644 index 99d5adb041..0000000000 --- a/erts/emulator/test/obsolete_SUITE_data/testcase_driver.c +++ /dev/null @@ -1,262 +0,0 @@ -/* ``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 via the world wide web 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. - * - * The Initial Developer of the Original Code is Ericsson Utvecklings AB. - * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings - * AB. All Rights Reserved.'' - * - * $Id$ - */ - -#include "testcase_driver.h" -#include <stdio.h> -#include <stdlib.h> -#include <stdarg.h> -#include <setjmp.h> -#include <string.h> - -#ifdef __WIN32__ -#undef HAVE_VSNPRINTF -#define HAVE_VSNPRINTF 1 -#define vsnprintf _vsnprintf -#endif - -#ifndef HAVE_VSNPRINTF -#define HAVE_VSNPRINTF 0 -#endif - -#define COMMENT_BUF_SZ 4096 - -#define TESTCASE_FAILED 0 -#define TESTCASE_SKIPPED 1 -#define TESTCASE_SUCCEEDED 2 - -typedef struct { - TestCaseState_t visible; - int port; - int result; - jmp_buf done_jmp_buf; - char *comment; - char comment_buf[COMMENT_BUF_SZ]; -} InternalTestCaseState_t; - -long testcase_drv_start(int port, char *command); -int testcase_drv_stop(long drv_data); -int testcase_drv_run(long drv_data, char *buf, int len); - -static DriverEntry testcase_drv_entry = { - NULL, - testcase_drv_start, - testcase_drv_stop, - testcase_drv_run -}; - - -int DRIVER_INIT(testcase_drv)(void *arg) -{ - testcase_drv_entry.driver_name = testcase_name(); - return (int) &testcase_drv_entry; -} - -long -testcase_drv_start(int port, char *command) -{ - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) - driver_alloc(sizeof(InternalTestCaseState_t)); - if (!itcs) { - return -1; - } - - itcs->visible.testcase_name = testcase_name(); - itcs->visible.extra = NULL; - itcs->port = port; - itcs->result = TESTCASE_FAILED; - itcs->comment = ""; - - return (long) itcs; -} - -int -testcase_drv_stop(long drv_data) -{ - testcase_cleanup((TestCaseState_t *) drv_data); - driver_free((void *) drv_data); - return 0; -} - -int -testcase_drv_run(long drv_data, char *buf, int len) -{ - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) drv_data; - DriverTermData result_atom; - DriverTermData msg[12]; - - itcs->visible.command = buf; - itcs->visible.command_len = len; - - if (setjmp(itcs->done_jmp_buf) == 0) { - testcase_run((TestCaseState_t *) itcs); - itcs->result = TESTCASE_SUCCEEDED; - } - - switch (itcs->result) { - case TESTCASE_SUCCEEDED: - result_atom = driver_mk_atom("succeeded"); - break; - case TESTCASE_SKIPPED: - result_atom = driver_mk_atom("skipped"); - break; - case TESTCASE_FAILED: - default: - result_atom = driver_mk_atom("failed"); - break; - } - - msg[0] = ERL_DRV_ATOM; - msg[1] = (DriverTermData) result_atom; - - msg[2] = ERL_DRV_PORT; - msg[3] = driver_mk_port(itcs->port); - - msg[4] = ERL_DRV_ATOM; - msg[5] = driver_mk_atom(itcs->visible.testcase_name); - - msg[6] = ERL_DRV_STRING; - msg[7] = (DriverTermData) itcs->comment; - msg[8] = (DriverTermData) strlen(itcs->comment); - - msg[9] = ERL_DRV_TUPLE; - msg[10] = (DriverTermData) 4; - - driver_output_term(itcs->port, msg, 11); - return 0; -} - -int -testcase_assertion_failed(TestCaseState_t *tcs, - char *file, int line, char *assertion) -{ - testcase_failed(tcs, "%s:%d: Assertion failed: \"%s\"", - file, line, assertion); - return 0; -} - -void -testcase_printf(TestCaseState_t *tcs, char *frmt, ...) -{ - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; - DriverTermData msg[12]; - va_list va; - va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif - va_end(va); - - msg[0] = ERL_DRV_ATOM; - msg[1] = (DriverTermData) driver_mk_atom("print"); - - msg[2] = ERL_DRV_PORT; - msg[3] = driver_mk_port(itcs->port); - - msg[4] = ERL_DRV_ATOM; - msg[5] = driver_mk_atom(itcs->visible.testcase_name); - - msg[6] = ERL_DRV_STRING; - msg[7] = (DriverTermData) itcs->comment_buf; - msg[8] = (DriverTermData) strlen(itcs->comment_buf); - - msg[9] = ERL_DRV_TUPLE; - msg[10] = (DriverTermData) 4; - - driver_output_term(itcs->port, msg, 11); -} - - -void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...) -{ - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; - va_list va; - va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif - va_end(va); - - itcs->result = TESTCASE_SUCCEEDED; - itcs->comment = itcs->comment_buf; - - longjmp(itcs->done_jmp_buf, 1); -} - -void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...) -{ - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; - va_list va; - va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif - va_end(va); - - itcs->result = TESTCASE_SKIPPED; - itcs->comment = itcs->comment_buf; - - longjmp(itcs->done_jmp_buf, 1); -} - -void testcase_failed(TestCaseState_t *tcs, char *frmt, ...) -{ - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; - char buf[10]; - size_t bufsz = sizeof(buf); - va_list va; - va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif - va_end(va); - - itcs->result = TESTCASE_FAILED; - itcs->comment = itcs->comment_buf; - - if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 - && strcmp("true", buf) == 0) { - fprintf(stderr, "Testcase \"%s\" failed: %s\n", - itcs->visible.testcase_name, itcs->comment); - abort(); - } - - longjmp(itcs->done_jmp_buf, 1); -} - -void *testcase_alloc(size_t size) -{ - return driver_alloc(size); -} - -void *testcase_realloc(void *ptr, size_t size) -{ - return driver_realloc(ptr, size); -} - -void testcase_free(void *ptr) -{ - driver_free(ptr); -} diff --git a/erts/emulator/test/obsolete_SUITE_data/testcase_driver.h b/erts/emulator/test/obsolete_SUITE_data/testcase_driver.h deleted file mode 100644 index 3d85ca6df0..0000000000 --- a/erts/emulator/test/obsolete_SUITE_data/testcase_driver.h +++ /dev/null @@ -1,57 +0,0 @@ -/* ``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 via the world wide web 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. - * - * The Initial Developer of the Original Code is Ericsson Utvecklings AB. - * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings - * AB. All Rights Reserved.'' - * - * $Id$ - */ - -#ifndef TESTCASE_DRIVER_H__ -#define TESTCASE_DRIVER_H__ - -#include "obsolete/driver.h" -#include <stdlib.h> - -typedef struct { - char *testcase_name; - char *command; - int command_len; - void *extra; -} TestCaseState_t; - -#define ASSERT_CLNUP(TCS, B, CLN) \ -do { \ - if (!(B)) { \ - CLN; \ - testcase_assertion_failed((TCS), __FILE__, __LINE__, #B); \ - } \ -} while (0) - -#define ASSERT(TCS, B) ASSERT_CLNUP(TCS, B, (void) 0) - -void testcase_printf(TestCaseState_t *tcs, char *frmt, ...); -void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...); -void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...); -void testcase_failed(TestCaseState_t *tcs, char *frmt, ...); -int testcase_assertion_failed(TestCaseState_t *tcs, char *file, int line, - char *assertion); -void *testcase_alloc(size_t size); -void *testcase_realloc(void *ptr, size_t size); -void testcase_free(void *ptr); - - -char *testcase_name(void); -void testcase_run(TestCaseState_t *tcs); -void testcase_cleanup(TestCaseState_t *tcs); - -#endif diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index b9100738e4..77fa75b78f 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -88,7 +88,7 @@ otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1, mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1, exit_status_multi_scheduling_block/1, ports/1, - spawn_driver/1,spawn_executable/1, + spawn_driver/1, spawn_executable/1, close_deaf_port/1, unregister_name/1]). -export([]). @@ -113,7 +113,7 @@ all(suite) -> otp_3906, otp_4389, win_massive, mix_up_ports, otp_5112, otp_5119, exit_status_multi_scheduling_block, - ports, spawn_driver, spawn_executable, + ports, spawn_driver, spawn_executable, close_deaf_port, unregister_name ]. @@ -878,12 +878,20 @@ env2(Config) -> "nisse" = os:getenv(Long) end), - + ?line env_slave(Temp, [{"must_define_something","some_value"}, - {"certainly_not_existing",false}, + {"certainly_not_existing",false}, + {"ends_with_equal", "value="}, {Long,false}, {"glurf","a glorfy string"}]), + %% A lot of non existing variables (mingled with existing) + NotExistingList = [{lists:flatten(io_lib:format("V~p_not_existing",[X])),false} + || X <- lists:seq(1,150)], + ExistingList = [{lists:flatten(io_lib:format("V~p_existing",[X])),"a_value"} + || X <- lists:seq(1,150)], + ?line env_slave(Temp, lists:sort(ExistingList ++ NotExistingList)), + ?line test_server:timetrap_cancel(Dog), ok. @@ -2292,3 +2300,12 @@ load_driver(Dir, Driver) -> io:format("~s\n", [erl_ddll:format_error(Error)]), Res end. + + +close_deaf_port(doc) -> ["Send data to port program that does not read it, then close port."]; +close_deaf_port(suite) -> []; +close_deaf_port(Config) when is_list(Config) -> + Port = open_port({spawn,"sleep 999999"},[]), + erlang:port_command(Port,"Hello, can you hear me!?!?"), + port_close(Port), + ok. diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl new file mode 100644 index 0000000000..40ebf2bd21 --- /dev/null +++ b/erts/emulator/test/receive_SUITE.erl @@ -0,0 +1,113 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. 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(receive_SUITE). + +%% Tests receive after. + +-include("test_server.hrl"). + +-export([all/1, + call_with_huge_message_queue/1,receive_in_between/1]). + +-export([init_per_testcase/2,fin_per_testcase/2]). + +all(suite) -> + [call_with_huge_message_queue,receive_in_between]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(3)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +call_with_huge_message_queue(Config) when is_list(Config) -> + ?line Pid = spawn_link(fun echo_loop/0), + + ?line {Time,ok} = tc(fun() -> calls(10, Pid) end), + + ?line [self() ! {msg,N} || N <- lists:seq(1, 500000)], + erlang:garbage_collect(), + ?line {NewTime,ok} = tc(fun() -> calls(10, Pid) end), + io:format("Time for empty message queue: ~p", [Time]), + io:format("Time for huge message queue: ~p", [NewTime]), + + case (NewTime+1) / (Time+1) of + Q when Q < 10 -> + ok; + Q -> + io:format("Q = ~p", [Q]), + ?line ?t:fail() + end, + ok. + +calls(0, _) -> ok; +calls(N, Pid) -> + {ok,{ultimate_answer,42}} = call(Pid, {ultimate_answer,42}), + calls(N-1, Pid). + +call(Pid, Msg) -> + Mref = erlang:monitor(process, Pid), + Pid ! {Mref,{self(),Msg}}, + receive + {Mref, Reply} -> + erlang:demonitor(Mref, [flush]), + {ok, Reply}; + {'DOWN', Mref, _, _, Reason} -> + exit(Reason) + end. + +receive_in_between(Config) when is_list(Config) -> + ?line Pid = spawn_link(fun echo_loop/0), + ?line [{ok,{a,b}} = call2(Pid, {a,b}) || _ <- lists:seq(1, 100000)], + ok. + +call2(Pid, Msg) -> + self() ! dummy, + Mref = erlang:monitor(process, Pid), + Pid ! {Mref,{self(),Msg}}, + receive_one(), + receive + {Mref,Reply} -> + erlang:demonitor(Mref, [flush]), + {ok,Reply}; + {'DOWN',Mref,_,_,Reason} -> + exit(Reason) + end. + +receive_one() -> + receive + dummy -> ok + end. + +%%% +%%% Common helpers. +%%% + +echo_loop() -> + receive + {Ref,{Pid,Msg}} -> + Pid ! {Ref,Msg}, + echo_loop() + end. + +tc(Fun) -> + timer:tc(erlang, apply, [Fun,[]]). diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index c9101b77c2..4f4458802c 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -33,7 +33,7 @@ -include("test_server.hrl"). %-compile(export_all). --export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/1, init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]). -export([equal/1, few_low/1, @@ -49,7 +49,8 @@ cpu_topology/1, sct_cmd/1, sbt_cmd/1, - scheduler_suspend/1]). + scheduler_suspend/1, + reader_groups/1]). -define(DEFAULT_TIMEOUT, ?t:minutes(10)). @@ -67,7 +68,8 @@ all(suite) -> equal_with_high_max, bound_process, scheduler_bind, - scheduler_suspend]. + scheduler_suspend, + reader_groups]. init_per_testcase(Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?DEFAULT_TIMEOUT), @@ -81,6 +83,10 @@ fin_per_testcase(_Case, Config) when is_list(Config) -> ?t:timetrap_cancel(Dog), ok. +end_per_suite(Config) -> + catch erts_debug:set_internal_state(available_internal_state, false), + Config. + -define(ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED, (2000*2000)). -define(DEFAULT_TEST_REDS_PER_SCHED, 200000000). @@ -902,7 +908,8 @@ scheduler_suspend_test(Config, Schedulers) -> ?line [SState] = mcall(Node, [fun () -> erlang:system_info(schedulers_state) end]), - ?line {Sched, _, _} = SState, + ?line ?t:format("SState=~p~n", [SState]), + ?line {Sched, SchedOnln, _SchedAvail} = SState, ?line true = is_integer(Sched), ?line [ok] = mcall(Node, [fun () -> sst0_loop(300) end]), ?line [ok] = mcall(Node, [fun () -> sst1_loop(300) end]), @@ -914,6 +921,14 @@ scheduler_suspend_test(Config, Schedulers) -> fun () -> sst2_loop(200) end, fun () -> sst3_loop(Sched, 200) end]), ?line [SState] = mcall(Node, [fun () -> + case Sched == SchedOnln of + false -> + Sched = erlang:system_flag( + schedulers_online, + SchedOnln); + true -> + ok + end, erlang:system_info(schedulers_state) end]), ?line stop_node(Node), @@ -956,12 +971,361 @@ sst3_loop(S, N) -> erlang:system_flag(schedulers_online, 1), erlang:system_flag(schedulers_online, S), sst3_loop(S, N-1). + +reader_groups(Config) when is_list(Config) -> + %% White box testing. These results are correct, but other results + %% could be too... + + %% The actual tilepro64 topology + CPUT0 = [{processor,[{node,[{core,{logical,0}}, + {core,{logical,1}}, + {core,{logical,2}}, + {core,{logical,8}}, + {core,{logical,9}}, + {core,{logical,10}}, + {core,{logical,11}}, + {core,{logical,16}}, + {core,{logical,17}}, + {core,{logical,18}}, + {core,{logical,19}}, + {core,{logical,24}}, + {core,{logical,25}}, + {core,{logical,27}}, + {core,{logical,29}}]}, + {node,[{core,{logical,3}}, + {core,{logical,4}}, + {core,{logical,5}}, + {core,{logical,6}}, + {core,{logical,7}}, + {core,{logical,12}}, + {core,{logical,13}}, + {core,{logical,14}}, + {core,{logical,15}}, + {core,{logical,20}}, + {core,{logical,21}}, + {core,{logical,22}}, + {core,{logical,23}}, + {core,{logical,28}}, + {core,{logical,30}}]}, + {node,[{core,{logical,31}}, + {core,{logical,36}}, + {core,{logical,37}}, + {core,{logical,38}}, + {core,{logical,44}}, + {core,{logical,45}}, + {core,{logical,46}}, + {core,{logical,47}}, + {core,{logical,51}}, + {core,{logical,52}}, + {core,{logical,53}}, + {core,{logical,54}}, + {core,{logical,55}}, + {core,{logical,60}}, + {core,{logical,61}}]}, + {node,[{core,{logical,26}}, + {core,{logical,32}}, + {core,{logical,33}}, + {core,{logical,34}}, + {core,{logical,35}}, + {core,{logical,39}}, + {core,{logical,40}}, + {core,{logical,41}}, + {core,{logical,42}}, + {core,{logical,43}}, + {core,{logical,48}}, + {core,{logical,49}}, + {core,{logical,50}}, + {core,{logical,58}}]}]}], + + ?line [{0,1},{1,1},{2,1},{3,3},{4,3},{5,3},{6,3},{7,3},{8,1},{9,1},{10,1}, + {11,1},{12,3},{13,3},{14,4},{15,4},{16,2},{17,2},{18,2},{19,2}, + {20,4},{21,4},{22,4},{23,4},{24,2},{25,2},{26,7},{27,2},{28,4}, + {29,2},{30,4},{31,5},{32,7},{33,7},{34,7},{35,7},{36,5},{37,5}, + {38,5},{39,7},{40,7},{41,8},{42,8},{43,8},{44,5},{45,5},{46,5}, + {47,6},{48,8},{49,8},{50,8},{51,6},{52,6},{53,6},{54,6},{55,6}, + {58,8},{60,6},{61,6}] + = reader_groups_map(CPUT0, 8), + + CPUT1 = [n([p([c([t(l(0)),t(l(1)),t(l(2)),t(l(3))]), + c([t(l(4)),t(l(5)),t(l(6)),t(l(7))]), + c([t(l(8)),t(l(9)),t(l(10)),t(l(11))]), + c([t(l(12)),t(l(13)),t(l(14)),t(l(15))])]), + p([c([t(l(16)),t(l(17)),t(l(18)),t(l(19))]), + c([t(l(20)),t(l(21)),t(l(22)),t(l(23))]), + c([t(l(24)),t(l(25)),t(l(26)),t(l(27))]), + c([t(l(28)),t(l(29)),t(l(30)),t(l(31))])])]), + n([p([c([t(l(32)),t(l(33)),t(l(34)),t(l(35))]), + c([t(l(36)),t(l(37)),t(l(38)),t(l(39))]), + c([t(l(40)),t(l(41)),t(l(42)),t(l(43))]), + c([t(l(44)),t(l(45)),t(l(46)),t(l(47))])]), + p([c([t(l(48)),t(l(49)),t(l(50)),t(l(51))]), + c([t(l(52)),t(l(53)),t(l(54)),t(l(55))]), + c([t(l(56)),t(l(57)),t(l(58)),t(l(59))]), + c([t(l(60)),t(l(61)),t(l(62)),t(l(63))])])]), + n([p([c([t(l(64)),t(l(65)),t(l(66)),t(l(67))]), + c([t(l(68)),t(l(69)),t(l(70)),t(l(71))]), + c([t(l(72)),t(l(73)),t(l(74)),t(l(75))]), + c([t(l(76)),t(l(77)),t(l(78)),t(l(79))])]), + p([c([t(l(80)),t(l(81)),t(l(82)),t(l(83))]), + c([t(l(84)),t(l(85)),t(l(86)),t(l(87))]), + c([t(l(88)),t(l(89)),t(l(90)),t(l(91))]), + c([t(l(92)),t(l(93)),t(l(94)),t(l(95))])])]), + n([p([c([t(l(96)),t(l(97)),t(l(98)),t(l(99))]), + c([t(l(100)),t(l(101)),t(l(102)),t(l(103))]), + c([t(l(104)),t(l(105)),t(l(106)),t(l(107))]), + c([t(l(108)),t(l(109)),t(l(110)),t(l(111))])]), + p([c([t(l(112)),t(l(113)),t(l(114)),t(l(115))]), + c([t(l(116)),t(l(117)),t(l(118)),t(l(119))]), + c([t(l(120)),t(l(121)),t(l(122)),t(l(123))]), + c([t(l(124)),t(l(125)),t(l(126)),t(l(127))])])])], + + ?line [{0,1},{1,1},{2,1},{3,1},{4,2},{5,2},{6,2},{7,2},{8,3},{9,3}, + {10,3},{11,3},{12,4},{13,4},{14,4},{15,4},{16,5},{17,5},{18,5}, + {19,5},{20,6},{21,6},{22,6},{23,6},{24,7},{25,7},{26,7},{27,7}, + {28,8},{29,8},{30,8},{31,8},{32,9},{33,9},{34,9},{35,9},{36,10}, + {37,10},{38,10},{39,10},{40,11},{41,11},{42,11},{43,11},{44,12}, + {45,12},{46,12},{47,12},{48,13},{49,13},{50,13},{51,13},{52,14}, + {53,14},{54,14},{55,14},{56,15},{57,15},{58,15},{59,15},{60,16}, + {61,16},{62,16},{63,16},{64,17},{65,17},{66,17},{67,17},{68,18}, + {69,18},{70,18},{71,18},{72,19},{73,19},{74,19},{75,19},{76,20}, + {77,20},{78,20},{79,20},{80,21},{81,21},{82,21},{83,21},{84,22}, + {85,22},{86,22},{87,22},{88,23},{89,23},{90,23},{91,23},{92,24}, + {93,24},{94,24},{95,24},{96,25},{97,25},{98,25},{99,25},{100,26}, + {101,26},{102,26},{103,26},{104,27},{105,27},{106,27},{107,27}, + {108,28},{109,28},{110,28},{111,28},{112,29},{113,29},{114,29}, + {115,29},{116,30},{117,30},{118,30},{119,30},{120,31},{121,31}, + {122,31},{123,31},{124,32},{125,32},{126,32},{127,32}] + = reader_groups_map(CPUT1, 128), + + ?line [{0,1},{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1}, + {11,1},{12,1},{13,1},{14,1},{15,1},{16,1},{17,1},{18,1},{19,1}, + {20,1},{21,1},{22,1},{23,1},{24,1},{25,1},{26,1},{27,1},{28,1}, + {29,1},{30,1},{31,1},{32,1},{33,1},{34,1},{35,1},{36,1},{37,1}, + {38,1},{39,1},{40,1},{41,1},{42,1},{43,1},{44,1},{45,1},{46,1}, + {47,1},{48,1},{49,1},{50,1},{51,1},{52,1},{53,1},{54,1},{55,1}, + {56,1},{57,1},{58,1},{59,1},{60,1},{61,1},{62,1},{63,1},{64,2}, + {65,2},{66,2},{67,2},{68,2},{69,2},{70,2},{71,2},{72,2},{73,2}, + {74,2},{75,2},{76,2},{77,2},{78,2},{79,2},{80,2},{81,2},{82,2}, + {83,2},{84,2},{85,2},{86,2},{87,2},{88,2},{89,2},{90,2},{91,2}, + {92,2},{93,2},{94,2},{95,2},{96,2},{97,2},{98,2},{99,2},{100,2}, + {101,2},{102,2},{103,2},{104,2},{105,2},{106,2},{107,2},{108,2}, + {109,2},{110,2},{111,2},{112,2},{113,2},{114,2},{115,2},{116,2}, + {117,2},{118,2},{119,2},{120,2},{121,2},{122,2},{123,2},{124,2}, + {125,2},{126,2},{127,2}] + = reader_groups_map(CPUT1, 2), + + ?line [{0,1},{1,1},{2,1},{3,1},{4,2},{5,2},{6,2},{7,2},{8,3},{9,3},{10,3}, + {11,3},{12,3},{13,3},{14,3},{15,3},{16,4},{17,4},{18,4},{19,4}, + {20,4},{21,4},{22,4},{23,4},{24,5},{25,5},{26,5},{27,5},{28,5}, + {29,5},{30,5},{31,5},{32,6},{33,6},{34,6},{35,6},{36,6},{37,6}, + {38,6},{39,6},{40,7},{41,7},{42,7},{43,7},{44,7},{45,7},{46,7}, + {47,7},{48,8},{49,8},{50,8},{51,8},{52,8},{53,8},{54,8},{55,8}, + {56,9},{57,9},{58,9},{59,9},{60,9},{61,9},{62,9},{63,9},{64,10}, + {65,10},{66,10},{67,10},{68,10},{69,10},{70,10},{71,10},{72,11}, + {73,11},{74,11},{75,11},{76,11},{77,11},{78,11},{79,11},{80,12}, + {81,12},{82,12},{83,12},{84,12},{85,12},{86,12},{87,12},{88,13}, + {89,13},{90,13},{91,13},{92,13},{93,13},{94,13},{95,13},{96,14}, + {97,14},{98,14},{99,14},{100,14},{101,14},{102,14},{103,14}, + {104,15},{105,15},{106,15},{107,15},{108,15},{109,15},{110,15}, + {111,15},{112,16},{113,16},{114,16},{115,16},{116,16},{117,16}, + {118,16},{119,16},{120,17},{121,17},{122,17},{123,17},{124,17}, + {125,17},{126,17},{127,17}] + = reader_groups_map(CPUT1, 17), + + ?line [{0,1},{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1}, + {11,1},{12,1},{13,1},{14,1},{15,1},{16,2},{17,2},{18,2},{19,2}, + {20,2},{21,2},{22,2},{23,2},{24,2},{25,2},{26,2},{27,2},{28,2}, + {29,2},{30,2},{31,2},{32,3},{33,3},{34,3},{35,3},{36,3},{37,3}, + {38,3},{39,3},{40,3},{41,3},{42,3},{43,3},{44,3},{45,3},{46,3}, + {47,3},{48,4},{49,4},{50,4},{51,4},{52,4},{53,4},{54,4},{55,4}, + {56,4},{57,4},{58,4},{59,4},{60,4},{61,4},{62,4},{63,4},{64,5}, + {65,5},{66,5},{67,5},{68,5},{69,5},{70,5},{71,5},{72,5},{73,5}, + {74,5},{75,5},{76,5},{77,5},{78,5},{79,5},{80,6},{81,6},{82,6}, + {83,6},{84,6},{85,6},{86,6},{87,6},{88,6},{89,6},{90,6},{91,6}, + {92,6},{93,6},{94,6},{95,6},{96,7},{97,7},{98,7},{99,7},{100,7}, + {101,7},{102,7},{103,7},{104,7},{105,7},{106,7},{107,7},{108,7}, + {109,7},{110,7},{111,7},{112,7},{113,7},{114,7},{115,7},{116,7}, + {117,7},{118,7},{119,7},{120,7},{121,7},{122,7},{123,7},{124,7}, + {125,7},{126,7},{127,7}] + = reader_groups_map(CPUT1, 7), + + ?line CPUT2 = [p([c(l(0)),c(l(1)),c(l(2)),c(l(3)),c(l(4))]), + p([t(l(5)),t(l(6)),t(l(7)),t(l(8)),t(l(9))]), + p([t(l(10))]), + p([c(l(11)),c(l(12)),c(l(13))]), + p([c(l(14)),c(l(15))])], + + ?line [{0,1},{1,1},{2,1},{3,1},{4,1}, + {5,2},{6,2},{7,2},{8,2},{9,2}, + {10,3}, + {11,4},{12,4},{13,4}, + {14,5},{15,5}] = reader_groups_map(CPUT2, 5), + + + ?line [{0,1},{1,1},{2,2},{3,2},{4,2}, + {5,3},{6,3},{7,3},{8,3},{9,3}, + {10,4}, + {11,5},{12,5},{13,5}, + {14,6},{15,6}] = reader_groups_map(CPUT2, 6), + + ?line [{0,1},{1,1},{2,2},{3,2},{4,2}, + {5,3},{6,3},{7,3},{8,3},{9,3}, + {10,4}, + {11,5},{12,6},{13,6}, + {14,7},{15,7}] = reader_groups_map(CPUT2, 7), + + ?line [{0,1},{1,1},{2,2},{3,2},{4,2}, + {5,3},{6,3},{7,3},{8,3},{9,3}, + {10,4}, + {11,5},{12,6},{13,6}, + {14,7},{15,8}] = reader_groups_map(CPUT2, 8), + + ?line [{0,1},{1,2},{2,2},{3,3},{4,3}, + {5,4},{6,4},{7,4},{8,4},{9,4}, + {10,5}, + {11,6},{12,7},{13,7}, + {14,8},{15,9}] = reader_groups_map(CPUT2, 9), + + ?line [{0,1},{1,2},{2,2},{3,3},{4,3}, + {5,4},{6,4},{7,4},{8,4},{9,4}, + {10,5}, + {11,6},{12,7},{13,8}, + {14,9},{15,10}] = reader_groups_map(CPUT2, 10), + + ?line [{0,1},{1,2},{2,3},{3,4},{4,4}, + {5,5},{6,5},{7,5},{8,5},{9,5}, + {10,6}, + {11,7},{12,8},{13,9}, + {14,10},{15,11}] = reader_groups_map(CPUT2, 11), + + ?line [{0,1},{1,2},{2,3},{3,4},{4,5}, + {5,6},{6,6},{7,6},{8,6},{9,6}, + {10,7}, + {11,8},{12,9},{13,10}, + {14,11},{15,12}] = reader_groups_map(CPUT2, 100), + + CPUT3 = [p([t(l(5)),t(l(6)),t(l(7)),t(l(8)),t(l(9))]), + p([t(l(10))]), + p([c(l(11)),c(l(12)),c(l(13))]), + p([c(l(14)),c(l(15))]), + p([c(l(0)),c(l(1)),c(l(2)),c(l(3)),c(l(4))])], + + ?line [{0,5},{1,5},{2,6},{3,6},{4,6}, + {5,1},{6,1},{7,1},{8,1},{9,1}, + {10,2},{11,3},{12,3},{13,3}, + {14,4},{15,4}] = reader_groups_map(CPUT3, 6), + + CPUT4 = [p([t(l(0)),t(l(1)),t(l(2)),t(l(3)),t(l(4))]), + p([t(l(5))]), + p([c(l(6)),c(l(7)),c(l(8))]), + p([c(l(9)),c(l(10))]), + p([c(l(11)),c(l(12)),c(l(13)),c(l(14)),c(l(15))])], + + ?line [{0,1},{1,1},{2,1},{3,1},{4,1}, + {5,2}, + {6,3},{7,3},{8,3}, + {9,4},{10,4}, + {11,5},{12,5},{13,6},{14,6},{15,6}] = reader_groups_map(CPUT4, 6), + + ?line [{0,1},{1,1},{2,1},{3,1},{4,1}, + {5,2}, + {6,3},{7,4},{8,4}, + {9,5},{10,5}, + {11,6},{12,6},{13,7},{14,7},{15,7}] = reader_groups_map(CPUT4, 7), + + ?line [{0,1},{65535,2}] = reader_groups_map([c(l(0)),c(l(65535))], 10), + + ?line ok. +reader_groups_map(CPUT, Groups) -> + Old = erlang:system_info({cpu_topology, defined}), + erlang:system_flag(cpu_topology, CPUT), + enable_internal_state(), + Res = erts_debug:get_internal_state({reader_groups_map, Groups}), + erlang:system_flag(cpu_topology, Old), + lists:sort(Res). + %% %% Utils %% +tilera_cpu_topology() -> + [{processor,[{node,[{core,{logical,0}}, + {core,{logical,1}}, + {core,{logical,2}}, + {core,{logical,8}}, + {core,{logical,9}}, + {core,{logical,10}}, + {core,{logical,11}}, + {core,{logical,16}}, + {core,{logical,17}}, + {core,{logical,18}}, + {core,{logical,19}}, + {core,{logical,24}}, + {core,{logical,25}}, + {core,{logical,27}}, + {core,{logical,29}}]}, + {node,[{core,{logical,3}}, + {core,{logical,4}}, + {core,{logical,5}}, + {core,{logical,6}}, + {core,{logical,7}}, + {core,{logical,12}}, + {core,{logical,13}}, + {core,{logical,14}}, + {core,{logical,15}}, + {core,{logical,20}}, + {core,{logical,21}}, + {core,{logical,22}}, + {core,{logical,23}}, + {core,{logical,28}}, + {core,{logical,30}}]}, + {node,[{core,{logical,31}}, + {core,{logical,36}}, + {core,{logical,37}}, + {core,{logical,38}}, + {core,{logical,44}}, + {core,{logical,45}}, + {core,{logical,46}}, + {core,{logical,47}}, + {core,{logical,51}}, + {core,{logical,52}}, + {core,{logical,53}}, + {core,{logical,54}}, + {core,{logical,55}}, + {core,{logical,60}}, + {core,{logical,61}}]}, + {node,[{core,{logical,26}}, + {core,{logical,32}}, + {core,{logical,33}}, + {core,{logical,34}}, + {core,{logical,35}}, + {core,{logical,39}}, + {core,{logical,40}}, + {core,{logical,41}}, + {core,{logical,42}}, + {core,{logical,43}}, + {core,{logical,48}}, + {core,{logical,49}}, + {core,{logical,50}}, + {core,{logical,58}}]}]}]. + +l(Id) -> + {logical, Id}. + +t(X) -> + {thread, X}. + +c(X) -> + {core, X}. + +p(X) -> + {processor, X}. + +n(X) -> + {node, X}. + mcall(Node, Funs) -> Parent = self(), Refs = lists:map(fun (Fun) -> diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl index 489adbd660..5fd01a9ac5 100644 --- a/erts/emulator/test/send_term_SUITE.erl +++ b/erts/emulator/test/send_term_SUITE.erl @@ -76,40 +76,43 @@ basic(Config) when is_list(Config) -> ?line ExpectedBinTup = term(P, 7), %% single terms - ?line [] = term(P, 8), % ERL_DRV_NIL - ?line '' = term(P, 9), % ERL_DRV_ATOM - ?line an_atom = term(P, 10), % ERL_DRV_ATOM - ?line -4711 = term(P, 11), % ERL_DRV_INT - ?line 4711 = term(P, 12), % ERL_DRV_UINT - ?line P = term(P, 13), % ERL_DRV_PORT - ?line <<>> = term(P, 14), % ERL_DRV_BINARY - ?line <<"hejsan">> = term(P, 15), % ERL_DRV_BINARY - ?line <<>> = term(P, 16), % ERL_DRV_BUF2BINARY - ?line <<>> = term(P, 17), % ERL_DRV_BUF2BINARY - ?line <<"hoppsan">> = term(P, 18), % ERL_DRV_BUF2BINARY - ?line "" = term(P, 19), % ERL_DRV_STRING - ?line "" = term(P, 20), % ERL_DRV_STRING - ?line "hippsan" = term(P, 21), % ERL_DRV_STRING - ?line {} = term(P, 22), % ERL_DRV_TUPLE - ?line [] = term(P, 23), % ERL_DRV_LIST - ?line Self = term(P, 24), % ERL_DRV_PID - ?line [] = term(P, 25), % ERL_DRV_STRING_CONS - ?line AFloat = term(P, 26), % ERL_DRV_FLOAT + Singles = [{[], 8}, % ERL_DRV_NIL + {'', 9}, % ERL_DRV_ATOM + {an_atom, 10}, % ERL_DRV_ATOM + {-4711, 11}, % ERL_DRV_INT + {4711, 12}, % ERL_DRV_UINT + {P, 13}, % ERL_DRV_PORT + {<<>>, 14}, % ERL_DRV_BINARY + {<<"hejsan">>, 15}, % ERL_DRV_BINARY + {<<>>, 16}, % ERL_DRV_BUF2BINARY + {<<>>, 17}, % ERL_DRV_BUF2BINARY + {<<"hoppsan">>, 18}, % ERL_DRV_BUF2BINARY + {"", 19}, % ERL_DRV_STRING + {"", 20}, % ERL_DRV_STRING + {"hippsan", 21}, % ERL_DRV_STRING + {{}, 22}, % ERL_DRV_TUPLE + {[], 23}, % ERL_DRV_LIST + {Self, 24}, % ERL_DRV_PID + {[], 25}, % ERL_DRV_STRING_CONS + {[], 27}, % ERL_DRV_EXT2TERM + {18446744073709551615, 28}, % ERL_DRV_UINT64 + {20233590931456, 29}, % ERL_DRV_UINT64 + {4711, 30}, % ERL_DRV_UINT64 + {0, 31}, % ERL_DRV_UINT64 + {9223372036854775807, 32}, % ERL_DRV_INT64 + {20233590931456, 33}, % ERL_DRV_INT64 + {4711, 34}, % ERL_DRV_INT64 + {0, 35}, % ERL_DRV_INT64 + {-1, 36}, % ERL_DRV_INT64 + {-4711, 37}, % ERL_DRV_INT64 + {-20233590931456, 38}, % ERL_DRV_INT64 + {-9223372036854775808, 39}], % ERL_DRV_INT64 + ?line {Terms, Ops} = lists:unzip(Singles), + ?line Terms = term(P,Ops), + + AFloat = term(P, 26), % ERL_DRV_FLOAT ?line true = AFloat < 0.001, ?line true = AFloat > -0.001, - ?line [] = term(P, 27), % ERL_DRV_EXT2TERM - ?line 18446744073709551615 = term(P, 28), % ERL_DRV_UINT64 - ?line 20233590931456 = term(P, 29), % ERL_DRV_UINT64 - ?line 4711 = term(P, 30), % ERL_DRV_UINT64 - ?line 0 = term(P, 31), % ERL_DRV_UINT64 - ?line 9223372036854775807 = term(P, 32), % ERL_DRV_INT64 - ?line 20233590931456 = term(P, 33), % ERL_DRV_INT64 - ?line 4711 = term(P, 34), % ERL_DRV_INT64 - ?line 0 = term(P, 35), % ERL_DRV_INT64 - ?line -1 = term(P, 36), % ERL_DRV_INT64 - ?line -4711 = term(P, 37), % ERL_DRV_INT64 - ?line -20233590931456 = term(P, 38), % ERL_DRV_INT64 - ?line -9223372036854775808 = term(P, 39), % ERL_DRV_INT64 %% Failure cases. ?line [] = term(P, 127), diff --git a/erts/emulator/test/send_term_SUITE_data/send_term_drv.c b/erts/emulator/test/send_term_SUITE_data/send_term_drv.c index 6638de0560..165cce2e9d 100644 --- a/erts/emulator/test/send_term_SUITE_data/send_term_drv.c +++ b/erts/emulator/test/send_term_SUITE_data/send_term_drv.c @@ -17,6 +17,7 @@ */ #include "erl_driver.h" +#include <stdio.h> #include <errno.h> #include <string.h> @@ -65,12 +66,21 @@ static void fail_term(ErlDrvTermData* msg, int len, int line); static void send_term_drv_run(ErlDrvData port, char *buf, int count) { - ErlDrvTermData msg[1024]; - - switch (*buf) { + char buf7[1024]; + ErlDrvTermData spec[1024]; + ErlDrvTermData* msg = spec; + ErlDrvBinary* bins[15]; + int bin_ix = 0; + ErlDrvSInt64 s64[15]; + int s64_ix = 0; + ErlDrvUInt64 u64[15]; + int u64_ix = 0; + int i = 0; + + for (i=0; i<count; i++) switch (buf[i]) { case 0: msg[0] = ERL_DRV_NIL; - output_term(msg, 1); + msg += 1; break; case 1: /* Most term types inside a tuple. */ @@ -102,7 +112,7 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) msg[22] = driver_connected(erlang_port); msg[23] = ERL_DRV_TUPLE; msg[24] = (ErlDrvTermData) 7; - output_term(msg, 25); + msg += 25; } break; @@ -117,7 +127,7 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) msg[i] = ERL_DRV_NIL; msg[i+1] = ERL_DRV_LIST; msg[i+2] = (ErlDrvTermData) 201; - output_term(msg, i+3); + msg += i+3; } break; @@ -126,7 +136,7 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) ErlDrvBinary* bin; int i; - bin = driver_alloc_binary(256); + bin = bins[bin_ix++] = driver_alloc_binary(256); for (i = 0; i < 256; i++) { bin->orig_bytes[i] = i; } @@ -140,8 +150,7 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) msg[7] = (ErlDrvTermData) 23; msg[8] = ERL_DRV_TUPLE; msg[9] = (ErlDrvTermData) 2; - output_term(msg, 10); - driver_free_binary(bin); + msg += 10; } break; @@ -152,11 +161,11 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) msg[3] = driver_caller(erlang_port); msg[4] = ERL_DRV_TUPLE; msg[5] = (ErlDrvTermData) 2; - output_term(msg, 6); + msg += 6; break; case 5: - output_term(msg, make_ext_term_list(msg, 0)); + msg += make_ext_term_list(msg, 0); break; case 6: @@ -166,94 +175,91 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) msg[3] = ~((ErlDrvTermData) 0); msg[4] = ERL_DRV_TUPLE; msg[5] = (ErlDrvTermData) 2; - output_term(msg, 6); + msg += 6; break; case 7: { int len = 0; - char buf[1024]; - memset(buf, 17, sizeof(buf)); + memset(buf7, 17, sizeof(buf7)); /* empty heap binary */ msg[len++] = ERL_DRV_BUF2BINARY; msg[len++] = (ErlDrvTermData) NULL; /* NULL is ok if size == 0 */ msg[len++] = (ErlDrvTermData) 0; /* empty heap binary again */ msg[len++] = ERL_DRV_BUF2BINARY; - msg[len++] = (ErlDrvTermData) &buf[0]; /* ptr is ok if size == 0 */ + msg[len++] = (ErlDrvTermData) buf7; /* ptr is ok if size == 0 */ msg[len++] = (ErlDrvTermData) 0; /* heap binary */ msg[len++] = ERL_DRV_BUF2BINARY; - msg[len++] = (ErlDrvTermData) &buf[0]; + msg[len++] = (ErlDrvTermData) buf7; msg[len++] = (ErlDrvTermData) 17; /* off heap binary */ msg[len++] = ERL_DRV_BUF2BINARY; - msg[len++] = (ErlDrvTermData) &buf[0]; - msg[len++] = (ErlDrvTermData) sizeof(buf); + msg[len++] = (ErlDrvTermData) buf7; + msg[len++] = (ErlDrvTermData) sizeof(buf7); msg[len++] = ERL_DRV_TUPLE; msg[len++] = (ErlDrvTermData) 4; - output_term(msg, len); + msg += len; break; } case 8: msg[0] = ERL_DRV_NIL; - output_term(msg, 1); + msg += 1; break; case 9: msg[0] = ERL_DRV_ATOM; msg[1] = (ErlDrvTermData) driver_mk_atom(""); - output_term(msg, 2); + msg += 2; break; case 10: msg[0] = ERL_DRV_ATOM; msg[1] = (ErlDrvTermData) driver_mk_atom("an_atom"); - output_term(msg, 2); + msg += 2; break; case 11: msg[0] = ERL_DRV_INT; msg[1] = (ErlDrvTermData) -4711; - output_term(msg, 2); + msg += 2; break; case 12: msg[0] = ERL_DRV_UINT; msg[1] = (ErlDrvTermData) 4711; - output_term(msg, 2); + msg += 2; break; case 13: msg[0] = ERL_DRV_PORT; msg[1] = driver_mk_port(erlang_port); - output_term(msg, 2); + msg += 2; break; case 14: { - ErlDrvBinary *dbin = driver_alloc_binary(0); + ErlDrvBinary *dbin = bins[bin_ix++] = driver_alloc_binary(0); msg[0] = ERL_DRV_BINARY; msg[1] = (ErlDrvTermData) dbin; msg[2] = (ErlDrvTermData) 0; msg[3] = (ErlDrvTermData) 0; - output_term(msg, 4); - driver_free_binary(dbin); + msg += 4; break; } case 15: { - char buf[] = "hejsan"; - ErlDrvBinary *dbin = driver_alloc_binary(sizeof(buf)-1); + static const char buf[] = "hejsan"; + ErlDrvBinary *dbin = bins[bin_ix++] = driver_alloc_binary(sizeof(buf)-1); if (dbin) memcpy((void *) dbin->orig_bytes, (void *) buf, sizeof(buf)-1); msg[0] = ERL_DRV_BINARY; msg[1] = (ErlDrvTermData) dbin; msg[2] = (ErlDrvTermData) (dbin ? sizeof(buf)-1 : 0); msg[3] = (ErlDrvTermData) 0; - output_term(msg, 4); - driver_free_binary(dbin); + msg += 4; break; } @@ -261,24 +267,24 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) msg[0] = ERL_DRV_BUF2BINARY; msg[1] = (ErlDrvTermData) NULL; msg[2] = (ErlDrvTermData) 0; - output_term(msg, 3); + msg += 3; break; case 17: { - char buf[] = ""; + static const char buf[] = ""; msg[0] = ERL_DRV_BUF2BINARY; msg[1] = (ErlDrvTermData) buf; msg[2] = (ErlDrvTermData) sizeof(buf)-1; - output_term(msg, 3); + msg += 3; break; } case 18: { - char buf[] = "hoppsan"; + static const char buf[] = "hoppsan"; msg[0] = ERL_DRV_BUF2BINARY; msg[1] = (ErlDrvTermData) buf; msg[2] = (ErlDrvTermData) sizeof(buf)-1; - output_term(msg, 3); + msg += 3; break; } @@ -286,44 +292,44 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) msg[0] = ERL_DRV_STRING; msg[1] = (ErlDrvTermData) buf; msg[2] = (ErlDrvTermData) 0; - output_term(msg, 3); + msg += 3; break; case 20: { - char buf[] = ""; + static const char buf[] = ""; msg[0] = ERL_DRV_STRING; msg[1] = (ErlDrvTermData) buf; msg[2] = (ErlDrvTermData) sizeof(buf)-1; - output_term(msg, 3); + msg += 3; break; } case 21: { - char buf[] = "hippsan"; + static const char buf[] = "hippsan"; msg[0] = ERL_DRV_STRING; msg[1] = (ErlDrvTermData) buf; msg[2] = (ErlDrvTermData) sizeof(buf)-1; - output_term(msg, 3); + msg += 3; break; } case 22: msg[0] = ERL_DRV_TUPLE; msg[1] = (ErlDrvTermData) 0; - output_term(msg, 2); + msg += 2; break; case 23: msg[0] = ERL_DRV_NIL; msg[1] = ERL_DRV_LIST; msg[2] = (ErlDrvTermData) 1; - output_term(msg, 3); + msg += 3; break; case 24: msg[0] = ERL_DRV_PID; msg[1] = driver_connected(erlang_port); - output_term(msg, 2); + msg += 2; break; case 25: @@ -331,132 +337,131 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) msg[1] = ERL_DRV_STRING_CONS; msg[2] = (ErlDrvTermData) ""; msg[3] = (ErlDrvTermData) 0; - output_term(msg, 4); + msg += 4; break; case 26: { - double my_float = 0.0; + static double my_float = 0.0; msg[0] = ERL_DRV_FLOAT; msg[1] = (ErlDrvTermData) &my_float; - output_term(msg, 2); + msg += 2; break; } case 27: { - char buf[] = {131, 106}; /* [] */ + static char buf[] = {131, 106}; /* [] */ msg[0] = ERL_DRV_EXT2TERM; msg[1] = (ErlDrvTermData) buf; msg[2] = (ErlDrvTermData) sizeof(buf); - output_term(msg, 3); + msg += 3; break; } case 28: { - ErlDrvUInt64 x = ~((ErlDrvUInt64) 0); + ErlDrvUInt64* x = &u64[u64_ix++]; + *x = ~((ErlDrvUInt64) 0); msg[0] = ERL_DRV_UINT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 29: { - ErlDrvUInt64 x = ((ErlDrvUInt64) 4711) << 32; + ErlDrvUInt64* x = &u64[u64_ix++]; + *x = ((ErlDrvUInt64) 4711) << 32; msg[0] = ERL_DRV_UINT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 30: { - ErlDrvUInt64 x = 4711; + ErlDrvUInt64* x = &u64[u64_ix++]; + *x = 4711; msg[0] = ERL_DRV_UINT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 31: { - ErlDrvUInt64 x = 0; + ErlDrvUInt64* x = &u64[u64_ix++]; + *x = 0; msg[0] = ERL_DRV_UINT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 32: { - ErlDrvSInt64 x = ((((ErlDrvUInt64) 0x7fffffff) << 32) - | ((ErlDrvUInt64) 0xffffffff)); + ErlDrvSInt64* x = &s64[s64_ix++]; + *x = ((((ErlDrvUInt64) 0x7fffffff) << 32) | ((ErlDrvUInt64) 0xffffffff)); msg[0] = ERL_DRV_INT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 33: { - ErlDrvSInt64 x = (ErlDrvSInt64) (((ErlDrvUInt64) 4711) << 32); + ErlDrvSInt64* x = &s64[s64_ix++]; + *x = (ErlDrvSInt64) (((ErlDrvUInt64) 4711) << 32); msg[0] = ERL_DRV_INT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 34: { - ErlDrvSInt64 x = 4711; + ErlDrvSInt64* x = &s64[s64_ix++]; + *x = 4711; msg[0] = ERL_DRV_INT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 35: { - ErlDrvSInt64 x = 0; + ErlDrvSInt64* x = &s64[s64_ix++]; + *x = 0; msg[0] = ERL_DRV_INT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 36: { - ErlDrvSInt64 x = -1; + ErlDrvSInt64* x = &s64[s64_ix++]; + *x = -1; msg[0] = ERL_DRV_INT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 37: { - ErlDrvSInt64 x = -4711; + ErlDrvSInt64* x = &s64[s64_ix++]; + *x = -4711; msg[0] = ERL_DRV_INT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 38: { - ErlDrvSInt64 x = ((ErlDrvSInt64) ((ErlDrvUInt64) 4711) << 32)*-1; + ErlDrvSInt64* x = &s64[s64_ix++]; + *x = ((ErlDrvSInt64) ((ErlDrvUInt64) 4711) << 32)*-1; msg[0] = ERL_DRV_INT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } case 39: { - ErlDrvSInt64 x = ((ErlDrvSInt64) 1) << 63; + ErlDrvSInt64* x = &s64[s64_ix++]; + *x = ((ErlDrvSInt64) 1) << 63; msg[0] = ERL_DRV_INT64; - msg[1] = (ErlDrvTermData) &x; - output_term(msg, 2); - + msg[1] = (ErlDrvTermData) x; + msg += 2; break; } @@ -464,7 +469,7 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) case 127: /* Error cases */ { long refc; - ErlDrvBinary* bin = driver_alloc_binary(256); + ErlDrvBinary* bin = bins[bin_ix++] = driver_alloc_binary(256); FAIL_TERM(msg, 0); @@ -537,7 +542,7 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) refc = driver_binary_get_refc(bin); if (refc > 3) { char sbuf[128]; - sprintf(sbuf, "bad_refc:%d", refc); + sprintf(sbuf, "bad_refc:%ld", refc); driver_failure_atom(erlang_port, sbuf); } driver_free_binary(bin); @@ -644,6 +649,7 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) /* Signal end of test case */ msg[0] = ERL_DRV_NIL; driver_output_term(erlang_port, msg, 1); + return; } break; @@ -651,6 +657,16 @@ static void send_term_drv_run(ErlDrvData port, char *buf, int count) driver_failure_atom(erlang_port, "bad_request"); break; } + if (count > 1) { + *msg++ = ERL_DRV_NIL; + *msg++ = ERL_DRV_LIST; + *msg++ = count + 1; + } + output_term(spec, msg-spec); + if ((bin_ix|s64_ix|u64_ix) > 15) abort(); + while (bin_ix) { + driver_free_binary(bins[--bin_ix]); + } } static void output_term(ErlDrvTermData* msg, int len) diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index e782d2f293..ba433d4e11 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -35,12 +35,12 @@ %-compile(export_all). -export([all/1, init_per_testcase/2, fin_per_testcase/2]). --export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1]). +-export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1]). -define(DEFAULT_TIMEOUT, ?t:minutes(2)). all(doc) -> []; -all(suite) -> [process_count, system_version, misc_smoke_tests, heap_size]. +all(suite) -> [process_count, system_version, misc_smoke_tests, heap_size, wordsize]. init_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?DEFAULT_TIMEOUT), @@ -145,3 +145,23 @@ heap_size(Config) when is_list(Config) -> ?line Hmin = proplists:get_value(min_heap_size, GCinf), ok. +wordsize(suite) -> + []; +wordsize(doc) -> + ["Tests the various wordsize variants"]; +wordsize(Config) when is_list(Config) -> + ?line A = erlang:system_info(wordsize), + ?line true = is_integer(A), + ?line A = erlang:system_info({wordsize,internal}), + ?line B = erlang:system_info({wordsize,external}), + ?line true = A =< B, + case {B,A} of + {4,4} -> + {comment, "True 32-bit emulator"}; + {8,8} -> + {comment, "True 64-bit emulator"}; + {8,4} -> + {comment, "Halfword 64-bit emulator"}; + Other -> + exit({unexpected_wordsizes,Other}) + end. diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl new file mode 100644 index 0000000000..7bc91addde --- /dev/null +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -0,0 +1,614 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. 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% +%% + +%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% Define to run outside of test server +%%% +%%% -define(STANDALONE,1). +%%% +%%% +%%% Define for debug output +%%% +%%% -define(debug,1). + +-module(trace_call_time_SUITE). + +%% Exported end user tests + +-export([seq/3, seq_r/3]). +-export([loaded/1, a_function/1, a_called_function/1, dec/1, nif_dec/1]). + +-define(US_ERROR, 10000). +-define(R_ERROR, 0.8). +-define(SINGLE_CALL_US_TIME, 10). + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Result examination macros + +-define(CT(P,MFA),{trace,P,call,MFA}). +-define(CTT(P, MFA),{trace_ts,P,call,MFA,{_,_,_}}). +-define(RF(P,MFA,V),{trace,P,return_from,MFA,V}). +-define(RFT(P,MFA,V),{trace_ts,P,return_from,MFA,V,{_,_,_}}). +-define(RT(P,MFA),{trace,P,return_to,MFA}). +-define(RTT(P,MFA),{trace_ts,P,return_to,MFA,{_,_,_}}). + +-ifdef(debug). +-define(dbgformat(A,B),io:format(A,B)). +-else. +-define(dbgformat(A,B),noop). +-endif. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-include("test_server.hrl"). + +%% When run in test server. +-export([all/1, init_per_testcase/2, fin_per_testcase/2, not_run/1]). +-export([basic/1, on_and_off/1, info/1, + pause_and_restart/1, scheduling/1, called_function/1, combo/1, bif/1, nif/1]). + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(test_server:seconds(400)), + erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time,call_count]), + erlang:trace_pattern(on_load, false, [local,meta,call_time,call_count]), + timer:now_diff(now(),now()), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time,call_count]), + erlang:trace_pattern(on_load, false, [local,meta,call_time,call_count]), + erlang:trace(all, false, [all]), + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +all(doc) -> + ["Test call count tracing of local function calls."]; +all(suite) -> + case test_server:is_native(?MODULE) of + true -> [not_run]; + false -> [basic, on_and_off, info, + pause_and_restart, scheduling, combo, bif, nif, called_function] + end. + +not_run(Config) when is_list(Config) -> + {skipped,"Native code"}. + +basic(suite) -> + []; +basic(doc) -> + ["Tests basic call count trace"]; +basic(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 1000, + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq, '_'}, true, [call_time]), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]), + ?line Pid = setup(), + ?line {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> (X+1) end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + ?line ok = check_trace_info({?MODULE, seq_r, 3}, [], none), + + ?line {Lr, T2} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> (X+1) end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Pid, 1, 0, 0}], T2/M), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid, M, 0, 0}], T2), + ?line L = lists:reverse(Lr), + + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line Pid ! quit, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +on_and_off(suite) -> + []; +on_and_off(doc) -> + ["Tests turning trace parameters on and off"]; +on_and_off(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 100, + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]), + ?line Pid = setup(), + ?line {L, T1} = execute(Pid, {?MODULE, seq, [1, M, fun(X) -> X+1 end]}), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + + ?line N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_time]), + ?line {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T2), + + ?line P = erlang:trace_pattern({'_','_','_'}, true, [call_time]), + ?line {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T3), + + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]), + ?line ok = check_trace_info({?MODULE, seq, 3}, false, none), + ?line {L, _T4} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, false, none), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, [], none), + ?line {Lr, T5} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid,M,0,0}], T5), + + ?line N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_time]), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, false, none), + ?line {Lr, _T6} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, false, none), + ?line L = lists:reverse(Lr), + %% + ?line Pid ! quit, + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +info(suite) -> + []; +info(doc) -> + ["Tests the trace_info BIF"]; +info(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_time]), + ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]), + ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + ?line {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all), + ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, L), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]), + ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]), + ?line {call_time,false} = erlang:trace_info({?MODULE,seq,3}, call_time), + ?line {all,false} = erlang:trace_info({?MODULE,seq,3}, all), + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +pause_and_restart(suite) -> + []; +pause_and_restart(doc) -> + ["Tests pausing and restarting call time counters"]; +pause_and_restart(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 100, + ?line Pid = setup(), + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]), + ?line ok = check_trace_info({?MODULE, seq, 3}, [], none), + ?line {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1), + ?line {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T2), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]), + ?line ok = check_trace_info({?MODULE, seq, 3}, [], none), + ?line {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T3), + %% + ?line Pid ! quit, + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +scheduling(suite) -> + []; +scheduling(doc) -> + ["Tests in/out scheduling of call time counters"]; +scheduling(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 1000000, + ?line Np = erlang:system_info(schedulers_online), + ?line F = 12, + + %% setup load processes + %% (single, no internal calls) + + ?line erlang:trace_pattern({?MODULE,loaded,1}, true, [call_time]), + + ?line Pids = [setup() || _ <- lists:seq(1, F*Np)], + ?line {_Ls,T1} = execute(Pids, {?MODULE,loaded,[M]}), + ?line [Pid ! quit || Pid <- Pids], + + %% logic dictates that each process will get ~ 1/F of the schedulers time + + ?line {call_time, CT} = erlang:trace_info({?MODULE,loaded,1}, call_time), + + ?line lists:foreach(fun (Pid) -> + ?line ok = case check_process_time(lists:keysearch(Pid, 1, CT), M, F, T1) of + schedule_time_error -> + test_server:comment("Warning: Failed time ratio"), + ok; + Other -> Other + end + end, Pids), + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +combo(suite) -> + []; +combo(doc) -> + ["Tests combining local call trace and meta trace with call time trace"]; +combo(Config) when is_list(Config) -> + ?line Self = self(), + ?line Nbc = 3, + ?line MetaMs = [{'_',[],[{return_trace}]}], + ?line Flags = lists:sort([call, return_to]), + ?line LocalTracer = spawn_link(fun () -> relay_n(5 + Nbc + 3, Self) end), + ?line MetaTracer = spawn_link(fun () -> relay_n(9 + Nbc + 3, Self) end), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, MetaMs, [{meta,MetaTracer}]), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]), + + % bifs + ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, [], [local]), + ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), + ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, MetaMs, [{meta,MetaTracer}]), + %% not implemented + %?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_count]), + + ?line 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]), + %% + ?line {traced,local} = + erlang:trace_info({?MODULE,seq_r,3}, traced), + ?line {match_spec,[]} = + erlang:trace_info({?MODULE,seq_r,3}, match_spec), + ?line {meta,MetaTracer} = + erlang:trace_info({?MODULE,seq_r,3}, meta), + ?line {meta_match_spec,MetaMs} = + erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec), + ?line ok = check_trace_info({?MODULE, seq_r, 3}, [], none), + + %% check empty trace_info for ?MODULE:seq_r/3 + ?line {all,[_|_]=TraceInfo} = erlang:trace_info({?MODULE,seq_r,3}, all), + ?line {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo), + ?line {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfo), + ?line {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo), + ?line {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfo), + ?line {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfo), + ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfo), + + %% check empty trace_info for erlang:term_to_binary/1 + ?line {all, [_|_] = TraceInfoBif} = erlang:trace_info({erlang, term_to_binary, 1}, all), + ?line {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfoBif), + ?line {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfoBif), + ?line {value,{meta, MetaTracer}} = lists:keysearch(meta, 1, TraceInfoBif), + ?line {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfoBif), + %% not implemented + ?line {value,{call_count,false}} = lists:keysearch(call_count, 1, TraceInfoBif), + %?line {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfoBif), + ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfoBif), + + %% + ?line [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), + ?line T0 = now(), + ?line with_bif(Nbc), + ?line T1 = now(), + ?line TimeB = timer:now_diff(T1,T0), + %% + + ?line List = collect(100), + ?line {MetaR, LocalR} = + lists:foldl( + fun ({P,X}, {M,L}) when P == MetaTracer -> + {[X|M],L}; + ({P,X}, {M,L}) when P == LocalTracer -> + {M,[X|L]} + end, + {[],[]}, + List), + ?line Meta = lists:reverse(MetaR), + ?line Local = lists:reverse(LocalR), + + ?line [?CTT(Self,{?MODULE,seq_r,[1,3,_]}), + ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}), + ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), + ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,3},[3,2,1]), + ?CTT(Self,{erlang,term_to_binary,[3]}), % bif + ?RFT(Self,{erlang,term_to_binary,1},<<131,97,3>>), + ?CTT(Self,{erlang,term_to_binary,[2]}), + ?RFT(Self,{erlang,term_to_binary,1},<<131,97,2>>) + ] = Meta, + + ?line [?CT(Self,{?MODULE,seq_r,[1,3,_]}), + ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}), + ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), + ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), + ?RT(Self,{?MODULE,combo,1}), + ?CT(Self,{erlang,term_to_binary,[3]}), % bif + ?RT(Self,{?MODULE,with_bif,1}), + ?CT(Self,{erlang,term_to_binary,[2]}), + ?RT(Self,{?MODULE,with_bif,1}) + ] = Local, + + ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1), + ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1), + ?line ok = check_trace_info({erlang, term_to_binary, 1}, [{self(), Nbc - 1, 0, 0}], TimeB), + %% + ?line erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time]), + ?line erlang:trace_pattern(on_load, false, [local,meta,call_time]), + ?line erlang:trace(all, false, [all]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +bif(suite) -> + []; +bif(doc) -> + ["Tests tracing of bifs"]; +bif(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 1000000, + %% + ?line 2 = erlang:trace_pattern({erlang, binary_to_term, '_'}, true, [call_time]), + ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), + ?line Pid = setup(), + ?line {L, T1} = execute(Pid, fun() -> with_bif(M) end), + + ?line ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M - 1, 0, 0}], T1/2), + ?line ok = check_trace_info({erlang, term_to_binary, 1}, [{Pid, M - 1, 0, 0}], T1/2), + + % disable term2binary + + ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, false, [call_time]), + + ?line {L, T2} = execute(Pid, fun() -> with_bif(M) end), + + ?line ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M*2 - 2, 0, 0}], T1/2 + T2), + ?line ok = check_trace_info({erlang, term_to_binary, 1}, false, none), + + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line Pid ! quit, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +nif(suite) -> + []; +nif(doc) -> + ["Tests tracing of nifs"]; +nif(Config) when is_list(Config) -> + load_nif(Config), + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 1000000, + %% + ?line 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]), + ?line 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]), + ?line Pid = setup(), + ?line {L, T1} = execute(Pid, fun() -> with_nif(M) end), + + % the nif is called M - 1 times, the last time the function with 'with_nif' + % returns ok and does not call the nif. + ?line ok = check_trace_info({?MODULE, nif_dec, 1}, [{Pid, M-1, 0, 0}], T1/5*4), + ?line ok = check_trace_info({?MODULE, with_nif, 1}, [{Pid, M, 0, 0}], T1/5), + + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line Pid ! quit, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +called_function(suite) -> + []; +called_function(doc) -> + ["Tests combining nested function calls and that the time accumulates to the right function"]; +called_function(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 2100, + ?line Pid = setup(), + %% + ?line 1 = erlang:trace_pattern({?MODULE,a_function,'_'}, true, [call_time]), + ?line {L, T1} = execute(Pid, {?MODULE, a_function, [M]}), + ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M, 0, 0}], T1), + + ?line 1 = erlang:trace_pattern({?MODULE,a_called_function,'_'}, true, [call_time]), + ?line {L, T2} = execute(Pid, {?MODULE, a_function, [M]}), + ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M, 0, 0}], T1 + M*?SINGLE_CALL_US_TIME), + ?line ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M, 0, 0}], T2), + + + ?line 1 = erlang:trace_pattern({?MODULE,dec,'_'}, true, [call_time]), + ?line {L, T3} = execute(Pid, {?MODULE, a_function, [M]}), + ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M+M, 0, 0}], T1 + (M+M)*?SINGLE_CALL_US_TIME), + ?line ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M+M, 0, 0}], T2 + M*?SINGLE_CALL_US_TIME ), + ?line ok = check_trace_info({?MODULE, dec, 1}, [{Pid, M, 0, 0}], T3), + + ?line Pid ! quit, + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ok. + +%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% The Tests +%%% + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Local helpers + + +load_nif(Config) -> + ?line Path = ?config(data_dir, Config), + ?line ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). + + +%% Stack recursive seq +seq(Stop, Stop, Succ) when is_function(Succ) -> + [Stop]; +seq(Start, Stop, Succ) when is_function(Succ) -> + [Start | seq(Succ(Start), Stop, Succ)]. + + +a_function(1) -> a_called_function(1); +a_function(N) when N > 1 -> a_function(a_called_function(N)). + +a_called_function(N) -> dec(N). + +with_bif(1) -> ok; +with_bif(N) -> + with_bif(erlang:binary_to_term(erlang:term_to_binary(N)) - 1). + +with_nif(0) -> error; +with_nif(1) -> ok; +with_nif(N) -> + with_nif(?MODULE:nif_dec(N)). + + +nif_dec(N) -> 0. + +dec(N) -> + loaded(10000), + N - 1. + +loaded(N) when N > 1 -> loaded(N - 1); +loaded(_) -> 5. + + +%% Tail recursive seq, result list is reversed +seq_r(Start, Stop, Succ) when is_function(Succ) -> + seq_r(Start, Stop, Succ, []). + +seq_r(Stop, Stop, _, R) -> + [Stop | R]; +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 -> + ok; + {call_time,[{Pid,C,S,Us}]} -> + 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 + end; +check_trace_info(Mfa, Expect, _) -> + case erlang:trace_info(Mfa, call_time) of + {call_time, Expect} -> + ok; + Other -> + io:format("Expected ~p -> {call_time, ~p}~n - got ~p~n", [Mfa, Expect, Other]), + result_not_expected_error + end. + + +%check process time +check_process_time({value,{Pid, M, S, Us}}, M, F, Time) -> + ?line Sum = S*1000000 + Us, + if + abs(1 - (F/(Time/Sum))) < ?R_ERROR -> + ok; + true -> + io:format("- Pid ~p, Got ratio ~.2f, expected ratio ~w~n", [Pid, Time/Sum,F]), + schedule_time_error + end; +check_process_time(Other, M, _, _) -> + io:format(" - Got ~p, expected count ~w~n", [Other, M]), + error. + + + +%% Message relay process +relay_n(0, _) -> + ok; +relay_n(N, Dest) -> + receive Msg -> + Dest ! {self(), Msg}, + relay_n(N-1, Dest) + end. + + + +%% Collect received messages +collect(Time) -> + Ref = erlang:start_timer(Time, self(), done), + L = lists:reverse(collect([], Ref)), + ?dbgformat("Got: ~p~n",[L]), + L. + +collect(A, 0) -> + receive + Mess -> + collect([Mess | A], 0) + after 0 -> + A + end; +collect(A, Ref) -> + receive + {timeout, Ref, done} -> + collect(A, 0); + Mess -> + collect([Mess | A], Ref) + end. + +setup() -> + Pid = spawn_link(fun() -> loop() end), + ?line 1 = erlang:trace(Pid, true, [call]), + Pid. + +execute(Pids, Mfa) when is_list(Pids) -> + T0 = now(), + [P ! {self(), execute, Mfa} || P <- Pids], + As = [receive {P, answer, Answer} -> Answer end || P <- Pids], + T1 = now(), + {As, timer:now_diff(T1,T0)}; +execute(P, Mfa) -> + T0 = now(), + P ! {self(), execute, Mfa}, + A = receive {P, answer, Answer} -> Answer end, + T1 = now(), + {A, timer:now_diff(T1,T0)}. + + + +loop() -> + receive + quit -> + ok; + {Pid, execute, Fun } when is_function(Fun) -> + Pid ! {self(), answer, erlang:apply(Fun, [])}, + loop(); + {Pid, execute, {M, F, A}} -> + Pid ! {self(), answer, erlang:apply(M, F, A)}, + loop() + end. diff --git a/erts/emulator/test/trace_call_time_SUITE_data/Makefile.src b/erts/emulator/test/trace_call_time_SUITE_data/Makefile.src new file mode 100644 index 0000000000..2b2a35bd2c --- /dev/null +++ b/erts/emulator/test/trace_call_time_SUITE_data/Makefile.src @@ -0,0 +1,6 @@ + +NIF_LIBS = trace_nif@dll@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ diff --git a/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c b/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c new file mode 100644 index 0000000000..33b346aab7 --- /dev/null +++ b/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c @@ -0,0 +1,37 @@ +#include "erl_nif.h" + + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ +} + +static ERL_NIF_TERM nif_dec_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int x = 0; + enif_get_uint(env, argv[0], &x); + return enif_make_int(env, x - 1); +} + + + +static ErlNifFunc nif_funcs[] = +{ + {"nif_dec", 1, nif_dec_1} +}; + +ERL_NIF_INIT(trace_call_time_SUITE,nif_funcs,load,reload,upgrade,unload) |