diff options
Diffstat (limited to 'erts/emulator/test')
243 files changed, 42204 insertions, 25422 deletions
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 0b0568c31a..bf00de2204 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2012. All Rights Reserved. +# Copyright Ericsson AB 1997-2017. 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/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# 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. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -31,6 +32,7 @@ MODULES= \ a_SUITE \ after_SUITE \ alloc_SUITE \ + async_ports_SUITE \ beam_SUITE \ beam_literals_SUITE \ bif_SUITE \ @@ -51,8 +53,11 @@ MODULES= \ crypto_SUITE \ ddll_SUITE \ decode_packet_SUITE \ + dirty_bif_SUITE \ + dirty_nif_SUITE \ distribution_SUITE \ driver_SUITE \ + dump_SUITE \ efile_SUITE \ erts_debug_SUITE \ estone_SUITE \ @@ -62,24 +67,31 @@ MODULES= \ exception_SUITE \ float_SUITE \ fun_SUITE \ - fun_r13_SUITE \ gc_SUITE \ guard_SUITE \ hash_SUITE \ hibernate_SUITE \ + hipe_SUITE \ + iovec_SUITE \ list_bif_SUITE \ + lttng_SUITE \ + lcnt_SUITE \ map_SUITE \ match_spec_SUITE \ module_info_SUITE \ monitor_SUITE \ + multi_load_SUITE \ nested_SUITE \ nif_SUITE \ node_container_SUITE \ nofrag_SUITE \ num_bif_SUITE \ + message_queue_data_SUITE \ op_SUITE \ + os_signal_SUITE \ port_SUITE \ port_bif_SUITE \ + prim_eval_SUITE \ process_SUITE \ pseudoknot_SUITE \ receive_SUITE \ @@ -105,10 +117,12 @@ MODULES= \ trace_meta_SUITE \ trace_call_count_SUITE \ trace_call_time_SUITE \ + tracer_SUITE \ + tracer_test \ scheduler_SUITE \ - old_scheduler_SUITE \ + port_trace_SUITE \ + unique_SUITE \ z_SUITE \ - old_mod \ long_timers_test \ ignore_cores \ dgawd_handler \ @@ -123,7 +137,8 @@ NO_OPT= bs_bincomp \ bs_match_tail \ bs_match_misc \ bs_utf \ - guard + guard \ + map NATIVE= hibernate @@ -142,7 +157,8 @@ EMAKEFILE=Emakefile TEST_SPEC_FILES= emulator.spec \ emulator.spec.win \ emulator_bench.spec \ - emulator_smoke.spec + emulator_smoke.spec \ + emulator_node_container_SUITE.spec # ---------------------------------------------------- # Release directory specification @@ -153,7 +169,7 @@ RELSYSDIR = $(RELEASE_PATH)/emulator_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += # ---------------------------------------------------- # Targets diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl index 195c9c0a5f..5b04a15b85 100644 --- a/erts/emulator/test/a_SUITE.erl +++ b/erts/emulator/test/a_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -26,94 +27,77 @@ %%%------------------------------------------------------------------- -module(a_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, long_timers/1, pollset_size/1]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1, + leaked_processes/1, long_timers/1, pollset_size/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. -all() -> - [long_timers, pollset_size]. +all() -> + [leaked_processes, long_timers, pollset_size]. -groups() -> - []. +%% Start some system servers now to avoid having them +%% reported as leaks. -init_per_suite(Config) -> - Config. +init_per_suite(Config) when is_list(Config) -> + %% Ensure inet_gethost_native port program started, in order to + %% allow other suites to use it... + inet_gethost_native:gethostbyname("localhost"), -end_per_suite(_Config) -> - ok. + %% Start the timer server. + timer:start(), -init_per_group(_GroupName, Config) -> Config. -end_per_group(_GroupName, Config) -> +end_per_suite(Config) when is_list(Config) -> Config. +leaked_processes(Config) when is_list(Config) -> + Parent = self(), + Go = make_ref(), + spawn(fun () -> + Name = leaked_processes__process_holder, + true = register(Name, self()), + Ps = processes(), + Parent ! Go, + receive + {get_initial_processes, Pid} -> + Pid ! {initial_processes, Ps} + end + end), + receive Go -> ok end, + {comment, "Testcase started! This test will run in parallel with the " + "erts testsuite and ends in the z_SUITE:leaked_processes/1 testcase."}. -long_timers(doc) -> - []; -long_timers(suite) -> - []; long_timers(Config) when is_list(Config) -> - Dir = ?config(data_dir, Config), - ?line long_timers_test:start(Dir), - ?line {comment, - "Testcase started! This test will run in parallel with the " - "erts testsuite and ends in the z_SUITE:long_timers testcase."}. + Dir = proplists:get_value(data_dir, Config), + long_timers_test:start(Dir), + {comment, "Testcase started! This test will run in parallel with the " + "erts testsuite and ends in the z_SUITE:long_timers/1 testcase."}. -pollset_size(doc) -> - []; -pollset_size(suite) -> - []; pollset_size(Config) when is_list(Config) -> - %% Ensure inet_gethost_native port program started, in order to - %% allow other suites to use it... - inet_gethost_native:gethostbyname("localhost"), - ?line Parent = self(), - ?line Go = make_ref(), - ?line spawn(fun () -> - Name = pollset_size_testcase_initial_state_holder, - true = register(Name, self()), - ChkIo = get_check_io_info(), - io:format("Initial: ~p~n", [ChkIo]), - Parent ! Go, - receive - {get_initial_check_io_result, Pid} -> - Pid ! {initial_check_io_result, ChkIo} - end - end), - ?line receive Go -> ok end, - ?line {comment, - "Testcase started! This test will run in parallel with the " - "erts testsuite and ends in the z_SUITE:pollset_size testcase."}. + Parent = self(), + Go = make_ref(), + spawn(fun () -> + Name = pollset_size_testcase_initial_state_holder, + true = register(Name, self()), + ChkIo = get_check_io_info(), + io:format("Initial: ~p~n", [ChkIo]), + Parent ! Go, + receive + {get_initial_check_io_result, Pid} -> + Pid ! {initial_check_io_result, ChkIo} + end + end), + receive Go -> ok end, + {comment, "Testcase started! This test will run in parallel with the " + "erts testsuite and ends in the z_SUITE:pollset_size/1 testcase."}. %% %% Internal functions... %% -display_check_io(ChkIo) -> - catch erlang:display('--- CHECK IO INFO ---'), - catch erlang:display(ChkIo), - catch erts_debug:set_internal_state(available_internal_state, true), - NoOfErrorFds = (catch erts_debug:get_internal_state(check_io_debug)), - catch erlang:display({'NoOfErrorFds', NoOfErrorFds}), - catch erts_debug:set_internal_state(available_internal_state, false), - catch erlang:display('--- CHECK IO INFO ---'), - ok. - get_check_io_info() -> - ChkIo = erlang:system_info(check_io), - case lists:keysearch(pending_updates, 1, ChkIo) of - {value, {pending_updates, 0}} -> - display_check_io(ChkIo), - ChkIo; - false -> - ChkIo; - _ -> - receive after 10 -> ok end, - get_check_io_info() - end. - - + z_SUITE:get_check_io_info(). diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl index 7cc329cc69..8a34195e8d 100644 --- a/erts/emulator/test/after_SUITE.erl +++ b/erts/emulator/test/after_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,98 +22,68 @@ %% Tests receive after. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, t_after/1, receive_after/1, receive_after_big/1, receive_after_errors/1, receive_var_zero/1, receive_zero/1, - multi_timeout/1, receive_after_32bit/1]). - --export([init_per_testcase/2, end_per_testcase/2]). + multi_timeout/1, receive_after_32bit/1, + receive_after_blast/1]). %% Internal exports. -export([timeout_g/0]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [t_after, receive_after, receive_after_big, receive_after_errors, receive_var_zero, receive_zero, - multi_timeout, receive_after_32bit]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). + multi_timeout, receive_after_32bit, receive_after_blast]. %% Tests for an old round-off error in 'receive after'." t_after(Config) when is_list(Config) -> - ?line spawn(fun frequent_process/0), - ?line Period = test_server:minutes(1), - ?line Before = erlang:now(), + Frequent = spawn_link(fun frequent_process/0), + Period = test_server:minutes(1), + Before = erlang:monotonic_time(), receive - after Period -> - ?line After = erlang:now(), - ?line report(Period, Before, After) - end. - + after Period -> + After = erlang:monotonic_time(), + unlink(Frequent), + exit(Frequent, die), + report(Period, Before, After) + end. report(Period, Before, After) -> - ?line Elapsed = (element(1, After)*1000000000 - +element(2, After)*1000 - +element(3, After) div 1000) - - (element(1,Before)*1000000000 - + element(2,Before)*1000 + element(3,Before) div 1000), - ?line case Elapsed*100 / Period of - Percent when Percent > 100.10 -> - ?line test_server:fail({too_inaccurate, Percent}); - Percent when Percent < 100.0 -> - ?line test_server:fail({too_early, Percent}); - Percent -> - ?line Comment = io_lib:format("Elapsed/expected: ~.2f %", - [Percent]), - {comment, lists:flatten(Comment)} - end. + case erlang:convert_time_unit(After - Before, native, 100*1000) / Period of + Percent when Percent > 100.10 -> + ct:fail({too_inaccurate, Percent}); + Percent when Percent < 100.0 -> + ct:fail({too_early, Percent}); + Percent -> + Comment = io_lib:format("Elapsed/expected: ~.2f %", [Percent]), + {comment, lists:flatten(Comment)} + end. frequent_process() -> receive - after 100 -> - ?line frequent_process() - end. + after 100 -> + frequent_process() + end. -receive_after(doc) -> - "Test that 'receive after' works (doesn't hang). " - "The test takes 10 seconds to complete."; +%% Test that 'receive after' works (doesn't hang). +%% The test takes 10 seconds to complete. receive_after(Config) when is_list(Config) -> - ?line receive_after1(5000). + receive_after1(5000). receive_after1(1) -> - ?line io:format("Testing: receive after ~p~n", [1]), - ?line receive after 1 -> ok end; + io:format("Testing: receive after ~p~n", [1]), + receive after 1 -> ok end; receive_after1(N) -> - ?line io:format("Testing: receive after ~p~n", [N]), - ?line receive after N -> receive_after1(N div 2) end. + io:format("Testing: receive after ~p~n", [N]), + receive after N -> receive_after1(N div 2) end. receive_after_big(Config) when is_list(Config) -> %% Test that 'receive after' with a 32 bit number works. @@ -124,14 +95,14 @@ receive_after_big1(Timeout) -> erlang:yield(), spawn(fun() -> Self ! here_is_a_message end), ok = receive - here_is_a_message -> - ok - after Timeout -> - %% We test that the timeout can be set, - %% not that an timeout occurs after the appropriate delay - %% (48 days, 56 minutes, 48 seconds)! - timeout - end. + here_is_a_message -> + ok + after Timeout -> + %% We test that the timeout can be set, + %% not that an timeout occurs after the appropriate delay + %% (48 days, 56 minutes, 48 seconds)! + timeout + end. receive_after_big2() -> Self = self(), @@ -152,38 +123,38 @@ receive_after_big2() -> %% Test error cases for 'receive after'. receive_after_errors(Config) when is_list(Config) -> - ?line ?TryAfter(-1), - ?line ?TryAfter(0.0), - ?line ?TryAfter(3.14), - ?line ?TryAfter(16#100000000), - ?line ?TryAfter(392347129847294724972398472984729847129874), - ?line ?TryAfter(16#3fffffffffffffff), - ?line ?TryAfter(16#ffffffffffffffff), - ?line ?TryAfter(-16#100000000), - ?line ?TryAfter(-3891278094774921784123987129848), - ?line ?TryAfter(xxx), + ?TryAfter(-1), + ?TryAfter(0.0), + ?TryAfter(3.14), + ?TryAfter(16#100000000), + ?TryAfter(392347129847294724972398472984729847129874), + ?TryAfter(16#3fffffffffffffff), + ?TryAfter(16#ffffffffffffffff), + ?TryAfter(-16#100000000), + ?TryAfter(-3891278094774921784123987129848), + ?TryAfter(xxx), ok. try_after(Timeout) -> {'EXIT',{timeout_value,_}} = (catch receive after Timeout -> ok end). -receive_var_zero(doc) -> "Test 'after Z', when Z == 0."; +%% Test 'after Z', when Z == 0. receive_var_zero(Config) when is_list(Config) -> self() ! x, self() ! y, Z = zero(), timeout = receive - z -> ok - after Z -> timeout - end, + z -> ok + after Z -> timeout + end, timeout = receive - after Z -> timeout - end, + after Z -> timeout + end, self() ! w, receive x -> ok; Other -> - ?line ?t:fail({bad_message,Other}) + ct:fail({bad_message,Other}) end. zero() -> 0. @@ -193,44 +164,43 @@ receive_zero(Config) when is_list(Config) -> self() ! x, self() ! y, timeout = receive - z -> ok - after 0 -> - timeout - end, + z -> ok + after 0 -> + timeout + end, self() ! w, timeout = receive after 0 -> timeout end, receive - x -> ok; - Other -> - ?line ?t:fail({bad_message,Other}) + x -> ok; + Other -> + ct:fail({bad_message,Other}) end. -multi_timeout(doc) -> - "Test for catching invalid assertion in erl_message.c (in queue_message)." - "This failed (dumped core) with debug-compiled emulator."; +%% Test for catching invalid assertion in erl_message.c (in queue_message) +%% This failed (dumped core) with debug-compiled emulator. multi_timeout(Config) when is_list(Config) -> - ?line P = spawn(?MODULE, timeout_g, []), - ?line P ! a, - ?line P ! b, - ?line receive - after 1000 -> ok - end, - ?line P ! c, - ?line receive - after 1000 -> ok - end, - ?line P ! d, + P = spawn(?MODULE, timeout_g, []), + P ! a, + P ! b, + receive + after 1000 -> ok + end, + P ! c, + receive + after 1000 -> ok + end, + P ! d, ok. timeout_g() -> - ?line receive - a -> ok + receive + a -> ok + end, + receive + after 100000 -> ok end, - ?line receive - after 100000 -> ok - end, ok. %% OTP-7493: Timeout for 32 bit numbers (such as 16#ffffFFFF) could @@ -251,4 +221,26 @@ recv_after_32bit(I, T) when I rem 2 =:= 0 -> receive after T -> exit(timeout) end; recv_after_32bit(_, _) -> receive after 16#ffffFFFF -> exit(timeout) end. - + +blaster() -> + receive + {go, TimeoutTime} -> + Tmo = TimeoutTime - erlang:monotonic_time(millisecond), + receive after Tmo -> ok end + end. + +spawn_blasters(0) -> + []; +spawn_blasters(N) -> + [spawn_monitor(fun () -> blaster() end)|spawn_blasters(N-1)]. + +receive_after_blast(Config) when is_list(Config) -> + PMs = spawn_blasters(10000), + TimeoutTime = erlang:monotonic_time(millisecond) + 5000, + lists:foreach(fun ({P, _}) -> P ! {go, TimeoutTime} end, PMs), + lists:foreach(fun ({P, M}) -> + receive + {'DOWN', M, process, P, normal} -> + ok + end + end, PMs). diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 35c44c229a..5e5cd6f578 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -1,25 +1,25 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% -module(alloc_SUITE). -author('[email protected]'). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). -export([basic/1, coalesce/1, @@ -30,44 +30,23 @@ rbtree/1, mseg_clear_cache/1, erts_mmap/1, - cpool/1]). - --export([init_per_testcase/2, end_per_testcase/2]). - --include_lib("test_server/include/test_server.hrl"). + cpool/1, + migration/1]). --define(DEFAULT_TIMETRAP_SECS, 240). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [basic, coalesce, threads, realloc_copy, bucket_index, - bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - + bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool, migration]. init_per_testcase(Case, Config) when is_list(Config) -> - Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), - [{watchdog, Dog},{testcase, Case}|Config]. + [{testcase, Case},{debug,false}|Config]. end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -75,56 +54,47 @@ end_per_testcase(_Case, Config) when is_list(Config) -> %% Testcases %% %% %% -basic(suite) -> []; -basic(doc) -> []; -basic(Cfg) -> ?line drv_case(Cfg). - -coalesce(suite) -> []; -coalesce(doc) -> []; -coalesce(Cfg) -> ?line drv_case(Cfg). - -threads(suite) -> []; -threads(doc) -> []; -threads(Cfg) -> ?line drv_case(Cfg). - -realloc_copy(suite) -> []; -realloc_copy(doc) -> []; -realloc_copy(Cfg) -> ?line drv_case(Cfg). - -bucket_index(suite) -> []; -bucket_index(doc) -> []; -bucket_index(Cfg) -> ?line drv_case(Cfg). - -bucket_mask(suite) -> []; -bucket_mask(doc) -> []; -bucket_mask(Cfg) -> ?line drv_case(Cfg). - -rbtree(suite) -> []; -rbtree(doc) -> []; -rbtree(Cfg) -> ?line drv_case(Cfg). - -mseg_clear_cache(suite) -> []; -mseg_clear_cache(doc) -> []; -mseg_clear_cache(Cfg) -> ?line drv_case(Cfg). +basic(Cfg) -> drv_case(Cfg). +coalesce(Cfg) -> drv_case(Cfg). +threads(Cfg) -> drv_case(Cfg). +realloc_copy(Cfg) -> drv_case(Cfg). +bucket_index(Cfg) -> drv_case(Cfg). +bucket_mask(Cfg) -> drv_case(Cfg). +rbtree(Cfg) -> drv_case(Cfg). +mseg_clear_cache(Cfg) -> drv_case(Cfg). +cpool(Cfg) -> drv_case(Cfg). -cpool(suite) -> []; -cpool(doc) -> []; -cpool(Cfg) -> ?line drv_case(Cfg). +migration(Cfg) -> + drv_case(Cfg, concurrent, "+MZe true"). erts_mmap(Config) when is_list(Config) -> - case {?t:os_type(), is_halfword_vm()} of - {{unix, _}, false} -> + case {os:type(), mmsc_flags()} of + {{unix,_}, false} -> [erts_mmap_do(Config, SCO, SCRPM, SCRFSD) || SCO <-[true,false], SCRFSD <-[1234,0], SCRPM <- [true,false]]; - - {_,true} -> - {skipped, "No supercarrier support on halfword vm"}; - {SkipOs,_} -> - ?line {skipped, + {{unix,_}, Flags} -> + {skipped, Flags}; + {{SkipOs,_},_} -> + {skipped, lists:flatten(["Not run on " | io_lib:format("~p",[SkipOs])])} end. +%% Check if there are ERL_FLAGS set that will mess up this test case +mmsc_flags() -> + case mmsc_flags("ERL_FLAGS") of + false -> mmsc_flags("ERL_ZFLAGS"); + Flags -> Flags + end. +mmsc_flags(Env) -> + case os:getenv(Env) of + false -> false; + V -> + case string:find(V, "+MMsc") of + nomatch -> false; + SubStr -> Env ++ "=" ++ SubStr + end + end. erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> %% We use the number of schedulers + 1 * approx main carriers size @@ -143,25 +113,26 @@ erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> {ok, Node} = start_node(Config, Opts), Self = self(), Ref = make_ref(), - F = fun () -> - SI = erlang:system_info({allocator,mseg_alloc}), - {erts_mmap,EM} = lists:keyfind(erts_mmap, 1, SI), - {supercarrier,SC} = lists:keyfind(supercarrier, 1, EM), - {sizes,Sizes} = lists:keyfind(sizes, 1, SC), - {free_segs,Segs} = lists:keyfind(free_segs,1,SC), - {total,Total} = lists:keyfind(total,1,Sizes), - Total = SCS*1024*1024, - - {reserved,Reserved} = lists:keyfind(reserved,1,Segs), - true = (Reserved >= SCRFSD), - - case {SCO,lists:keyfind(os,1,EM)} of - {true, false} -> ok; - {false, {os,_}} -> ok - end, - - Self ! {Ref, ok} - end, + F = fun() -> + SI = erlang:system_info({allocator,erts_mmap}), + {default_mmap,EM} = lists:keyfind(default_mmap, 1, SI), + {supercarrier,SC} = lists:keyfind(supercarrier, 1, EM), + {sizes,Sizes} = lists:keyfind(sizes, 1, SC), + {free_segs,Segs} = lists:keyfind(free_segs,1,SC), + {total,Total} = lists:keyfind(total,1,Sizes), + io:format("Expecting total ~w, got ~w~n", [SCS*1024*1024,Total]), + Total = SCS*1024*1024, + + {reserved,Reserved} = lists:keyfind(reserved,1,Segs), + true = (Reserved >= SCRFSD), + + case {SCO,lists:keyfind(os,1,EM)} of + {true, false} -> ok; + {false, {os,_}} -> ok + end, + + Self ! {Ref, ok} + end, spawn_link(Node, F), Result = receive {Ref, Rslt} -> Rslt end, @@ -175,91 +146,224 @@ erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> %% %% drv_case(Config) -> - drv_case(Config, ""). + drv_case(Config, one_shot, ""). -drv_case(Config, Command) when is_list(Config), - is_list(Command) -> - case ?t:os_type() of +drv_case(Config, Mode, NodeOpts) when is_list(Config) -> + case os:type() of {Family, _} when Family == unix; Family == win32 -> - ?line {ok, Node} = start_node(Config), - ?line Self = self(), - ?line Ref = make_ref(), - ?line spawn_link(Node, + {ok, Node} = start_node(Config, NodeOpts), + Self = self(), + Ref = make_ref(), + spawn_link(Node, fun () -> - Res = run_drv_case(Config, Command), + Res = run_drv_case(Config, Mode), Self ! {Ref, Res} end), - ?line Result = receive {Ref, Rslt} -> Rslt end, - ?line stop_node(Node), - ?line Result; + Result = receive {Ref, Rslt} -> Rslt end, + stop_node(Node), + Result; SkipOs -> - ?line {skipped, + {skipped, lists:flatten(["Not run on " | io_lib:format("~p",[SkipOs])])} end. -run_drv_case(Config, Command) -> - ?line DataDir = ?config(data_dir,Config), - ?line CaseName = ?config(testcase,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() +run_drv_case(Config, Mode) -> + DataDir = proplists:get_value(data_dir,Config), + CaseName = proplists:get_value(testcase,Config), + File = filename:join(DataDir, CaseName), + {ok,CaseName,Bin} = compile:file(File, [binary,return_errors]), + {module,CaseName} = erlang:load_module(CaseName,Bin), + print_stats(CaseName), + ok = CaseName:init(File), + + SlaveState = slave_init(CaseName), + case Mode of + one_shot -> + Result = one_shot(CaseName); + + concurrent -> + Result = concurrent(CaseName) 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 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. - -start_node(Config) -> - start_node(Config, []). + + wait_for_memory_deallocations(), + print_stats(CaseName), + + true = erlang:delete_module(CaseName), + slave_end(SlaveState), + Result. + +slave_init(migration) -> + A0 = case application:start(sasl) of + ok -> [sasl]; + _ -> [] + end, + case application:start(os_mon) of + ok -> [os_mon|A0]; + _ -> A0 + end; +slave_init(_) -> []. + +slave_end(Apps) -> + lists:foreach(fun (A) -> application:stop(A) end, Apps). + +wait_for_memory_deallocations() -> + try + erts_debug:set_internal_state(wait, deallocations) + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_for_memory_deallocations() + end. + +print_stats(migration) -> + {Btot,Ctot} = lists:foldl(fun({instance,Inr,Istats}, {Bacc,Cacc}) -> + {mbcs,MBCS} = lists:keyfind(mbcs, 1, Istats), + Btup = lists:keyfind(blocks, 1, MBCS), + Ctup = lists:keyfind(carriers, 1, MBCS), + io:format("{instance,~p,~p,~p}\n", [Inr, Btup, Ctup]), + {tuple_add(Bacc,Btup),tuple_add(Cacc,Ctup)}; + (_, Acc) -> Acc + end, + {{blocks,0,0,0},{carriers,0,0,0}}, + erlang:system_info({allocator,test_alloc})), + + io:format("Number of blocks : ~p\n", [Btot]), + io:format("Number of carriers: ~p\n", [Ctot]); +print_stats(_) -> ok. + +tuple_add(T1, T2) -> + list_to_tuple(lists:zipwith(fun(E1,E2) when is_number(E1), is_number(E2) -> + E1 + E2; + (A,A) -> + A + end, + tuple_to_list(T1), tuple_to_list(T2))). + + +one_shot(CaseName) -> + State = CaseName:start({1, 0, erlang:system_info(build_type)}), + Result0 = CaseName:run(State), + false = (Result0 =:= continue), + Result1 = handle_result(State, Result0), + CaseName:stop(State), + Result1. + + +many_shot(CaseName, I, Mem) -> + State = CaseName:start({I, Mem, erlang:system_info(build_type)}), + Result1 = repeat_while(fun() -> + Result0 = CaseName:run(State), + handle_result(State, Result0) + end, + 10*1000, I), + CaseName:stop(State), + flush_log(), + Result1. + +concurrent(CaseName) -> + NSched = erlang:system_info(schedulers), + Mem = (free_memory() * 3) div 4, + PRs = lists:map(fun(I) -> spawn_opt(fun() -> + many_shot(CaseName, I, + Mem div NSched) + end, + [monitor, {scheduler,I}]) + end, + lists:seq(1, NSched)), + lists:foreach(fun({Pid,Ref}) -> + receive {'DOWN', Ref, process, Pid, Reason} -> + Reason + end + end, + PRs), + ok. + +repeat_while(Fun, Timeout, I) -> + TRef = erlang:start_timer(Timeout, self(), timeout), + R = repeat_while_loop(Fun, TRef, I), + erlang:cancel_timer(TRef, [{async,true},{info,false}]), + R. + +repeat_while_loop(Fun, TRef, I) -> + receive + {timeout, TRef, timeout} -> + io:format("~p: Timeout, enough is enough.",[I]), + succeeded + after 0 -> + %%io:format("~p calls fun\n", [self()]), + case Fun() of + continue -> repeat_while_loop(Fun, TRef, I); + R -> R + end + end. + +flush_log() -> + receive + {print, Str} -> + io:format("~s", [Str]), + flush_log() + after 0 -> + ok + end. + +handle_result(_State, Result0) -> + flush_log(), + case Result0 of + {'EXIT', Error} -> + ct:fail(Error); + {'EXIT', error, Error} -> + ct:fail(Error); + {failed, Comment} -> + ct:fail(Comment); + {skipped, Comment} -> + {skipped, Comment}; + {succeeded, ""} -> + succeeded; + {succeeded, Comment} -> + {comment, Comment}; + continue -> + continue + end. + start_node(Config, Opts) when is_list(Config), is_list(Opts) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), - ?line ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + case proplists:get_value(debug,Config) of + true -> {ok, node()}; + _ -> start_node_1(Config, Opts) + end. +start_node_1(Config, Opts) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + +stop_node(Node) when Node =:= node() -> ok; stop_node(Node) -> - ?t:stop_node(Node). - -is_halfword_vm() -> - case {erlang:system_info({wordsize, internal}), - erlang:system_info({wordsize, external})} of - {4, 8} -> true; - {WS, WS} -> false + test_server:stop_node(Node). + +free_memory() -> + %% Free memory in MB. + try + SMD = memsup:get_system_memory_data(), + {value, {free_memory, Free}} = lists:keysearch(free_memory, 1, SMD), + TotFree = (Free + + case lists:keysearch(cached_memory, 1, SMD) of + {value, {cached_memory, Cached}} -> Cached; + false -> 0 + end + + case lists:keysearch(buffered_memory, 1, SMD) of + {value, {buffered_memory, Buffed}} -> Buffed; + false -> 0 + end), + TotFree div (1024*1024) + catch + error : undef -> + ct:fail({"os_mon not built"}) end. + diff --git a/erts/emulator/test/alloc_SUITE_data/Makefile.src b/erts/emulator/test/alloc_SUITE_data/Makefile.src index 1d4286e671..e31de54e1b 100644 --- a/erts/emulator/test/alloc_SUITE_data/Makefile.src +++ b/erts/emulator/test/alloc_SUITE_data/Makefile.src @@ -1,13 +1,14 @@ -# ``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. +# ``Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # The Initial Developer of the Original Code is Ericsson Utvecklings AB. # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -24,7 +25,8 @@ TEST_DRVS = basic@dll@ \ bucket_mask@dll@ \ rbtree@dll@ \ mseg_clear_cache@dll@ \ - cpool@dll@ + cpool@dll@ \ + migration@dll@ CC = @CC@ LD = @LD@ diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h index 2d6c5f9dc7..97ee58cdad 100644 --- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h +++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -19,9 +20,20 @@ #ifndef ALLOCATOR_TEST_H__ #define ALLOCATOR_TEST_H__ -typedef ErlDrvUInt Ulong; +#if SIZEOF_VOID_P == SIZEOF_INT +typedef unsigned int Ulong; +#elif SIZEOF_VOID_P == SIZEOF_LONG +typedef unsigned long Ulong; +#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG +typedef unsigned long long Ulong; +#else +# error No pointer sized integer type found ??? +#endif -#ifndef __WIN32__ +#ifdef __WIN32__ +typedef Ulong erts_alc_test_Fn(Ulong, Ulong, Ulong, Ulong); +# define erts_alc_test ((erts_alc_test_Fn*)WinDynNifCallbacks.erts_alc_test) +#else Ulong erts_alc_test(Ulong, Ulong, Ulong, Ulong); #endif @@ -84,6 +96,7 @@ typedef void* erts_cond; #define CPOOL_DELETE(A,B) ((Carrier_t *) ALC_TEST2(0x022, (A), (B))) #define CPOOL_IS_EMPTY(A) ((int) ALC_TEST1(0x023, (A))) #define CPOOL_IS_IN_POOL(A,B) ((int) ALC_TEST2(0x024, (A), (B))) +#define UMEM2BLK_TEST(P) ((Block_t*) ALC_TEST1(0x025, (P))) /* From erl_goodfit_alloc.c */ #define BKT_IX(A, S) ((Ulong) ALC_TEST2(0x100, (A), (S))) @@ -141,5 +154,9 @@ typedef void* erts_cond; #define THR_JOIN(T) ((void) ALC_TEST1(0xf11, (T))) #define THR_EXIT(R) ((void) ALC_TEST1(0xf12, (R))) #define IS_SMP_ENABLED ((int) ALC_TEST0(0xf13)) +#define ALLOC_TEST(S) ((void*) ALC_TEST1(0xf14, (S))) +#define FREE_TEST(P) ((void) ALC_TEST1(0xf15, (P))) +#define SET_TEST_MBC_USER_HEADER(SZ,CMBC,DMBC) ((int)ALC_TEST3(0xf16, (SZ), (CMBC), (DMBC))) +#define GET_TEST_MBC_SIZE() ((int) ALC_TEST0(0xf17)) #endif diff --git a/erts/emulator/test/alloc_SUITE_data/basic.c b/erts/emulator/test/alloc_SUITE_data/basic.c index 0c27665712..debb3d7ebe 100644 --- a/erts/emulator/test/alloc_SUITE_data/basic.c +++ b/erts/emulator/test/alloc_SUITE_data/basic.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -59,3 +60,6 @@ testcase_cleanup(TestCaseState_t *tcs) if (tcs->extra) STOP_ALC((Allctr_t *) tcs->extra); } + +ERL_NIF_INIT(basic, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/basic.erl b/erts/emulator/test/alloc_SUITE_data/basic.erl new file mode 100644 index 0000000000..a018fd5582 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/basic.erl @@ -0,0 +1,10 @@ +-module(basic). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_index.c b/erts/emulator/test/alloc_SUITE_data/bucket_index.c index 32fd16fc10..45cb53fbf7 100644 --- a/erts/emulator/test/alloc_SUITE_data/bucket_index.c +++ b/erts/emulator/test/alloc_SUITE_data/bucket_index.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -112,3 +113,5 @@ test_it(TestCaseState_t *tcs, unsigned sbct) sbct ? sbct_buf : "default"); } +ERL_NIF_INIT(bucket_index, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_index.erl b/erts/emulator/test/alloc_SUITE_data/bucket_index.erl new file mode 100644 index 0000000000..c54f54e2f5 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/bucket_index.erl @@ -0,0 +1,10 @@ +-module(bucket_index). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c index 34979cacf1..c94c265f4e 100644 --- a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c +++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -51,7 +52,7 @@ testcase_run(TestCaseState_t *tcs) typedef struct linked_block { struct linked_block* next; }Linked; - Linked* link; + Linked* link = NULL; Linked* fence_list; Linked* pad_list; void* tmp; @@ -182,3 +183,5 @@ testcase_run(TestCaseState_t *tcs) tcs->extra = NULL; } +ERL_NIF_INIT(bucket_mask, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl b/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl new file mode 100644 index 0000000000..589a50e1fa --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl @@ -0,0 +1,10 @@ +-module(bucket_mask). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.c b/erts/emulator/test/alloc_SUITE_data/coalesce.c index 9da49a0d14..7791409a34 100644 --- a/erts/emulator/test/alloc_SUITE_data/coalesce.c +++ b/erts/emulator/test/alloc_SUITE_data/coalesce.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -316,3 +317,6 @@ testcase_cleanup(TestCaseState_t *tcs) if (tcs->extra) STOP_ALC((Allctr_t *) tcs->extra); } + +ERL_NIF_INIT(coalesce, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.erl b/erts/emulator/test/alloc_SUITE_data/coalesce.erl new file mode 100644 index 0000000000..453c726c4e --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/coalesce.erl @@ -0,0 +1,10 @@ +-module(coalesce). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.c b/erts/emulator/test/alloc_SUITE_data/cpool.c index 276ed7be04..0c41f4d747 100644 --- a/erts/emulator/test/alloc_SUITE_data/cpool.c +++ b/erts/emulator/test/alloc_SUITE_data/cpool.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2013. All Rights Reserved. + * Copyright Ericsson AB 2013-2016. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ @@ -85,13 +86,13 @@ thread_func(void *arg) for (i = 0; i < (TEST_NO_CARRIERS_PER_THREAD+TEST_CARRIERS_OFFSET); i++) { int d; if (i < TEST_NO_CARRIERS_PER_THREAD) { - CPOOL_INSERT(alloc, crr[i]); + (void) CPOOL_INSERT(alloc, crr[i]); if ((i & 0x7) == 0) FATAL_ASSERT(CPOOL_IS_IN_POOL(alloc, crr[i])); } d = i-TEST_CARRIERS_OFFSET; if (d >= 0) { - CPOOL_DELETE(alloc, crr[d]); + (void) CPOOL_DELETE(alloc, crr[d]); if ((d & 0x7) == 0) FATAL_ASSERT(!CPOOL_IS_IN_POOL(alloc, crr[d])); } @@ -128,7 +129,7 @@ testcase_run(TestCaseState_t *tcs) for (c = 0; c < TEST_NO_CARRIERS_PER_THREAD; c++) { Carrier_t *crr = (Carrier_t *) p; p += zcrr_sz; - ZERO_CRR_INIT(alloc, crr); + (void) ZERO_CRR_INIT(alloc, crr); threads[t].crr[c] = crr; } } @@ -155,3 +156,6 @@ testcase_run(TestCaseState_t *tcs) ASSERT(tcs, no_threads == TEST_NO_THREADS); } + +ERL_NIF_INIT(cpool, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.erl b/erts/emulator/test/alloc_SUITE_data/cpool.erl new file mode 100644 index 0000000000..89053471fa --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/cpool.erl @@ -0,0 +1,10 @@ +-module(cpool). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/migration.c b/erts/emulator/test/alloc_SUITE_data/migration.c new file mode 100644 index 0000000000..b9a4de03b3 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/migration.c @@ -0,0 +1,343 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014-2016. 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% + */ + +/* + * Test the carrier migration logic + */ + +#ifndef __WIN32__ +#include <sys/types.h> +#include <unistd.h> +#include <errno.h> +#endif +#include <stdio.h> +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include "testcase_driver.h" +#include "allocator_test.h" + +#define FATAL_ASSERT(A) \ + ((void) ((A) \ + ? 1 \ + : (fatal_assert_failed(#A, \ + (char *) __FILE__, \ + __LINE__), \ + 0))) + +static void +fatal_assert_failed(char* expr, char* file, int line) +{ + fflush(stdout); + fprintf(stderr, "%s:%d: Assertion failed: %s\n", + file, line, expr); + fflush(stderr); + abort(); +} + + +char * +testcase_name(void) +{ + return "migration"; +} + +/* Turns out random_r() is a nonstandard glibc extension. +#define HAVE_RANDOM_R +*/ +#ifdef HAVE_RANDOM_R + +typedef struct { struct random_data rnd; char rndbuf[32]; } MyRandState; + +static void myrand_init(MyRandState* mrs, unsigned int seed) +{ + int res; + memset(&mrs->rnd, 0, sizeof(mrs->rnd)); + res = initstate_r(seed, mrs->rndbuf, sizeof(mrs->rndbuf), &mrs->rnd); + FATAL_ASSERT(res == 0); +} + +static int myrand(MyRandState* mrs) +{ + int32_t x; + int res = random_r(&mrs->rnd, &x); + FATAL_ASSERT(res == 0); + return (int)x; +} + +#else /* !HAVE_RANDOM_R */ + +typedef unsigned int MyRandState; + +static void myrand_init(MyRandState* mrs, unsigned int seed) +{ + *mrs = seed; +} + +static int myrand(MyRandState* mrs) +{ + /* Taken from rand(3) man page. + * Modified to return a full 31-bit value by using low half of *mrs as well. + */ + *mrs = (*mrs) * 1103515245 + 12345; + return (int) (((*mrs >> 16) | (*mrs << 16)) & ~(1 << 31)); +} + +#endif /* !HAVE_RANDOM_R */ + +#define MAX_BLOCK_PER_THR 200 +#define BLOCKS_PER_MBC 10 +#define MAX_ROUNDS 10000 + +typedef struct MyBlock_ { + struct MyBlock_* next; + struct MyBlock_** prevp; +} MyBlock; + +typedef struct { + MyBlock* blockv[MAX_BLOCK_PER_THR]; + MyRandState rand_state; + enum { GROWING, SHRINKING, CLEANUP, DONE } phase; + int nblocks; + int goal_nblocks; + int round; + int nr_of_migrations; + int nr_of_carriers; + int max_blocks_in_mbc; + int block_size; + int max_nblocks; +} MigrationState; + +typedef struct { + ErlNifMutex* mtx; + int nblocks; + MyBlock* first; + MigrationState* employer; +} MyCrrInfo; + + +static int crr_info_offset = -1; +static void (*orig_create_mbc_fn)(Allctr_t *allctr, Carrier_t *carrier); +static void (*orig_destroying_mbc_fn)(Allctr_t *allctr, Carrier_t *carrier); + +static void my_creating_mbc(Allctr_t *allctr, Carrier_t *carrier) +{ + MyCrrInfo* mci = (MyCrrInfo*) ((char*)carrier + crr_info_offset); + if (orig_create_mbc_fn) + orig_create_mbc_fn(allctr, carrier); + + mci->mtx = enif_mutex_create("alloc_SUITE.migration"); + mci->nblocks = 0; + mci->first = NULL; + mci->employer = NULL; +} + +static void my_destroying_mbc(Allctr_t *allctr, Carrier_t *carrier) +{ + MyCrrInfo* mci = (MyCrrInfo*) ((char*)carrier + crr_info_offset); + + FATAL_ASSERT(mci->nblocks == 0); + FATAL_ASSERT(mci->first == NULL); + enif_mutex_destroy(mci->mtx); + + if (orig_destroying_mbc_fn) + orig_destroying_mbc_fn(allctr, carrier); +} + +static int migration_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + void* creating_mbc_arg = (void*)my_creating_mbc; + void* destroying_mbc_arg = (void*)my_destroying_mbc; + + if (testcase_nif_init(env, priv_data, load_info)) + return -1; + + crr_info_offset = SET_TEST_MBC_USER_HEADER(sizeof(MyCrrInfo), + &creating_mbc_arg, + &destroying_mbc_arg); + FATAL_ASSERT(crr_info_offset >= 0); + orig_create_mbc_fn = creating_mbc_arg; + orig_destroying_mbc_fn = destroying_mbc_arg; + + return 0; +} + +static void add_block(MyBlock* p, MigrationState* state) +{ + MyCrrInfo* mci = (MyCrrInfo*)((char*)BLK_TO_MBC(UMEM2BLK_TEST(p)) + crr_info_offset); + + enif_mutex_lock(mci->mtx); + if (++mci->nblocks > state->max_blocks_in_mbc) + state->max_blocks_in_mbc = mci->nblocks; + p->next = mci->first; + p->prevp = &mci->first; + mci->first = p; + if (p->next) + p->next->prevp = &p->next; + if (mci->employer != state) { + if (!mci->employer) { + FATAL_ASSERT(mci->nblocks == 1); + state->nr_of_carriers++; + } + else { + state->nr_of_migrations++; + } + mci->employer = state; + } + enif_mutex_unlock(mci->mtx); +} + +static void remove_block(MyBlock* p) +{ + MyCrrInfo* mci = (MyCrrInfo*)((char*)BLK_TO_MBC(UMEM2BLK_TEST(p)) + crr_info_offset); + + enif_mutex_lock(mci->mtx); + mci->nblocks--; + if (p->next) + p->next->prevp = p->prevp; + *p->prevp = p->next; + enif_mutex_unlock(mci->mtx); +} + +static int rand_int(MigrationState* state, int low, int high) +{ + int x; + FATAL_ASSERT(high >= low); + x = myrand(&state->rand_state); + return low + (x % (high+1-low)); +} + + +static void do_cleanup(TestCaseState_t *tcs, MigrationState* state) +{ + if (state->nblocks == 0) { + state->phase = DONE; + testcase_printf(tcs, "%d: Done %d rounds", tcs->thr_nr, state->round); + testcase_printf(tcs, "%d: Cleanup all blocks", tcs->thr_nr); + testcase_printf(tcs, "%d: Empty carriers detected = %d", tcs->thr_nr, + state->nr_of_carriers); + testcase_printf(tcs, "%d: Migrations detected = %d", tcs->thr_nr, + state->nr_of_migrations); + testcase_printf(tcs, "%d: Max blocks in carrier = %d", tcs->thr_nr, + state->max_blocks_in_mbc); + } + else { + state->nblocks--; + if (state->blockv[state->nblocks]) { + remove_block(state->blockv[state->nblocks]); + FREE_TEST(state->blockv[state->nblocks]); + } + } +} + + +void +testcase_run(TestCaseState_t *tcs) +{ + MigrationState* state = (MigrationState*) tcs->extra; + + if (!tcs->extra) { + if (!IS_SMP_ENABLED) + testcase_skipped(tcs, "No SMP support"); + + tcs->extra = enif_alloc(sizeof(MigrationState)); + state = (MigrationState*) tcs->extra; + memset(state->blockv, 0, sizeof(state->blockv)); + myrand_init(&state->rand_state, tcs->thr_nr); + state->phase = GROWING; + state->nblocks = 0; + state->round = 0; + state->nr_of_migrations = 0; + state->nr_of_carriers = 0; + state->max_blocks_in_mbc = 0; + state->block_size = GET_TEST_MBC_SIZE() / (BLOCKS_PER_MBC+1); + if (MAX_BLOCK_PER_THR * state->block_size < tcs->free_mem) { + state->max_nblocks = MAX_BLOCK_PER_THR; + } else { + state->max_nblocks = tcs->free_mem / state->block_size; + } + state->goal_nblocks = rand_int(state, 1, state->max_nblocks); + } + + switch (state->phase) { + case GROWING: { + MyBlock* p; + FATAL_ASSERT(!state->blockv[state->nblocks]); + p = ALLOC_TEST(rand_int(state, state->block_size/2, state->block_size)); + FATAL_ASSERT(p); + add_block(p, state); + state->blockv[state->nblocks] = p; + if (++state->nblocks >= state->goal_nblocks) { + /*testcase_printf(tcs, "%d: Grown to %d blocks", tcs->thr_nr, state->nblocks);*/ + state->phase = SHRINKING; + state->goal_nblocks = rand_int(state, 0, state->goal_nblocks-1); + } + else + FATAL_ASSERT(!state->blockv[state->nblocks]); + break; + } + case SHRINKING: { + int ix = rand_int(state, 0, state->nblocks-1); + FATAL_ASSERT(state->blockv[ix]); + remove_block(state->blockv[ix]); + FREE_TEST(state->blockv[ix]); + state->blockv[ix] = state->blockv[--state->nblocks]; + state->blockv[state->nblocks] = NULL; + + if (state->nblocks <= state->goal_nblocks) { + /*testcase_printf(tcs, "%d: Shrunk to %d blocks", tcs->thr_nr, state->nblocks);*/ + if (++state->round >= MAX_ROUNDS) { + state->phase = CLEANUP; + } else { + state->phase = GROWING; + state->goal_nblocks = rand_int(state, state->goal_nblocks+1, state->max_nblocks); + } + } + break; + } + case CLEANUP: + do_cleanup(tcs, state); + break; + + default: + FATAL_ASSERT(!"Invalid phase"); + } + + if (state->phase == DONE) { + } + else { + testcase_continue(tcs); + } +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + MigrationState* state = (MigrationState*) tcs->extra; + + while (state->phase != DONE) + do_cleanup(tcs, state); + + enif_free(tcs->extra); + tcs->extra = NULL; +} + + +ERL_NIF_INIT(migration, testcase_nif_funcs, migration_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/migration.erl b/erts/emulator/test/alloc_SUITE_data/migration.erl new file mode 100644 index 0000000000..440a99becd --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/migration.erl @@ -0,0 +1,10 @@ +-module(migration). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c index 7d5608f890..e5df3d647f 100644 --- a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c +++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -100,3 +101,6 @@ testcase_cleanup(TestCaseState_t *tcs) tcs->extra = NULL; } } + +ERL_NIF_INIT(mseg_clear_cache, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl new file mode 100644 index 0000000000..befd6c2e8e --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl @@ -0,0 +1,10 @@ +-module(mseg_clear_cache). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.c b/erts/emulator/test/alloc_SUITE_data/rbtree.c index 49df2f0245..38bbbdf90c 100644 --- a/erts/emulator/test/alloc_SUITE_data/rbtree.c +++ b/erts/emulator/test/alloc_SUITE_data/rbtree.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -19,7 +20,7 @@ #include "testcase_driver.h" #include "allocator_test.h" -#define NO_BLOCKS 100000 +int NO_BLOCKS; #define RIGHT_VISITED (1 << 0) #define LEFT_VISITED (1 << 1) @@ -264,9 +265,10 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) ASSERT(tcs, curr_blacks == 0); ASSERT(tcs, i == -1); + /* testcase_printf(tcs, "Red-Black Tree OK! Max depth = %d; " "Black depth = %d\n", max_i+1, blacks < 0 ? 0 : blacks); - + */ return res; } @@ -467,6 +469,12 @@ testcase_run(TestCaseState_t *tcs) Allctr_t *a; rbtree_test_data *td; + NO_BLOCKS = 100*1000; + if (enif_is_identical(tcs->build_type, + enif_make_atom(tcs->curr_env,"valgrind"))) { + NO_BLOCKS /= 10; + } + /* Best fit... */ testcase_printf(tcs, "Setup...\n"); @@ -576,3 +584,6 @@ testcase_run(TestCaseState_t *tcs) testcase_printf(tcs, "aoffcaobf test succeeded!\n"); } + +ERL_NIF_INIT(rbtree, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.erl b/erts/emulator/test/alloc_SUITE_data/rbtree.erl new file mode 100644 index 0000000000..f5b7120ff2 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/rbtree.erl @@ -0,0 +1,10 @@ +-module(rbtree). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/realloc_copy.c b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c index 12454c75e4..c4147eb00d 100644 --- a/erts/emulator/test/alloc_SUITE_data/realloc_copy.c +++ b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -277,3 +278,5 @@ testcase_cleanup(TestCaseState_t *tcs) STOP_ALC((Allctr_t *) tcs->extra); } +ERL_NIF_INIT(realloc_copy, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl b/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl new file mode 100644 index 0000000000..cc6617bf64 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl @@ -0,0 +1,10 @@ +-module(realloc_copy). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.c b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c index 5c4b11454f..7dcca544e5 100644 --- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.c +++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -22,141 +23,147 @@ #include <stdarg.h> #include <setjmp.h> #include <string.h> +#include <limits.h> #ifdef __WIN32__ -#undef HAVE_VSNPRINTF -#define HAVE_VSNPRINTF 1 -#define vsnprintf _vsnprintf +static void my_vsnprintf(char *outBuf, size_t size, const char *format, va_list ap) +{ + _vsnprintf(outBuf, size, format, ap); + outBuf[size-1] = 0; /* be sure string is terminated */ +} +#elif defined(HAVE_VSNPRINTF) +# define my_vsnprintf(B,S,F,A) (void)vsnprintf(B,S,F,A) +#else +# warning Using unsafe 'vsprintf' without buffer overflow protection +# define my_vsnprintf(B,S,F,A) (void)vsprintf(B,F,A) #endif -#ifndef HAVE_VSNPRINTF -#define HAVE_VSNPRINTF 0 -#endif +static void my_snprintf(char *outBuf, size_t size, const char *format, ...) +{ + va_list ap; + va_start(ap, format); + my_vsnprintf(outBuf, size, format, ap); + va_end(ap); +} #define COMMENT_BUF_SZ 4096 #define TESTCASE_FAILED 0 #define TESTCASE_SKIPPED 1 #define TESTCASE_SUCCEEDED 2 +#define TESTCASE_CONTINUE 3 typedef struct { TestCaseState_t visible; - ErlDrvPort port; - ErlDrvTermData port_id; int result; - jmp_buf done_jmp_buf; + jmp_buf* done_jmp_buf; char *comment; char comment_buf[COMMENT_BUF_SZ]; } InternalTestCaseState_t; -ErlDrvData testcase_drv_start(ErlDrvPort port, char *command); -void testcase_drv_stop(ErlDrvData drv_data); -void testcase_drv_run(ErlDrvData drv_data, char *buf, ErlDrvSizeT len); - -static ErlDrvEntry testcase_drv_entry = { - NULL, - testcase_drv_start, - testcase_drv_stop, - testcase_drv_run, - NULL, - NULL, - "testcase_drv", - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - 0, - NULL, - NULL, - NULL +ERL_NIF_TERM testcase_nif_start(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM testcase_nif_stop(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM testcase_nif_run(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +ErlNifFunc testcase_nif_funcs[] = +{ + {"start", 1, testcase_nif_start}, + {"run", 1, testcase_nif_run}, + {"stop", 1, testcase_nif_stop} }; +static ErlNifResourceType* testcase_rt; +static ERL_NIF_TERM print_atom; -DRIVER_INIT(testcase_drv) +int testcase_nif_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { - testcase_drv_entry.driver_name = testcase_name(); - return &testcase_drv_entry; + testcase_rt = enif_open_resource_type(env, NULL, "testcase_rt", NULL, + ERL_NIF_RT_CREATE, NULL); + + print_atom = enif_make_atom(env, "print"); + return 0; } -ErlDrvData -testcase_drv_start(ErlDrvPort port, char *command) -{ +ERL_NIF_TERM +testcase_nif_start(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ /* (ThrNr, FreeMeg, BuildType) */ + ERL_NIF_TERM ret; InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) - driver_alloc(sizeof(InternalTestCaseState_t)); - if (!itcs) { - return ERL_DRV_ERROR_GENERAL; + enif_alloc_resource(testcase_rt, sizeof(InternalTestCaseState_t)); + int free_megabyte; + const int max_megabyte = INT_MAX / (1024*1024); + const ERL_NIF_TERM* tpl; + int tpl_arity; + + if (!itcs + || !enif_get_tuple(env, argv[0], &tpl_arity, &tpl) + || tpl_arity != 3 + || !enif_get_int(env, tpl[0], &itcs->visible.thr_nr) + || !enif_get_int(env, tpl[1], &free_megabyte)) { + enif_make_badarg(env); } - + itcs->visible.free_mem = (free_megabyte < max_megabyte ? + free_megabyte : max_megabyte) * (1024*1024); itcs->visible.testcase_name = testcase_name(); + itcs->visible.build_type = tpl[2]; itcs->visible.extra = NULL; - itcs->port = port; - itcs->port_id = driver_mk_port(port); itcs->result = TESTCASE_FAILED; itcs->comment = ""; - return (ErlDrvData) itcs; + ret = enif_make_resource(env, itcs); + enif_release_resource(itcs); + return ret; } -void -testcase_drv_stop(ErlDrvData drv_data) +ERL_NIF_TERM +testcase_nif_stop(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - testcase_cleanup((TestCaseState_t *) drv_data); - driver_free((void *) drv_data); + InternalTestCaseState_t *itcs; + if (!enif_get_resource(env, argv[0], testcase_rt, (void**)&itcs)) + return enif_make_badarg(env); + testcase_cleanup(&itcs->visible); + return enif_make_atom(env,"ok"); } -void -testcase_drv_run(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) +ERL_NIF_TERM +testcase_nif_run(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) drv_data; - ErlDrvTermData result_atom; - ErlDrvTermData msg[12]; + InternalTestCaseState_t *itcs; + const char* result_atom; + jmp_buf the_jmp_buf; - itcs->visible.command = buf; - itcs->visible.command_len = len; + if (!enif_get_resource(env, argv[0], testcase_rt, (void**)&itcs)) + return enif_make_badarg(env); - if (setjmp(itcs->done_jmp_buf) == 0) { - testcase_run((TestCaseState_t *) itcs); + itcs->visible.curr_env = env; + + /* For some unknown reason, first call to setjmp crashes on win64 + * when jmp_buf is allocated as part of the resource. But it works when + * allocated on stack. It used to work when this was a driver. + */ + itcs->done_jmp_buf = &the_jmp_buf; + + if (setjmp(the_jmp_buf) == 0) { + testcase_run(&itcs->visible); 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: + case TESTCASE_CONTINUE: + return enif_make_atom(env, "continue"); + + case TESTCASE_SUCCEEDED: result_atom = "succeeded"; break; + case TESTCASE_SKIPPED: result_atom = "skipped"; break; + case TESTCASE_FAILED: result_atom = "failed"; break; default: - result_atom = driver_mk_atom("failed"); - break; + result_atom = "failed"; + my_snprintf(itcs->comment_buf, sizeof(itcs->comment_buf), + "Unexpected test result code %d.", itcs->result); + itcs->comment = itcs->comment_buf; } - msg[0] = ERL_DRV_ATOM; - msg[1] = (ErlDrvTermData) result_atom; - - msg[2] = ERL_DRV_PORT; - msg[3] = itcs->port_id; - - msg[4] = ERL_DRV_ATOM; - msg[5] = driver_mk_atom(itcs->visible.testcase_name); - - msg[6] = ERL_DRV_STRING; - msg[7] = (ErlDrvTermData) itcs->comment; - msg[8] = (ErlDrvTermData) strlen(itcs->comment); - - msg[9] = ERL_DRV_TUPLE; - msg[10] = (ErlDrvTermData) 4; - - erl_drv_output_term(itcs->port_id, msg, 11); + return enif_make_tuple2(env, enif_make_atom(env, result_atom), + enif_make_string(env, itcs->comment, ERL_NIF_LATIN1)); } int @@ -171,34 +178,22 @@ testcase_assertion_failed(TestCaseState_t *tcs, void testcase_printf(TestCaseState_t *tcs, char *frmt, ...) { - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; - ErlDrvTermData msg[12]; + InternalTestCaseState_t* itcs = (InternalTestCaseState_t*)tcs; + ErlNifPid pid; + ErlNifEnv* msg_env = enif_alloc_env(); + ERL_NIF_TERM msg; 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 + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); - msg[0] = ERL_DRV_ATOM; - msg[1] = (ErlDrvTermData) driver_mk_atom("print"); - - msg[2] = ERL_DRV_PORT; - msg[3] = itcs->port_id; - - msg[4] = ERL_DRV_ATOM; - msg[5] = driver_mk_atom(itcs->visible.testcase_name); + msg = enif_make_tuple2(msg_env, print_atom, + enif_make_string(msg_env, itcs->comment_buf, ERL_NIF_LATIN1)); - msg[6] = ERL_DRV_STRING; - msg[7] = (ErlDrvTermData) itcs->comment_buf; - msg[8] = (ErlDrvTermData) strlen(itcs->comment_buf); + enif_send(itcs->visible.curr_env, enif_self(itcs->visible.curr_env, &pid), + msg_env, msg); - msg[9] = ERL_DRV_TUPLE; - msg[10] = (ErlDrvTermData) 4; - - erl_drv_output_term(itcs->port_id, msg, 11); + enif_free_env(msg_env); } @@ -207,17 +202,13 @@ 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 + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); itcs->result = TESTCASE_SUCCEEDED; itcs->comment = itcs->comment_buf; - longjmp(itcs->done_jmp_buf, 1); + longjmp(*itcs->done_jmp_buf, 1); } void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...) @@ -225,17 +216,20 @@ 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 + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); itcs->result = TESTCASE_SKIPPED; itcs->comment = itcs->comment_buf; - longjmp(itcs->done_jmp_buf, 1); + longjmp(*itcs->done_jmp_buf, 1); +} + +void testcase_continue(TestCaseState_t *tcs) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + itcs->result = TESTCASE_CONTINUE; + longjmp(*itcs->done_jmp_buf, 1); } void testcase_failed(TestCaseState_t *tcs, char *frmt, ...) @@ -245,37 +239,33 @@ void testcase_failed(TestCaseState_t *tcs, char *frmt, ...) 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 + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); itcs->result = TESTCASE_FAILED; itcs->comment = itcs->comment_buf; - if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + if (enif_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); + longjmp(*itcs->done_jmp_buf, 1); } void *testcase_alloc(size_t size) { - return driver_alloc(size); + return enif_alloc(size); } void *testcase_realloc(void *ptr, size_t size) { - return driver_realloc(ptr, size); + return enif_realloc(ptr, size); } void testcase_free(void *ptr) { - driver_free(ptr); + enif_free(ptr); } diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h index 66d567cb44..2b742dd7e3 100644 --- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h +++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -19,13 +20,15 @@ #ifndef TESTCASE_DRIVER_H__ #define TESTCASE_DRIVER_H__ -#include "erl_driver.h" +#include <erl_nif.h> #include <stdlib.h> typedef struct { + ErlNifEnv* curr_env; char *testcase_name; - char *command; - int command_len; + int thr_nr; + int free_mem; /* in bytes */ + ERL_NIF_TERM build_type; /* opt, debug, valgrind, ... */ void *extra; } TestCaseState_t; @@ -33,9 +36,11 @@ typedef struct { ((void) ((B) ? 1 : testcase_assertion_failed((TCS), __FILE__, __LINE__, #B))) +int testcase_nif_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); 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_continue(TestCaseState_t *tcs); void testcase_failed(TestCaseState_t *tcs, char *frmt, ...); int testcase_assertion_failed(TestCaseState_t *tcs, char *file, int line, char *assertion); @@ -44,8 +49,11 @@ void *testcase_realloc(void *ptr, size_t size); void testcase_free(void *ptr); +/* Implemented by testcase: */ char *testcase_name(void); void testcase_run(TestCaseState_t *tcs); void testcase_cleanup(TestCaseState_t *tcs); -#endif +extern ErlNifFunc testcase_nif_funcs[3]; + +#endif /* TESTCASE_DRIVER_H__ */ diff --git a/erts/emulator/test/alloc_SUITE_data/threads.c b/erts/emulator/test/alloc_SUITE_data/threads.c index 1247e5d7dd..44d982b6c7 100644 --- a/erts/emulator/test/alloc_SUITE_data/threads.c +++ b/erts/emulator/test/alloc_SUITE_data/threads.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -85,7 +86,7 @@ static void fail(int t_no, char *frmt, ...) tc_failed = 1; - if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + if (enif_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 && strcmp("true", buf) == 0) { fprintf(stderr, "Testcase \"%s\" failed: %s\n", testcase_name(), err_buf); @@ -95,16 +96,11 @@ static void fail(int t_no, char *frmt, ...) exit_thread(t_no, 0); } -static Allctr_t *alloc_not_ts = NULL; static Allctr_t *alloc_ts_1 = NULL; static Allctr_t *alloc_ts_2 = NULL; static void stop_allocators(void) { - if (alloc_not_ts) { - STOP_ALC(alloc_not_ts); - alloc_not_ts = NULL; - } if (alloc_ts_1) { STOP_ALC(alloc_ts_1); alloc_ts_1 = NULL; @@ -154,7 +150,6 @@ testcase_run(TestCaseState_t *tcs) if (!IS_THREADS_ENABLED) testcase_skipped(tcs, "Threads not enabled"); - alloc_not_ts = NULL; alloc_ts_1 = NULL; alloc_ts_2 = NULL; @@ -163,16 +158,12 @@ testcase_run(TestCaseState_t *tcs) sprintf(sbct_buf, "%d", SBC_THRESHOLD/1024); memcpy((void *) argv, argv_org, sizeof(argv_org)); - alloc_not_ts = START_ALC("threads_not_ts", 0, argv); - ASSERT(tcs, alloc_not_ts); - memcpy((void *) argv, argv_org, sizeof(argv_org)); alloc_ts_1 = START_ALC("threads_ts_1", 1, argv); ASSERT(tcs, alloc_ts_1); memcpy((void *) argv, argv_org, sizeof(argv_org)); alloc_ts_2 = START_ALC("threads_ts_2", 1, argv); ASSERT(tcs, alloc_ts_2); - ASSERT(tcs, !IS_ALLOC_THREAD_SAFE(alloc_not_ts)); ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_1)); ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_2)); @@ -186,16 +177,10 @@ testcase_run(TestCaseState_t *tcs) for(i = 1; i <= NO_OF_THREADS; i++) { char *alc; - int res; threads[i].arg.no_ops_per_bl = NO_OF_OPS_PER_BL; - if (i == 1) { - alc = "threads_not_ts"; - threads[i].arg.no_ops_per_bl *= 2; - threads[i].arg.a = alloc_not_ts; - } - else if (i % 2 == 0) { + if (i % 2 == 0) { alc = "threads_ts_1"; threads[i].arg.a = alloc_ts_1; } @@ -396,7 +381,7 @@ alloc_op(int t_no, Allctr_t *a, block *bp, int id, int clean_up) bp->p = (unsigned char *) ALLOC(a, bp->s); if(!bp->p) fail(t_no, "ALLOC(%lu) failed [id=%d])\n", bp->s, id); - memset((void *) bp->p, id, (size_t) bp->s); + memset((void *) bp->p, (unsigned char)id, (size_t) bp->s); } else { unsigned char *p = (unsigned char *) REALLOC(a, bp->p, bp->as[bp->i]); @@ -406,7 +391,7 @@ alloc_op(int t_no, Allctr_t *a, block *bp, int id, int clean_up) if(bp->s < bp->as[bp->i]) { CHECK_BLOCK_DATA(t_no, p, bp->s, id); - memset((void *) p, id, (size_t) bp->as[bp->i]); + memset((void *) p, (unsigned char)id, (size_t) bp->as[bp->i]); } else CHECK_BLOCK_DATA(t_no, p, bp->as[bp->i], id); @@ -445,3 +430,6 @@ thread_func(void *arg) exit_thread(td->t_no, 1); return NULL; } + +ERL_NIF_INIT(threads, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/threads.erl b/erts/emulator/test/alloc_SUITE_data/threads.erl new file mode 100644 index 0000000000..a7b4965f5e --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/threads.erl @@ -0,0 +1,10 @@ +-module(threads). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/async_ports_SUITE.erl b/erts/emulator/test/async_ports_SUITE.erl new file mode 100644 index 0000000000..f0f5fb5687 --- /dev/null +++ b/erts/emulator/test/async_ports_SUITE.erl @@ -0,0 +1,117 @@ +-module(async_ports_SUITE). + +-export([all/0, suite/0]). +-export([permanent_busy_test/1]). +-export([run_loop/5]). + +-include_lib("common_test/include/ct.hrl"). + +-define(PACKET_SIZE, (10 * 1024 * 8)). +-define(CPORT_DELAY, 100). +-define(TEST_LOOPS_COUNT, 100000). +-define(SLEEP_BEFORE_CHECK, 1000). +-define(TEST_PROCS_COUNT, 2). +-define(TC_TIMETRAP_SECONDS, 10). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, ?TC_TIMETRAP_SECONDS}}]. + +all() -> + [permanent_busy_test]. + +permanent_busy_test(Config) -> + ExePath = filename:join(proplists:get_value(data_dir, Config), "cport"), + Self = self(), + spawn_link( + fun() -> + Block = <<0:?PACKET_SIZE>>, + + Port = open_port(ExePath), + + Testers = lists:map( + fun(_) -> + spawn_link(?MODULE, run_loop, + [Self, + Port, + Block, + ?TEST_LOOPS_COUNT, + 0]) + end, + lists:seq(1, ?TEST_PROCS_COUNT)), + Self ! {test_info, Port, Testers}, + endless_flush(Port) + end), + + receive + {test_info, Port, Testers} -> + MaxWaitTime = round(0.7 * ?TC_TIMETRAP_SECONDS * 1000), + ct:log("wait testers, maximum ~w mcsec~n", [MaxWaitTime]), + ok = wait_testers(MaxWaitTime, Testers), + timer:sleep(?SLEEP_BEFORE_CHECK), + case erlang:port_command(Port, <<"test">>, [nosuspend]) of + false -> + exit(port_dead); + true -> + ok + end + end. + +wait_testers(Timeout, Testers) -> + lists:foldl( + fun(Pid, AccIn) -> + StartWait = os:timestamp(), + receive + {Pid, port_dead} -> + recalc_timeout(AccIn, StartWait) + after AccIn -> + Pid ! stop, + recalc_timeout(AccIn, StartWait) + end + end, Timeout, Testers), + ok. + +recalc_timeout(TimeoutIn, WaitStart) -> + erlang:max(0, TimeoutIn - round(timer:now_diff(os:timestamp(), WaitStart)) div 1000). + +open_port(ExePath) -> + erlang:open_port({spawn, ExePath ++ " 100"}, [{packet, 4}, eof, exit_status, use_stdio, binary]). + +run_loop(RootProc, Port, Block, CheckLimit, BusyCnt) -> + receive + stop -> + ok + after 0 -> + case erlang:port_command(Port, Block, [nosuspend]) of + true -> + run_loop(RootProc, Port, Block, CheckLimit, 0); + false -> + if + BusyCnt + 1 > CheckLimit -> + check_dead(RootProc, Port, Block, CheckLimit); + true -> + run_loop(RootProc, Port, Block, CheckLimit, BusyCnt + 1) + end + end + end. + +check_dead(RootProc, Port, Block, CheckLimit) -> + ct:log("~p: check port dead~n", [self()]), + timer:sleep(?SLEEP_BEFORE_CHECK), + case erlang:port_command(Port, Block, [nosuspend]) of + true -> + ct:log("not dead~n"), + run_loop(RootProc, Port, Block, CheckLimit, 0); + false -> + ct:log("port dead: ~p~n", [Port]), + RootProc ! {self(), port_dead}, + ok + end. + +endless_flush(Port) -> + receive + {Port, {data, _}} -> + endless_flush(Port); + {Port, SomethingWrong} -> + erlang:error({someting_wrong, SomethingWrong}) + end. diff --git a/erts/emulator/test/async_ports_SUITE_data/Makefile.src b/erts/emulator/test/async_ports_SUITE_data/Makefile.src new file mode 100644 index 0000000000..56da3fbe12 --- /dev/null +++ b/erts/emulator/test/async_ports_SUITE_data/Makefile.src @@ -0,0 +1,15 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = cport@exe@ + + +all: $(PROGS) + +cport@exe@: cport@obj@ + $(LD) $(CROSSLDFLAGS) -o cport cport@obj@ @LIBS@ + +cport@obj@: cport.c + $(CC) -c -o cport@obj@ $(CFLAGS) cport.c diff --git a/erts/emulator/test/async_ports_SUITE_data/cport.c b/erts/emulator/test/async_ports_SUITE_data/cport.c new file mode 100644 index 0000000000..033aff382a --- /dev/null +++ b/erts/emulator/test/async_ports_SUITE_data/cport.c @@ -0,0 +1,81 @@ +#include <stdlib.h> +#include <stdio.h> +#include <errno.h> +#include <string.h> +#ifdef __WIN32__ +# include "windows.h" +# include "winbase.h" +#else +# include <unistd.h> +#endif + +typedef unsigned char byte; + +int read_cmd(byte *buf) +{ + int len; + if (read_exact(buf, 4) != 4) + return(-1); + + len = (buf[0] << 24) | (buf[1] << 16) | (buf[2] << 8) | buf[3]; + return read_exact(buf, len); +} + +int write_cmd(byte *buf, int len) +{ + byte li[4]; + li[0] = (len >> 24) & 0xff; + li[1] = (len >> 16) & 0xff; + li[2] = (len >> 8) & 0xff; + li[3] = len & 0xff; + write_exact(&li, 4); + + return write_exact(buf, len); +} + +int read_exact(byte *buf, int len) +{ + int i, got=0; + do { + if ((i = read(0, buf+got, len-got)) <= 0) + { + return(i); + } + got += i; + } while (got<len); + return len; +} + +int write_exact(byte *buf, int len) +{ + int i, wrote = 0; + do { + if ((i = write(1, buf+wrote, len-wrote)) < 0) + return (i); + wrote += i; + } while (wrote<len); + return len; +} + +byte static_buf[31457280]; // 30 mb + +int main(int argc, char **argv) { + int sleep_time = atoi(argv[1]); + int fn, arg, res; + byte *buf = &static_buf[0]; + int len = 0; + if (sleep_time <= 0) + sleep_time = 0; +#ifdef __WIN32__ + else + sleep_time = ((sleep_time - 1) / 1000) + 1; /* Milli seconds */ +#endif + while ((len = read_cmd(buf)) > 0) { +#ifdef __WIN32__ + Sleep((DWORD) sleep_time); +#else + usleep(sleep_time); +#endif + write_cmd(buf, len); + } +} diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index 60339ea422..bdf8f6c34e 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,17 +24,19 @@ init_per_group/2,end_per_group/2, packed_registers/1, apply_last/1, apply_last_bif/1, buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1, - select_val/1]). + select_val/1, swap_temp_apply/1]). --export([applied/2]). +-export([applied/2,swap_temp_applied/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). +-include_lib("syntax_tools/include/merl.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [packed_registers, apply_last, apply_last_bif, - buildo_mucho, heap_sizes, big_lists, select_val]. + buildo_mucho, heap_sizes, big_lists, select_val, + swap_temp_apply]. groups() -> []. @@ -60,15 +63,15 @@ apply_last(Config) when is_list(Config) -> {Pid, finished} -> stack_size(Pid) after 30000 -> - ?t:fail("applied/2 timed out.") + ct:fail("applied/2 timed out.") end, Pid ! die, - ?t:format("Size: ~p~n", [Size]), + io:format("Size: ~p~n", [Size]), if Size < 700 -> ok; true -> - ?t:fail("10000 apply() grew stack too much.") + ct:fail("10000 apply() grew stack too much.") end, ok. @@ -91,48 +94,66 @@ applied(Starter, N) -> apply_last_bif(Config) when is_list(Config) -> apply(erlang, abs, [1]). -%% Test three high register numbers in a put_list instruction -%% (to test whether packing works properly). +%% Test whether packing works properly. packed_registers(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), - Mod = packed_regs, - Name = filename:join(PrivDir, atom_to_list(Mod) ++ ".erl"), - - %% Generate a module which generates a list of tuples. - %% put_list(A) -> [{A, 600}, {A, 999}, ... {A, 0}]. - Code = gen_packed_regs(600, ["-module("++atom_to_list(Mod)++").\n", - "-export([put_list/1]).\n", - "put_list(A) ->\n["]), - ok = file:write_file(Name, Code), - - %% Compile the module. - io:format("Compiling: ~s\n", [Name]), - CompRc = compile:file(Name, [{outdir, PrivDir}, report]), - io:format("Result: ~p\n",[CompRc]), - {ok, Mod} = CompRc, - - %% Load it. - io:format("Loading...\n",[]), - LoadRc = code:load_abs(filename:join(PrivDir, atom_to_list(Mod))), - {module,_Module} = LoadRc, - - %% Call it and verify result. - Term = {a, b}, - L = Mod:put_list(Term), - verify_packed_regs(L, Term, 600), - ok. + Mod = ?FUNCTION_NAME, + + %% Generate scrambled sequence. + Seq0 = [{erlang:phash2(I),I} || I <- lists:seq(0, 260)], + Seq = [I || {_,I} <- lists:sort(Seq0)], + + %% Generate a test modules that uses get_list/3 instructions + %% with high register numbers. + S0 = [begin + VarName = list_to_atom("V"++integer_to_list(V)), + {merl:var(VarName),V} + end || V <- Seq], + Vars = [V || {V,_} <- S0], + NewVars = [begin + VarName = list_to_atom("M"++integer_to_list(V)), + merl:var(VarName) + end || V <- Seq], + MoreNewVars = [begin + VarName = list_to_atom("MM"++integer_to_list(V)), + merl:var(VarName) + end || V <- Seq], + TupleEls = [?Q("id(_@Value@)") || {_,Value} <- S0], + S = [?Q("_@Var = id(_@Value@)") || {Var,Value} <- S0], + Code = ?Q(["-module('@Mod@').\n" + "-export([f/0]).\n" + "f() ->\n" + "Tuple = id({_@TupleEls}),\n" + "{_@MoreNewVars} = Tuple,\n" + "_@S,\n" + "_ = id(0),\n" + "L = [_@Vars],\n" + "_ = id(1),\n" + "[_@NewVars] = L,\n" %Test get_list/3. + "_ = id(2),\n" + "id([_@Vars,_@NewVars,_@MoreNewVars]).\n" + "id(I) -> I.\n"]), + merl:compile_and_load(Code), + + %% Optionally print the generated code. + PrintCode = false, %Change to true to print code. + + case PrintCode of + false -> + ok; + true -> + merl:print(Code), + erts_debug:df(Mod), + {ok,Dis} = file:read_file(atom_to_list(Mod)++".dis"), + io:put_chars(Dis) + end, -gen_packed_regs(0, Acc) -> - [Acc|"{A,0}].\n"]; -gen_packed_regs(N, Acc) -> - gen_packed_regs(N-1, [Acc,"{A,",integer_to_list(N)|"},\n"]). + CombinedSeq = Seq ++ Seq ++ Seq, + CombinedSeq = Mod:f(), -verify_packed_regs([], _, -1) -> ok; -verify_packed_regs([{Term, N}| T], Term, N) -> - verify_packed_regs(T, Term, N-1); -verify_packed_regs(L, Term, N) -> - ok = io:format("Expected [{~p, ~p}|T]; got\n~p\n", [Term, N, L]), - test_server:fail(). + %% Clean up. + true = code:delete(Mod), + false = code:purge(Mod), + ok. buildo_mucho(Config) when is_list(Config) -> buildo_mucho_1(), @@ -318,7 +339,7 @@ fconv(Config) when is_list(Config) -> do_fconv(Type) -> try do_fconv(Type, 1.0), - test_server:fail() + ct:fail(no_badarith) catch error:badarith -> ok @@ -346,3 +367,41 @@ do_select_val(X) -> Int when is_integer(Int) -> integer end. + +swap_temp_apply(_Config) -> + {swap_temp_applied,42} = do_swap_temp_apply(41), + not_an_integer = do_swap_temp_apply(not_an_integer), + ok. + +do_swap_temp_apply(Msg) -> + case swap_temp_apply_function(Msg) of + undefined -> Msg; + Type -> + %% The following sequence: + %% move {x,0} {x,2} + %% move {y,0} {x,0} + %% move {x,2} {y,0} + %% apply 1 + %% + %% Would be incorrectly transformed to: + %% swap {x,0} {y,0} + %% apply 1 + %% + %% ({x,1} is the module, {x,2} the function to be applied). + %% + %% If the instructions are to be transformed, the correct + %% transformation is: + %% + %% swap_temp {x,0} {y,0} {x,2} + %% apply 1 + Fields = ?MODULE:Type(Msg), + {Type,Fields} + end. + +swap_temp_apply_function(Int) when is_integer(Int) -> + swap_temp_applied; +swap_temp_apply_function(_) -> + undefined. + +swap_temp_applied(Int) -> + Int+1. diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl index 85236e4203..09761263e2 100644 --- a/erts/emulator/test/beam_literals_SUITE.erl +++ b/erts/emulator/test/beam_literals_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,7 +28,7 @@ put_list/1, fconv/1, literal_case_expression/1, increment/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -54,7 +55,7 @@ end_per_group(_GroupName, Config) -> Config. -putting(doc) -> "Test creating lists and tuples containing big number literals."; +%% Test creating lists and tuples containing big number literals. putting(Config) when is_list(Config) -> -773973888575883407313908 = chksum(putting1(8987697898797)). @@ -63,23 +64,22 @@ putting1(X) -> [X|349873987387373], [329878349873|-387394729872], -773973937933873929749873}. -matching_bigs(doc) -> "Test matching of a few big number literals (in Beam," - "select_val/3 will NOT be used)."; +%% Test matching of a few big number literals (in Beam select_val/3 will NOT be used). matching_bigs(Config) when is_list(Config) -> a = matching1(3972907842873739), b = matching1(-389789298378939783333333333333333333784), other = matching1(3141699999999999999999999999999999999), other = matching1(42). -matching_smalls(doc) -> "Test matching small numbers (both positive and negative)."; +%% Test matching small numbers (both positive and negative). matching_smalls(Config) when is_list(Config) -> - ?line a = m_small(-42), - ?line b = m_small(0), - ?line c = m_small(105), - ?line d = m_small(-13), - ?line e = m_small(337848), - ?line other = m_small(324), - ?line other = m_small(-7), + a = m_small(-42), + b = m_small(0), + c = m_small(105), + d = m_small(-13), + e = m_small(337848), + other = m_small(324), + other = m_small(-7), ok. m_small(-42) -> a; @@ -89,17 +89,16 @@ m_small(-13) -> d; m_small(337848) -> e; m_small(_) -> other. -matching_smalls_jt(doc) -> - "Test matching small numbers (both positive and negative). " - "Make sure that a jump table is used."; +%% Test matching small numbers (both positive and negative). +%% Make sure that a jump table is used. matching_smalls_jt(Config) when is_list(Config) -> - ?line a = m_small_jt(-2), - ?line b = m_small_jt(-1), - ?line c = m_small_jt(0), - ?line d = m_small_jt(2), - ?line e = m_small_jt(3), - ?line other = m_small(324), - ?line other = m_small(-7), + a = m_small_jt(-2), + b = m_small_jt(-1), + c = m_small_jt(0), + d = m_small_jt(2), + e = m_small_jt(3), + other = m_small(324), + other = m_small(-7), ok. m_small_jt(-2) -> a; @@ -116,8 +115,7 @@ matching1(-389789298378939783333333333333333333784) -> b; matching1(_) -> other. -matching_more_bigs(doc) -> "Test matching of a big number literals (in Beam," - "a select_val/3 instruction will be used)."; +%% Test matching of a big number literals (in Beam, a select_val/3 instruction will be used) matching_more_bigs(Config) when is_list(Config) -> a = matching2(-999766349740978337), b = matching2(9734097866575478), @@ -136,8 +134,7 @@ matching2(13987294872948990) -> d; matching2(777723896192459245) -> e; matching2(_) -> other. -matching_bigs_and_smalls(doc) -> "Test matching of a mix of big numbers and literals."; -matching_bigs_and_smalls(suite) -> []; +%% Test matching of a mix of big numbers and literals. matching_bigs_and_smalls(Config) when is_list(Config) -> a = matching3(38472928723987239873873), b = matching3(0), @@ -158,30 +155,30 @@ matching3(42) -> e; matching3(-4533) -> f; matching3(_) -> other. -badmatch(doc) -> "Test literal badmatches with big number and floats."; +%% Test literal badmatches with big number and floats. badmatch(Config) when is_list(Config) -> %% We are satisfied if we can load this module and run it. Big = id(32984798729847892498297824872982972978239874), Float = id(3.1415927), - ?line catch a = Big, - ?line catch b = Float, - ?line {'EXIT',{{badmatch,3879373498378993387},_}} = + catch a = Big, + catch b = Float, + {'EXIT',{{badmatch,3879373498378993387},_}} = (catch c = 3879373498378993387), - ?line {'EXIT',{{badmatch,7.0},_}} = (catch d = 7.0), - ?line case Big of - Big -> ok - end, - ?line case Float of - Float -> ok - end, + {'EXIT',{{badmatch,7.0},_}} = (catch d = 7.0), + case Big of + Big -> ok + end, + case Float of + Float -> ok + end, ok. case_clause(Config) when is_list(Config) -> - ?line {'EXIT',{{case_clause,337.0},_}} = (catch case_clause_float()), - ?line {'EXIT',{{try_clause,42.0},_}} = (catch try_case_clause_float()), - ?line {'EXIT',{{case_clause,37932749837839747383847398743789348734987},_}} = + {'EXIT',{{case_clause,337.0},_}} = (catch case_clause_float()), + {'EXIT',{{try_clause,42.0},_}} = (catch try_case_clause_float()), + {'EXIT',{{case_clause,37932749837839747383847398743789348734987},_}} = (catch case_clause_big()), - ?line {'EXIT',{{try_clause,977387349872349870423364354398566348},_}} = + {'EXIT',{{try_clause,977387349872349870423364354398566348},_}} = (catch try_case_clause_big()), ok. @@ -209,8 +206,7 @@ try_case_clause_big() -> error end. -receiving(doc) -> "Test receive with a big number literal (more than 27 bits, " - "less than 32 bits)."; +%% Test receive with a big number literal (more than 27 bits, less than 32 bits). receiving(Config) when is_list(Config) -> Self = self(), spawn(fun() -> Self ! here_is_a_message end), @@ -221,33 +217,34 @@ receiving(Config) when is_list(Config) -> timeout end. -literal_type_tests(doc) -> "Test type tests on literal values."; +%% Test type tests on literal values. literal_type_tests(Config) when is_list(Config) -> %% Generate an Erlang module with all different type of type tests. - ?line Tests = make_test([{T, L} || T <- type_tests(), L <- literals()]), - ?line Mod = literal_test, - ?line Func = {function, 0, test, 0, [{clause,0,[],[],Tests}]}, - ?line Form = [{attribute,0,module,Mod}, - {attribute,0,compile,export_all}, - Func, {eof,0}], + Tests = make_test([{T, L} || T <- type_tests(), L <- literals()]), + Mod = literal_test, + Anno = erl_anno:new(0), + Func = {function, Anno, test, 0, [{clause,Anno,[],[],Tests}]}, + Form = [{attribute,Anno,module,Mod}, + {attribute,Anno,compile,export_all}, + Func, {eof,Anno}], %% Print generated code for inspection. - ?line lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form), + lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form), %% Test compile:form/1. This implies full optimization (default). - ?line {ok,Mod,Code1} = compile:forms(Form), - ?line {module,Mod} = code:load_binary(Mod, Mod, Code1), - ?line Mod:test(), - ?line true = code:delete(Mod), - ?line code:purge(Mod), + {ok,Mod,Code1} = compile:forms(Form), + {module,Mod} = code:load_binary(Mod, Mod, Code1), + Mod:test(), + true = code:delete(Mod), + code:purge(Mod), %% Test compile:form/2. Turn off all optimizations. - ?line {ok,Mod,Code2} = compile:forms(Form, [binary,report,time, + {ok,Mod,Code2} = compile:forms(Form, [binary,report,time, no_copt,no_postopt]), - ?line {module,Mod} = code:load_binary(Mod, Mod, Code2), - ?line Mod:test(), - ?line true = code:delete(Mod), - ?line code:purge(Mod), + {module,Mod} = code:load_binary(Mod, Mod, Code2), + Mod:test(), + true = code:delete(Mod), + code:purge(Mod), ok. make_test([{is_function=T,L}|Ts]) -> @@ -261,7 +258,8 @@ test(T, L) -> {ok,Toks,_Line} = erl_scan:string(S), {ok,E} = erl_parse:parse_exprs(Toks), {value,Val,_Bs} = erl_eval:exprs(E, []), - {match,0,{atom,0,Val},hd(E)}. + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},hd(E)}. test(T, A, L) -> S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", @@ -269,7 +267,8 @@ test(T, A, L) -> {ok,Toks,_Line} = erl_scan:string(S), {ok,E} = erl_parse:parse_exprs(Toks), {value,Val,_Bs} = erl_eval:exprs(E, []), - {match,0,{atom,0,Val},hd(E)}. + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},hd(E)}. literals() -> [42, @@ -295,34 +294,34 @@ type_tests() -> put_list(Config) when is_list(Config) -> %% put_list x0 Literal Reg - ?line [Config|8739757395764] = put_list_rqr(Config), - ?line {[Config|7779757395764],Config} = put_list_rqx(Config), - ?line [Config|98765432100000] = put_list_rqy(Config), + [Config|8739757395764] = put_list_rqr(Config), + {[Config|7779757395764],Config} = put_list_rqx(Config), + [Config|98765432100000] = put_list_rqy(Config), %% put_list x Literal Reg - ?line [Config|16#FFFFF77777137483769] = put_list_xqr(ignore, Config), - ?line {[Config|16#AAAAAFFFFF77777],{a,b},Config} = put_list_xqx({a,b}, Config), - ?line [Config|12777765432979879] = put_list_xqy(ignore, Config), + [Config|16#FFFFF77777137483769] = put_list_xqr(ignore, Config), + {[Config|16#AAAAAFFFFF77777],{a,b},Config} = put_list_xqx({a,b}, Config), + [Config|12777765432979879] = put_list_xqy(ignore, Config), %% put_list y Literal Reg - ?line [Config|17424134793676869867] = put_list_yqr(Config), - ?line {[Config|77424134793676869867],Config} = put_list_yqx(Config), - ?line {Config,[Config|16#BCDEFF4241676869867]} = put_list_yqy(Config), + [Config|17424134793676869867] = put_list_yqr(Config), + {[Config|77424134793676869867],Config} = put_list_yqx(Config), + {Config,[Config|16#BCDEFF4241676869867]} = put_list_yqy(Config), %% put_list Literal x0 Reg - ?line [42.0|Config] = put_list_qrr(Config), - ?line [Config,42.0|Config] = put_list_qrx(Config), - ?line [100.0|Config] = put_list_qry(Config), + [42.0|Config] = put_list_qrr(Config), + [Config,42.0|Config] = put_list_qrx(Config), + [100.0|Config] = put_list_qry(Config), %% put_list Literal x1 Reg - ?line [127.0|Config] = put_list_qxr({ignore,me}, Config), - ?line [Config,130.0|Config] = put_list_qxx(ignore, Config), - ?line [99.0|Config] = put_list_qxy(Config), + [127.0|Config] = put_list_qxr({ignore,me}, Config), + [Config,130.0|Config] = put_list_qxx(ignore, Config), + [99.0|Config] = put_list_qxy(Config), %% put_list Literal y0 Reg - ?line [200.0|Config] = put_list_qyr(Config), - ?line [Config,210.0|Config] = put_list_qyx(Config), - ?line [[300.0|Config]|Config] = put_list_qyy(Config), + [200.0|Config] = put_list_qyr(Config), + [Config,210.0|Config] = put_list_qyx(Config), + [[300.0|Config]|Config] = put_list_qyy(Config), ok. @@ -413,8 +412,8 @@ put_list_qyy(Config) -> [Res|Config]. fconv(Config) when is_list(Config) -> - ?line 5.0 = fconv_1(-34444444450.0), - ?line 13.0 = fconv_2(7.0), + 5.0 = fconv_1(-34444444450.0), + 13.0 = fconv_2(7.0), ok. fconv_1(F) when is_float(F) -> @@ -424,19 +423,18 @@ fconv_2(F) when is_float(F) -> 6.0 + F. literal_case_expression(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line Src = filename:join(DataDir, "literal_case_expression"), - ?line {ok,literal_case_expression=Mod,Code} = - compile:file(Src, [from_asm,binary]), - ?line {module,Mod} = code:load_binary(Mod, Src, Code), - ?line ok = Mod:x(), - ?line ok = Mod:y(), - ?line ok = Mod:zi1(), - ?line ok = Mod:zi2(), - ?line ok = Mod:za1(), - ?line ok = Mod:za2(), - ?line true = code:delete(Mod), - ?line code:purge(Mod), + DataDir = proplists:get_value(data_dir, Config), + Src = filename:join(DataDir, "literal_case_expression"), + {ok,literal_case_expression=Mod,Code} = compile:file(Src, [from_asm,binary]), + {module,Mod} = code:load_binary(Mod, Src, Code), + ok = Mod:x(), + ok = Mod:y(), + ok = Mod:zi1(), + ok = Mod:zi2(), + ok = Mod:za1(), + ok = Mod:za2(), + true = code:delete(Mod), + code:purge(Mod), ok. %% Test the i_increment instruction. @@ -448,27 +446,27 @@ increment(Config) when is_list(Config) -> Neg32 = -(1 bsl 27), Big32 = id(1 bsl 32), Result32 = (1 bsl 32) + (1 bsl 27), - ?line Result32 = Big32 + (1 bsl 27), - ?line Result32 = Big32 - Neg32, + Result32 = Big32 + (1 bsl 27), + Result32 = Big32 - Neg32, %% Same thing, but for the 64-bit emulator. Neg64 = -(1 bsl 59), Big64 = id(1 bsl 64), Result64 = (1 bsl 64) + (1 bsl 59), - ?line Result64 = Big64 + (1 bsl 59), - ?line Result64 = Big64 - Neg64, + Result64 = Big64 + (1 bsl 59), + Result64 = Big64 - Neg64, %% Test error handling for the i_increment instruction. Bad = id(bad), - ?line {'EXIT',{badarith,_}} = (catch Bad + 42), + {'EXIT',{badarith,_}} = (catch Bad + 42), %% Small operands, but a big result. Res32 = 1 bsl 27, Small32 = id(Res32-1), - ?line Res32 = Small32 + 1, + Res32 = Small32 + 1, Res64 = 1 bsl 59, Small64 = id(Res64-1), - ?line Res64 = Small64 + 1, + Res64 = Small64 + 1, ok. %% Help functions. diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index fbc229bc53..e1b42e5d85 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -1,76 +1,54 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/file.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - display/1, display_huge/0, +-export([all/0, suite/0, + display/1, display_huge/0, display_string/1, erl_bif_types/1,guard_bifs_in_erl_bif_types/1, - shadow_comments/1, + shadow_comments/1,list_to_utf8_atom/1, specs/1,improper_bif_stubs/1,auto_imports/1, t_list_to_existing_atom/1,os_env/1,otp_7526/1, binary_to_atom/1,binary_to_existing_atom/1, - atom_to_binary/1,min_max/1, erlang_halt/1]). + atom_to_binary/1,min_max/1, erlang_halt/1, + erl_crash_dump_bytes/1, + is_builtin/1, error_stacktrace/1, + error_stacktrace_during_call_trace/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [erl_bif_types, guard_bifs_in_erl_bif_types, shadow_comments, specs, improper_bif_stubs, auto_imports, t_list_to_existing_atom, os_env, otp_7526, - display, + display, display_string, list_to_utf8_atom, atom_to_binary, binary_to_atom, binary_to_existing_atom, - min_max, erlang_halt]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(1)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). + erl_crash_dump_bytes, min_max, erlang_halt, is_builtin, + error_stacktrace, error_stacktrace_during_call_trace]. - -display(suite) -> - []; -display(doc) -> - ["Uses erlang:display to test that erts_printf does not do deep recursion"]; +%% Uses erlang:display to test that erts_printf does not do deep recursion display(Config) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), {ok, Node} = test_server:start_node(display_huge_term,peer, @@ -90,6 +68,28 @@ deeep(N,Acc) -> deeep(N) -> deeep(N,[hello]). +display_string(Config) when is_list(Config) -> + true = erlang:display_string("hej"), + true = erlang:display_string(""), + true = erlang:display_string("hopp"), + true = erlang:display_string("\n"), + true = erlang:display_string(lists:seq(1100,1200)), + {error,badarg} = try + erlang:display_string(atom), + ok + catch + T0:E0 -> + {T0, E0} + end, + {error,badarg} = try + erlang:display_string(make_ref()), + ok + catch + T1:E1 -> + {T1, E1} + end, + ok. + erl_bif_types(Config) when is_list(Config) -> ensure_erl_bif_types_compiled(), @@ -115,7 +115,7 @@ erl_bif_types_2(List) -> [_|_] -> io:put_chars("Bifs with bad arity\n"), io:format("~p\n", [BadArity]), - ?line ?t:fail({length(BadArity),bad_arity}) + ct:fail({length(BadArity),bad_arity}) end. erl_bif_types_3(List) -> @@ -139,7 +139,7 @@ erl_bif_types_3(List) -> 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}) + ct:fail({length(BadSmokeTest),bad_smoke_test}) end. guard_bifs_in_erl_bif_types(_Config) -> @@ -160,15 +160,17 @@ guard_bifs_in_erl_bif_types(_Config) -> "The following guard BIFs have no type information " "in erl_bif_types:\n\n", [io_lib:format(" ~p/~p\n", [F,A]) || {F,A} <- Not]]), - ?t:fail() + ct:fail(erl_bif_types) end. shadow_comments(_Config) -> ensure_erl_bif_types_compiled(), + ErlangList = [{erlang,F,A} || {F,A} <- erlang:module_info(exports), + not is_operator(F,A)], List0 = erlang:system_info(snifs), - List1 = [MFA || {M,_,_}=MFA <- List0, M =/= hipe_bifs], - List = [MFA || MFA <- List1, not is_operator(MFA)], + List1 = [MFA || {M,_,_}=MFA <- List0, M =/= hipe_bifs, M =/= erlang], + List = List1 ++ ErlangList, HasTypes = [MFA || {M,F,A}=MFA <- List, erl_bif_types:is_known(M, F, A)], Path = get_code_path(), @@ -200,7 +202,7 @@ shadow_comments(_Config) -> "obvious.\n\nThe following comments are missing:\n\n", [io_lib:format("%% Shadowed by erl_bif_types: ~p:~p/~p\n", [M,F,A]) || {M,F,A} <- NoComments]]), - ?t:fail() + ct:fail(bif_stub) end, case NoBifSpecs of @@ -214,7 +216,7 @@ shadow_comments(_Config) -> "Therefore, the following comments should be removed:\n\n", [io_lib:format("%% Shadowed by erl_bif_types: ~p:~p/~p\n", [M,F,A]) || {M,F,A} <- NoBifSpecs]]), - ?t:fail() + ct:fail(erl_bif_types) end. extract_comments(Mod, Path) -> @@ -236,7 +238,7 @@ ensure_erl_bif_types_compiled() -> case erlang:function_exported(erl_bif_types, module_info, 0) of false -> %% Fail cleanly. - ?t:fail("erl_bif_types not compiled"); + ct:fail("erl_bif_types not compiled"); true -> ok end. @@ -274,16 +276,19 @@ specs(_) -> [_|_] -> io:put_chars("The following BIFs don't have specs:\n"), [print_mfa(MFA) || MFA <- NoSpecs], - ?t:fail() + ct:fail(no_spec) end. is_operator({erlang,F,A}) -> + is_operator(F,A); +is_operator(_) -> false. + +is_operator(F,A) -> erl_internal:arith_op(F, A) orelse erl_internal:bool_op(F, A) orelse erl_internal:comp_op(F, A) orelse erl_internal:list_op(F, A) orelse - erl_internal:send_op(F, A); -is_operator(_) -> false. + erl_internal:send_op(F, A). extract_specs(M, Abstr) -> [{make_mfa(M, Name),Spec} || {attribute,_,spec,{Name,Spec}} <- Abstr]. @@ -334,7 +339,7 @@ auto_imports([{erlang,F,A}|T], Errors) -> auto_imports([], 0) -> ok; auto_imports([], Errors) -> - ?t:fail({Errors,inconsistencies}). + ct:fail({Errors,inconsistencies}). extract_functions(M, Abstr) -> [{{M,F,A},Body} || {function,_,F,A,Body} <- Abstr]. @@ -353,40 +358,68 @@ check_stub({_,F,A}, B) -> io:put_chars(erl_pp:function(Func)), io:nl(), io:put_chars("The body should be: erlang:nif_error(undef)"), - ?t:fail() + ct:fail(invalid_body) end. +list_to_utf8_atom(Config) when is_list(Config) -> + 'hello' = atom_roundtrip("hello"), + 'こんにちは' = atom_roundtrip("こんにちは"), + + %% Test all edge cases. + _ = atom_roundtrip([16#80]), + _ = atom_roundtrip([16#7F]), + _ = atom_roundtrip([16#FF]), + _ = atom_roundtrip([16#100]), + _ = atom_roundtrip([16#7FF]), + _ = atom_roundtrip([16#800]), + _ = atom_roundtrip([16#D7FF]), + atom_badarg([16#D800]), + atom_badarg([16#DFFF]), + _ = atom_roundtrip([16#E000]), + _ = atom_roundtrip([16#FFFF]), + _ = atom_roundtrip([16#1000]), + _ = atom_roundtrip([16#10FFFF]), + atom_badarg([16#110000]), + ok. + +atom_roundtrip(String) -> + Atom = list_to_atom(String), + Atom = list_to_existing_atom(String), + String = atom_to_list(Atom), + Atom. + +atom_badarg(String) -> + {'EXIT',{badarg,_}} = (catch list_to_atom(String)), + {'EXIT',{badarg,_}} = (catch list_to_existing_atom(String)), + ok. + 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), - ?line UnlikelyStr = "dsfj923874390867er869fds9864y97jhg3973qerueoru", + all = list_to_existing_atom("all"), + ?MODULE = list_to_existing_atom(?MODULE_STRING), + UnlikelyStr = "dsfj923874390867er869fds9864y97jhg3973qerueoru", try - ?line list_to_existing_atom(UnlikelyStr), - ?line ?t:fail() + list_to_existing_atom(UnlikelyStr), + ct:fail(atom_exists) catch error:badarg -> ok end, %% The compiler has become smarter! We need the call to id/1 in %% the next line. - ?line UnlikelyAtom = list_to_atom(id(UnlikelyStr)), - ?line UnlikelyAtom = list_to_existing_atom(UnlikelyStr), + UnlikelyAtom = list_to_atom(id(UnlikelyStr)), + UnlikelyAtom = list_to_existing_atom(UnlikelyStr), ok. -os_env(doc) -> - []; -os_env(suite) -> - []; os_env(Config) when is_list(Config) -> - ?line EnvVar1 = "MjhgvFDrresdCghN mnjkUYg vfrD", - ?line false = os:getenv(EnvVar1), - ?line true = os:putenv(EnvVar1, "mors"), - ?line "mors" = os:getenv(EnvVar1), - ?line true = os:putenv(EnvVar1, ""), - ?line case os:getenv(EnvVar1) of - "" -> ?line ok; - false -> ?line ok; - BadVal -> ?line ?t:fail(BadVal) + EnvVar1 = "MjhgvFDrresdCghN mnjkUYg vfrD", + false = os:getenv(EnvVar1), + true = os:putenv(EnvVar1, "mors"), + "mors" = os:getenv(EnvVar1), + true = os:putenv(EnvVar1, ""), + case os:getenv(EnvVar1) of + "" -> ok; + false -> ok; + BadVal -> ct:fail(BadVal) end, true = os:putenv(EnvVar1, "mors"), true = os:unsetenv(EnvVar1), @@ -394,19 +427,18 @@ os_env(Config) when is_list(Config) -> true = os:unsetenv(EnvVar1), % unset unset variable %% os:putenv, os:getenv and os:unsetenv currently use a temp %% buffer of size 1024 for storing key+value - ?line os_env_long(1010, 1030, "hej hopp"). + os_env_long(1010, 1030, "hej hopp"). os_env_long(Min, Max, _Value) when Min > Max -> - ?line ok; + ok; os_env_long(Min, Max, Value) -> - ?line EnvVar = lists:duplicate(Min, $X), - ?line true = os:putenv(EnvVar, Value), - ?line Value = os:getenv(EnvVar), + EnvVar = lists:duplicate(Min, $X), + true = os:putenv(EnvVar, Value), + Value = os:getenv(EnvVar), true = os:unsetenv(EnvVar), - ?line os_env_long(Min+1, Max, Value). + os_env_long(Min+1, Max, Value). -otp_7526(doc) -> - ["Test that string:to_integer does not Halloc in wrong order."]; +%% Test that string:to_integer does not Halloc in wrong order. otp_7526(Config) when is_list(Config) -> ok = test_7526(256). @@ -421,15 +453,15 @@ do_test_7526(N,M) -> {Self, Ref} = {self(), make_ref()}, T = erlang:make_tuple(M,0), spawn_opt(fun()-> - L = iterate_7526(N, []), - BadList = [X || X <- L, X =/= 9223372036854775808], - BadLen = length(BadList), - M = length(tuple_to_list(T)), - %%io:format("~b bad conversions: ~p~n", [BadLen, BadList]), - Self ! {done, Ref, BadLen} - end, - [link,{fullsweep_after,0}]), - receive {done, Ref, Len} -> Len end. + L = iterate_7526(N, []), + BadList = [X || X <- L, X =/= 9223372036854775808], + BadLen = length(BadList), + M = length(tuple_to_list(T)), + %%io:format("~b bad conversions: ~p~n", [BadLen, BadList]), + Self ! {done, Ref, BadLen} + end, + [link,{fullsweep_after,0}]), + receive {done, Ref, Len} -> Len end. test_7526(0) -> @@ -451,59 +483,60 @@ binary_to_atom(Config) when is_list(Config) -> Long = lists:seq(0, 254), LongAtom = list_to_atom(Long), LongBin = list_to_binary(Long), + UnicodeLongAtom = list_to_atom([$é || _ <- lists:seq(0, 254)]), + UnicodeLongBin = << <<"é"/utf8>> || _ <- lists:seq(0, 254)>>, %% latin1 - ?line '' = test_binary_to_atom(<<>>, latin1), - ?line '\377' = test_binary_to_atom(<<255>>, latin1), - ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, latin1), - ?line LongAtom = test_binary_to_atom(LongBin, latin1), + '' = test_binary_to_atom(<<>>, latin1), + '\377' = test_binary_to_atom(<<255>>, latin1), + HalfLongAtom = test_binary_to_atom(HalfLongBin, latin1), + LongAtom = test_binary_to_atom(LongBin, latin1), %% utf8 - ?line '' = test_binary_to_atom(<<>>, utf8), - ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, utf8), - ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, unicode), - ?line [] = [C || C <- lists:seq(128, 255), + '' = test_binary_to_atom(<<>>, utf8), + HalfLongAtom = test_binary_to_atom(HalfLongBin, utf8), + HalfLongAtom = test_binary_to_atom(HalfLongBin, unicode), + UnicodeLongAtom = test_binary_to_atom(UnicodeLongBin, utf8), + UnicodeLongAtom = test_binary_to_atom(UnicodeLongBin, unicode), + [] = [C || C <- lists:seq(128, 255), begin list_to_atom([C]) =/= test_binary_to_atom(<<C/utf8>>, utf8) end], + <<"こんにちは"/utf8>> = + atom_to_binary(test_binary_to_atom(<<"こんにちは"/utf8>>, utf8), utf8), + %% badarg failures. - ?line fail_binary_to_atom(atom), - ?line fail_binary_to_atom(42), - ?line fail_binary_to_atom({a,b,c}), - ?line fail_binary_to_atom([1,2,3]), - ?line fail_binary_to_atom([]), - ?line fail_binary_to_atom(42.0), - ?line fail_binary_to_atom(self()), - ?line fail_binary_to_atom(make_ref()), - ?line fail_binary_to_atom(<<0:7>>), - ?line fail_binary_to_atom(<<42:13>>), - ?line ?BADARG(binary_to_atom(id(<<>>), blurf)), - ?line ?BADARG(binary_to_atom(id(<<>>), [])), + fail_binary_to_atom(atom), + fail_binary_to_atom(42), + fail_binary_to_atom({a,b,c}), + fail_binary_to_atom([1,2,3]), + fail_binary_to_atom([]), + fail_binary_to_atom(42.0), + fail_binary_to_atom(self()), + fail_binary_to_atom(make_ref()), + fail_binary_to_atom(<<0:7>>), + fail_binary_to_atom(<<42:13>>), + ?BADARG(binary_to_atom(id(<<>>), blurf)), + ?BADARG(binary_to_atom(id(<<>>), [])), %% Bad UTF8 sequences. - ?line ?BADARG(binary_to_atom(id(<<255>>), utf8)), - ?line ?BADARG(binary_to_atom(id(<<255,0>>), utf8)), - ?line ?BADARG(binary_to_atom(id(<<16#C0,16#80>>), utf8)), %Overlong 0. - ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || - C <- lists:seq(256, 16#D7FF)], - ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || - C <- lists:seq(16#E000, 16#FFFD)], - ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || - C <- lists:seq(16#10000, 16#8FFFF)], - ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || - C <- lists:seq(16#90000, 16#10FFFF)], + ?BADARG(binary_to_atom(id(<<255>>), utf8)), + ?BADARG(binary_to_atom(id(<<255,0>>), utf8)), + ?BADARG(binary_to_atom(id(<<16#C0,16#80>>), utf8)), %Overlong 0. + <<B:1/binary, _/binary>> = id(<<194, 163>>), %Truncated character ERL-474 + ?BADARG(binary_to_atom(B, utf8)), %% system_limit failures. - ?line ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)), - ?line ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255,0>>), utf8)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, latin1)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, latin1)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, latin1)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, utf8)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, utf8)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, utf8)), + ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)), + ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255,0>>), utf8)), + ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, latin1)), + ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, latin1)), + ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, latin1)), + ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, utf8)), + ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, utf8)), + ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, utf8)), ok. test_binary_to_atom(Bin0, Encoding) -> @@ -516,49 +549,49 @@ test_binary_to_atom(Bin0, Encoding) -> fail_binary_to_atom(Bin) -> try - binary_to_atom(Bin, latin1) + binary_to_atom(Bin, latin1) catch - error:badarg -> - ok + error:badarg -> + ok end, try - binary_to_atom(Bin, utf8) + binary_to_atom(Bin, utf8) catch - error:badarg -> - ok + error:badarg -> + ok end, try - binary_to_existing_atom(Bin, latin1) + binary_to_existing_atom(Bin, latin1) catch - error:badarg -> - ok + error:badarg -> + ok end, try - binary_to_existing_atom(Bin, utf8) + binary_to_existing_atom(Bin, utf8) catch - error:badarg -> - ok + error:badarg -> + ok end. binary_to_existing_atom(Config) when is_list(Config) -> - ?line UnlikelyBin = <<"ou0897979655678dsfj923874390867er869fds973qerueoru">>, + UnlikelyBin = <<"ou0897979655678dsfj923874390867er869fds973qerueoru">>, try - ?line binary_to_existing_atom(UnlikelyBin, latin1), - ?line ?t:fail() + binary_to_existing_atom(UnlikelyBin, latin1), + ct:fail(atom_exists) catch error:badarg -> ok end, try - ?line binary_to_existing_atom(UnlikelyBin, utf8), - ?line ?t:fail() + binary_to_existing_atom(UnlikelyBin, utf8), + ct:fail(atom_exists) catch error:badarg -> ok end, - ?line UnlikelyAtom = binary_to_atom(id(UnlikelyBin), latin1), - ?line UnlikelyAtom = binary_to_existing_atom(UnlikelyBin, latin1), + UnlikelyAtom = binary_to_atom(id(UnlikelyBin), latin1), + UnlikelyAtom = binary_to_existing_atom(UnlikelyBin, latin1), ok. @@ -571,32 +604,32 @@ atom_to_binary(Config) when is_list(Config) -> LongBin = list_to_binary(Long), %% latin1 - ?line <<>> = atom_to_binary('', latin1), - ?line <<"abc">> = atom_to_binary(abc, latin1), - ?line <<127>> = atom_to_binary('\177', latin1), - ?line HalfLongBin = atom_to_binary(HalfLongAtom, latin1), - ?line LongBin = atom_to_binary(LongAtom, latin1), + <<>> = atom_to_binary('', latin1), + <<"abc">> = atom_to_binary(abc, latin1), + <<127>> = atom_to_binary('\177', latin1), + HalfLongBin = atom_to_binary(HalfLongAtom, latin1), + LongBin = atom_to_binary(LongAtom, latin1), %% utf8. - ?line <<>> = atom_to_binary('', utf8), - ?line <<>> = atom_to_binary('', unicode), - ?line <<127>> = atom_to_binary('\177', utf8), - ?line <<"abcdef">> = atom_to_binary(abcdef, utf8), - ?line HalfLongBin = atom_to_binary(HalfLongAtom, utf8), - ?line LongAtomBin = atom_to_binary(LongAtom, utf8), - ?line verify_long_atom_bin(LongAtomBin, 0), + <<>> = atom_to_binary('', utf8), + <<>> = atom_to_binary('', unicode), + <<127>> = atom_to_binary('\177', utf8), + <<"abcdef">> = atom_to_binary(abcdef, utf8), + HalfLongBin = atom_to_binary(HalfLongAtom, utf8), + LongAtomBin = atom_to_binary(LongAtom, utf8), + verify_long_atom_bin(LongAtomBin, 0), %% Failing cases. - ?line fail_atom_to_binary(<<1>>), - ?line fail_atom_to_binary(42), - ?line fail_atom_to_binary({a,b,c}), - ?line fail_atom_to_binary([1,2,3]), - ?line fail_atom_to_binary([]), - ?line fail_atom_to_binary(42.0), - ?line fail_atom_to_binary(self()), - ?line fail_atom_to_binary(make_ref()), - ?line ?BADARG(atom_to_binary(id(a), blurf)), - ?line ?BADARG(atom_to_binary(id(b), [])), + fail_atom_to_binary(<<1>>), + fail_atom_to_binary(42), + fail_atom_to_binary({a,b,c}), + fail_atom_to_binary([1,2,3]), + fail_atom_to_binary([]), + fail_atom_to_binary(42.0), + fail_atom_to_binary(self()), + fail_atom_to_binary(make_ref()), + ?BADARG(atom_to_binary(id(a), blurf)), + ?BADARG(atom_to_binary(id(b), [])), ok. verify_long_atom_bin(<<I/utf8,T/binary>>, I) -> @@ -605,74 +638,73 @@ verify_long_atom_bin(<<>>, 255) -> ok. fail_atom_to_binary(Term) -> try - atom_to_binary(Term, latin1) + atom_to_binary(Term, latin1) catch - error:badarg -> - ok + error:badarg -> + ok end, try - atom_to_binary(Term, utf8) + atom_to_binary(Term, utf8) catch - error:badarg -> - ok + error:badarg -> + ok end. min_max(Config) when is_list(Config) -> - ?line a = erlang:min(id(a), a), - ?line a = erlang:min(id(a), b), - ?line a = erlang:min(id(b), a), - ?line b = erlang:min(id(b), b), - ?line a = erlang:max(id(a), a), - ?line b = erlang:max(id(a), b), - ?line b = erlang:max(id(b), a), - ?line b = erlang:max(id(b), b), - - ?line 42.0 = erlang:min(42.0, 42), - ?line 42.0 = erlang:max(42.0, 42), + a = erlang:min(id(a), a), + a = erlang:min(id(a), b), + a = erlang:min(id(b), a), + b = erlang:min(id(b), b), + a = erlang:max(id(a), a), + b = erlang:max(id(a), b), + b = erlang:max(id(b), a), + b = erlang:max(id(b), b), + + 42.0 = erlang:min(42.0, 42), + 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), - + a = min(id(a), a), + a = min(id(a), b), + a = min(id(b), a), + b = min(id(b), b), + a = max(id(a), a), + b = max(id(a), b), + b = max(id(b), a), + b = max(id(b), b), + + 42.0 = min(42.0, 42), + 42.0 = max(42.0, 42), ok. erlang_halt(Config) when is_list(Config) -> try erlang:halt(undefined) of - _-> ?t:fail({erlang,halt,{undefined}}) + _-> ct:fail({erlang,halt,{undefined}}) catch error:badarg -> ok end, try halt(undefined) of - _-> ?t:fail({halt,{undefined}}) + _-> ct:fail({halt,{undefined}}) catch error:badarg -> ok end, try erlang:halt(undefined, []) of - _-> ?t:fail({erlang,halt,{undefined,[]}}) + _-> ct:fail({erlang,halt,{undefined,[]}}) catch error:badarg -> ok end, try halt(undefined, []) of - _-> ?t:fail({halt,{undefined,[]}}) + _-> ct:fail({halt,{undefined,[]}}) catch error:badarg -> ok end, try halt(0, undefined) of - _-> ?t:fail({halt,{0,undefined}}) + _-> ct:fail({halt,{0,undefined}}) catch error:badarg -> ok end, try halt(0, [undefined]) of - _-> ?t:fail({halt,{0,[undefined]}}) + _-> ct:fail({halt,{0,[undefined]}}) catch error:badarg -> ok end, try halt(0, [{undefined,true}]) of - _-> ?t:fail({halt,{0,[{undefined,true}]}}) + _-> ct:fail({halt,{0,[{undefined,true}]}}) catch error:badarg -> ok end, try halt(0, [{flush,undefined}]) of - _-> ?t:fail({halt,{0,[{flush,undefined}]}}) + _-> ct:fail({halt,{0,[{flush,undefined}]}}) catch error:badarg -> ok end, try halt(0, [{flush,true,undefined}]) of - _-> ?t:fail({halt,{0,[{flush,true,undefined}]}}) + _-> ct:fail({halt,{0,[{flush,true,undefined}]}}) catch error:badarg -> ok end, H = hostname(), {ok,N1} = slave:start(H, halt_node1), @@ -681,8 +713,256 @@ erlang_halt(Config) when is_list(Config) -> {badrpc,nodedown} = rpc:call(N2, erlang, halt, [0]), {ok,N3} = slave:start(H, halt_node3), {badrpc,nodedown} = rpc:call(N3, erlang, halt, [0,[]]), + {ok,N4} = slave:start(H, halt_node4), + {badrpc,nodedown} = rpc:call(N4, erlang, halt, [lists:duplicate(300,$x)]), + %% Test unicode slogan + {ok,N4} = slave:start(H, halt_node4), + {badrpc,nodedown} = rpc:call(N4, erlang, halt, [[339,338,254,230,198,295,167,223,32,12507,12531,12480]]), + + % This test triggers a segfault when dumping a crash dump + % to make sure that we can handle it properly. + {ok,N4} = slave:start(H, halt_node4), + CrashDump = filename:join(proplists:get_value(priv_dir,Config), + "segfault_erl_crash.dump"), + true = rpc:call(N4, os, putenv, ["ERL_CRASH_DUMP",CrashDump]), + false = rpc:call(N4, erts_debug, set_internal_state, + [available_internal_state, true]), + {badrpc,nodedown} = rpc:call(N4, erts_debug, set_internal_state, + [broken_halt, "Validate correct crash dump"]), + {ok,_} = wait_until_stable_size(CrashDump,-1), + {ok, Bin} = file:read_file(CrashDump), + case {string:find(Bin, <<"\n=end\n">>), + string:find(Bin, <<"\r\n=end\r\n">>)} of + {nomatch,nomatch} -> + ct:fail("Could not find end marker in crash dump"); + {_,_} -> + ok + end. + +wait_until_stable_size(_File,-10) -> + {error,enoent}; +wait_until_stable_size(File,PrevSz) -> + timer:sleep(250), + case file:read_file_info(File) of + {error,enoent} -> + wait_until_stable_size(File,PrevSz-1); + {ok,#file_info{size = PrevSz }} when PrevSz /= -1 -> + io:format("Crashdump file size was: ~p (~s)~n",[PrevSz,File]), + {ok,PrevSz}; + {ok,#file_info{size = NewSz }} -> + wait_until_stable_size(File,NewSz) + end. + +% Test erlang:halt with ERL_CRASH_DUMP_BYTES +erl_crash_dump_bytes(Config) when is_list(Config) -> + Bytes = 1000, + CrashDump = do_limited_crash_dump(Config, Bytes), + {ok,ActualBytes} = wait_until_stable_size(CrashDump,-1), + true = ActualBytes < (Bytes + 100), + + NoDump = do_limited_crash_dump(Config,0), + {error,enoent} = wait_until_stable_size(NoDump,-8), ok. +do_limited_crash_dump(Config, Bytes) -> + H = hostname(), + {ok,N} = slave:start(H, halt_node), + BytesStr = integer_to_list(Bytes), + CrashDump = filename:join(proplists:get_value(priv_dir,Config), + "erl_crash." ++ BytesStr ++ ".dump"), + true = rpc:call(N, os, putenv, ["ERL_CRASH_DUMP",CrashDump]), + true = rpc:call(N, os, putenv, ["ERL_CRASH_DUMP_BYTES",BytesStr]), + {badrpc,nodedown} = rpc:call(N, erlang, halt, ["Testing ERL_CRASH_DUMP_BYTES"]), + CrashDump. + + +is_builtin(_Config) -> + Exp0 = [{M,F,A} || {M,_} <- code:all_loaded(), + {F,A} <- M:module_info(exports)], + Exp = ordsets:from_list(Exp0), + + %% Built-ins implemented as special instructions. + Instructions = [{erlang,apply,2},{erlang,apply,3},{erlang,yield,0}], + + Builtins0 = Instructions ++ erlang:system_info(snifs), + Builtins = ordsets:from_list(Builtins0), + + Fakes = [{M,F,42} || {M,F,_} <- Instructions], + All = ordsets:from_list(Fakes ++ Exp), + NotBuiltin = ordsets:subtract(All, Builtins), + + _ = [{true,_} = {erlang:is_builtin(M, F, A),MFA} || + {M,F,A}=MFA <- Builtins], + _ = [{false,_} = {erlang:is_builtin(M, F, A),MFA} || + {M,F,A}=MFA <- NotBuiltin], + + ok. + +error_stacktrace(Config) when is_list(Config) -> + error_stacktrace_test(). + +error_stacktrace_during_call_trace(Config) when is_list(Config) -> + Tracer = spawn_link(fun () -> + receive after infinity -> ok end + end), + Mprog = [{'_',[],[{exception_trace}]}], + erlang:trace_pattern({?MODULE,'_','_'}, Mprog, [local]), + 1 = erlang:trace_pattern({erlang,error,2}, Mprog, [local]), + 1 = erlang:trace_pattern({erlang,error,1}, Mprog, [local]), + erlang:trace(all, true, [call,return_to,timestamp,{tracer, Tracer}]), + try + error_stacktrace_test() + after + erlang:trace(all, false, [call,return_to,timestamp,{tracer, Tracer}]), + erlang:trace_pattern({erlang,error,2}, false, [local]), + erlang:trace_pattern({erlang,error,1}, false, [local]), + erlang:trace_pattern({?MODULE,'_','_'}, false, [local]), + unlink(Tracer), + exit(Tracer, kill), + Mon = erlang:monitor(process, Tracer), + receive + {'DOWN', Mon, process, Tracer, _} -> ok + end + end, + ok. + + +error_stacktrace_test() -> + Types = [apply_const_last, apply_const, apply_last, + apply, double_apply_const_last, double_apply_const, + double_apply_last, double_apply, multi_apply_const_last, + multi_apply_const, multi_apply_last, multi_apply, + call_const_last, call_last, call_const, call], + lists:foreach(fun (Type) -> + {Pid, Mon} = spawn_monitor( + fun () -> + stk([a,b,c,d], Type, error_2) + end), + receive + {'DOWN', Mon, process, Pid, Reason} -> + {oops, Stack} = Reason, +%% io:format("Type: ~p Stack: ~p~n", +%% [Type, Stack]), + [{?MODULE, do_error_2, [Type], _}, + {?MODULE, stk, 3, _}, + {?MODULE, stk, 3, _}] = Stack + end + end, + Types), + lists:foreach(fun (Type) -> + {Pid, Mon} = spawn_monitor( + fun () -> + stk([a,b,c,d], Type, error_1) + end), + receive + {'DOWN', Mon, process, Pid, Reason} -> + {oops, Stack} = Reason, +%% io:format("Type: ~p Stack: ~p~n", +%% [Type, Stack]), + [{?MODULE, do_error_1, 1, _}, + {?MODULE, stk, 3, _}, + {?MODULE, stk, 3, _}] = Stack + end + end, + Types), + ok. + +stk([], Type, Func) -> + tail(Type, Func, jump), + ok; +stk([_|L], Type, Func) -> + stk(L, Type, Func), + ok. + +tail(Type, Func, jump) -> + tail(Type, Func, do); +tail(Type, error_1, do) -> + do_error_1(Type); +tail(Type, error_2, do) -> + do_error_2(Type). + +do_error_2(apply_const_last) -> + erlang:apply(erlang, error, [oops, [apply_const_last]]); +do_error_2(apply_const) -> + erlang:apply(erlang, error, [oops, [apply_const]]), + ok; +do_error_2(apply_last) -> + erlang:apply(id(erlang), id(error), id([oops, [apply_last]])); +do_error_2(apply) -> + erlang:apply(id(erlang), id(error), id([oops, [apply]])), + ok; +do_error_2(double_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const_last]]]); +do_error_2(double_apply_const) -> + erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const]]]), + ok; +do_error_2(double_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply_last]])]); +do_error_2(double_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply]])]), + ok; +do_error_2(multi_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const_last]]]]]); +do_error_2(multi_apply_const) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const]]]]]), + ok; +do_error_2(multi_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply_last]])]]]); +do_error_2(multi_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply]])]]]), + ok; +do_error_2(call_const_last) -> + erlang:error(oops, [call_const_last]); +do_error_2(call_last) -> + erlang:error(id(oops), id([call_last])); +do_error_2(call_const) -> + erlang:error(oops, [call_const]), + ok; +do_error_2(call) -> + erlang:error(id(oops), id([call])). + + +do_error_1(apply_const_last) -> + erlang:apply(erlang, error, [oops]); +do_error_1(apply_const) -> + erlang:apply(erlang, error, [oops]), + ok; +do_error_1(apply_last) -> + erlang:apply(id(erlang), id(error), id([oops])); +do_error_1(apply) -> + erlang:apply(id(erlang), id(error), id([oops])), + ok; +do_error_1(double_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, error, [oops]]); +do_error_1(double_apply_const) -> + erlang:apply(erlang, apply, [erlang, error, [oops]]), + ok; +do_error_1(double_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]); +do_error_1(double_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]), + ok; +do_error_1(multi_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]); +do_error_1(multi_apply_const) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]), + ok; +do_error_1(multi_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]); +do_error_1(multi_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]), + ok; +do_error_1(call_const_last) -> + erlang:error(oops); +do_error_1(call_last) -> + erlang:error(id(oops)); +do_error_1(call_const) -> + erlang:error(oops), + ok; +do_error_1(call) -> + erlang:error(id(oops)). + + %% Helpers diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl index 413bd3bcae..5939d024ae 100644 --- a/erts/emulator/test/big_SUITE.erl +++ b/erts/emulator/test/big_SUITE.erl @@ -1,29 +1,31 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(big_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0, groups/0]). + -export([t_div/1, eq_28/1, eq_32/1, eq_big/1, eq_math/1, big_literals/1, borders/1, negative/1, big_float_1/1, big_float_2/1, - shift_limit_1/1, powmod/1, system_limit/1, otp_6692/1]). + bxor_2pow/1, + shift_limit_1/1, powmod/1, system_limit/1, toobig/1, otp_6692/1]). %% Internal exports. -export([eval/1]). @@ -31,41 +33,22 @@ -export([fac/1, fib/1, pow/2, gcd/2, lcm/2]). --export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [t_div, eq_28, eq_32, eq_big, eq_math, big_literals, borders, negative, {group, big_float}, shift_limit_1, - powmod, system_limit, otp_6692]. + bxor_2pow, + powmod, system_limit, toobig, otp_6692]. groups() -> [{big_float, [], [big_float_1, big_float_2]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - %% %% Syntax of data files: %% Expr1 = Expr2. @@ -94,7 +77,7 @@ eq_math(Config) when is_list(Config) -> test(TestFile). -borders(doc) -> "Tests border cases between small/big."; +%% Tests border cases between small/big. borders(Config) when is_list(Config) -> TestFile = test_file(Config, "borders.dat"), test(TestFile). @@ -106,7 +89,7 @@ negative(Config) when is_list(Config) -> %% Find test file test_file(Config, Name) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), filename:join(DataDir, Name). %% @@ -118,12 +101,12 @@ test(File) -> test(File, [node()]). test(File, Nodes) -> - ?line {ok,Fd} = file:open(File, [read]), + {ok,Fd} = file:open(File, [read]), Res = test(File, Fd, Nodes), file:close(Fd), case Res of {0,Cases} -> {comment, integer_to_list(Cases) ++ " cases"}; - {_,_} -> test_server:fail() + {_,_} -> ct:fail("failed") end. test(File, Fd, Ns) -> @@ -155,7 +138,7 @@ multi_match(Ns, Expr) -> multi_match(Ns, Expr, []). multi_match([Node|Ns], Expr, Rs) -> - ?line X = rpc:call(Node, big_SUITE, eval, [Expr]), + X = rpc:call(Node, big_SUITE, eval, [Expr]), if X == 0 -> multi_match(Ns, Expr, Rs); true -> multi_match(Ns, Expr, [{Node,X}|Rs]) end; @@ -247,10 +230,10 @@ lcm(Q, R) -> %% Test case t_div cut in from R2D test suite. t_div(Config) when is_list(Config) -> - ?line 'try'(fun() -> 98765432101234 div 98765432101235 end, 0), + 'try'(fun() -> 98765432101234 div 98765432101235 end, 0), % Big remainder, small quotient. - ?line 'try'(fun() -> 339254531512 div 68719476736 end, 4), + 'try'(fun() -> 339254531512 div 68719476736 end, 4), ok. 'try'(Fun, Result) -> @@ -264,65 +247,60 @@ t_div(Config) when is_list(Config) -> {result, Result} -> 'try'(Iter-1, Fun, Result, [0|Filler]); {result, Other} -> - io:format("Expected ~p; got ~p~n", [Result, Other]), - test_server:fail() + ct:fail("Expected ~p; got ~p~n", [Result, Other]) end. init(ReplyTo, Fun, _Filler) -> ReplyTo ! {result, Fun()}. -big_literals(doc) -> - "Tests that big-number literals work correctly."; +%% Tests that big-number literals work correctly. big_literals(Config) when is_list(Config) -> %% Note: The literal test cannot be compiler on a pre-R4 Beam emulator, %% so we compile it now. - ?line DataDir = ?config(data_dir, Config), - ?line Test = filename:join(DataDir, "literal_test"), - ?line {ok, Mod, Bin} = compile:file(Test, [binary]), - ?line {module, Mod} = code:load_binary(Mod, Mod, Bin), - ?line ok = Mod:t(), + DataDir = proplists:get_value(data_dir, Config), + Test = filename:join(DataDir, "literal_test"), + {ok, Mod, Bin} = compile:file(Test, [binary]), + {module, Mod} = code:load_binary(Mod, Mod, Bin), + ok = Mod:t(), ok. -big_float_1(doc) -> - ["OTP-2436, part 1"]; +%% OTP-2436, part 1 big_float_1(Config) when is_list(Config) -> %% F is a number very close to a maximum float. - ?line F = id(1.7e308), - ?line I = trunc(F), - ?line true = (I == F), - ?line false = (I /= F), - ?line true = (I > F/2), - ?line false = (I =< F/2), - ?line true = (I*2 >= F), - ?line false = (I*2 < F), - ?line true = (I*I > F), - ?line false = (I*I =< F), - - ?line true = (F == I), - ?line false = (F /= I), - ?line false = (F/2 > I), - ?line true = (F/2 =< I), - ?line false = (F >= I*2), - ?line true = (F < I*2), - ?line false = (F > I*I), - ?line true = (F =< I*I), + F = id(1.7e308), + I = trunc(F), + true = (I == F), + false = (I /= F), + true = (I > F/2), + false = (I =< F/2), + true = (I*2 >= F), + false = (I*2 < F), + true = (I*I > F), + false = (I*I =< F), + + true = (F == I), + false = (F /= I), + false = (F/2 > I), + true = (F/2 =< I), + false = (F >= I*2), + true = (F < I*2), + false = (F > I*I), + true = (F =< I*I), ok. -big_float_2(doc) -> - ["OTP-2436, part 2"]; +%% "OTP-2436, part 2 big_float_2(Config) when is_list(Config) -> - ?line F = id(1.7e308), - ?line I = trunc(F), - ?line {'EXIT', _} = (catch 1/(2*I)), - ?line _Ignore = 2/I, - ?line {'EXIT', _} = (catch 4/(2*I)), + F = id(1.7e308), + I = trunc(F), + {'EXIT', _} = (catch 1/(2*I)), + _Ignore = 2/I, + {'EXIT', _} = (catch 4/(2*I)), ok. -shift_limit_1(doc) -> - ["OTP-3256"]; +%% OTP-3256 shift_limit_1(Config) when is_list(Config) -> - ?line case catch (id(1) bsl 100000000) of + case catch (id(1) bsl 100000000) of {'EXIT', {system_limit, _}} -> ok end, @@ -351,16 +329,23 @@ powmod(A, B, C) -> end. system_limit(Config) when is_list(Config) -> - ?line Maxbig = maxbig(), - ?line {'EXIT',{system_limit,_}} = (catch Maxbig+1), - ?line {'EXIT',{system_limit,_}} = (catch -Maxbig-1), - ?line {'EXIT',{system_limit,_}} = (catch 2*Maxbig), - ?line {'EXIT',{system_limit,_}} = (catch bnot Maxbig), - ?line {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bnot'), [Maxbig])), - ?line {'EXIT',{system_limit,_}} = (catch Maxbig bsl 2), - ?line {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])), - ?line {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)), - ?line {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)), + Maxbig = maxbig(), + {'EXIT',{system_limit,_}} = (catch Maxbig+1), + {'EXIT',{system_limit,_}} = (catch -Maxbig-1), + {'EXIT',{system_limit,_}} = (catch 2*Maxbig), + {'EXIT',{system_limit,_}} = (catch bnot Maxbig), + {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bnot'), [Maxbig])), + {'EXIT',{system_limit,_}} = (catch Maxbig bsl 2), + {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])), + {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)), + {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)), + + %% There should be no system_limit exception when shifting a zero. + 0 = id(0) bsl (1 bsl 128), + 0 = id(0) bsr -(1 bsl 128), + Erlang = id(erlang), + 0 = Erlang:'bsl'(id(0), 1 bsl 128), + 0 = Erlang:'bsr'(id(0), -(1 bsl 128)), ok. maxbig() -> @@ -370,12 +355,19 @@ maxbig() -> id(I) -> I. -otp_6692(suite) -> - []; -otp_6692(doc) -> - ["Tests for DIV/REM bug reported in OTP-6692"]; +toobig(Config) when is_list(Config) -> + {'EXIT',{{badmatch,_},_}} = (catch toobig()), + ok. + +toobig() -> + A = erlang:term_to_binary(lists:seq(1000000, 2200000)), + ASize = erlang:bit_size(A), + <<ANr:ASize>> = A, % should fail + ANr band ANr. + +%% Tests for DIV/REM bug reported in OTP-6692 otp_6692(Config) when is_list(Config)-> - ?line loop1(1,1000). + loop1(1,1000). fact(N) -> fact(N,1). @@ -413,3 +405,54 @@ loop2(X,Y,N,M) -> end, loop2(X,Y,N+1,M). + +%% ERL-450 +bxor_2pow(_Config) -> + IL = lists:seq(8*3, 8*16, 4), + JL = lists:seq(0, 64), + [bxor_2pow_1((1 bsl I), (1 bsl J)) + || I <- IL, J <- JL], + ok. + +bxor_2pow_1(A, B) -> + for(-1,1, fun(Ad) -> + for(-1,1, fun(Bd) -> + bxor_2pow_2(A+Ad, B+Bd), + bxor_2pow_2(-A+Ad, B+Bd), + bxor_2pow_2(A+Ad, -B+Bd), + bxor_2pow_2(-A+Ad, -B+Bd) + end) + end). + +for(From, To, _Fun) when From > To -> + ok; +for(From, To, Fun) -> + Fun(From), + for(From+1, To, Fun). + +bxor_2pow_2(A, B) -> + Correct = my_bxor(A, B), + case A bxor B of + Correct -> ok; + Wrong -> + io:format("~.16b bxor ~.16b\n", [A,B]), + io:format("Expected ~.16b\n", [Correct]), + io:format("Got ~.16b\n", [Wrong]), + ct:fail({failed, 'bxor'}) + + end. + +%% Implement bxor without bxor +my_bxor(A, B) -> + my_bxor(A, B, 0, 0). + +my_bxor(0, 0, _, Acc) -> Acc; +my_bxor(-1, -1, _, Acc) -> Acc; +my_bxor(-1, 0, N, Acc) -> (-1 bsl N) bor Acc; % sign extension +my_bxor(0, -1, N, Acc) -> (-1 bsl N) bor Acc; % sign extension +my_bxor(A, B, N, Acc0) -> + Acc1 = case (A band 1) =:= (B band 1) of + true -> Acc0; + false -> Acc0 bor (1 bsl N) + end, + my_bxor(A bsr 1, B bsr 1, N+1, Acc1). diff --git a/erts/emulator/test/big_SUITE_data/borders.dat b/erts/emulator/test/big_SUITE_data/borders.dat index 52e4f35861..c38ff93383 100644 --- a/erts/emulator/test/big_SUITE_data/borders.dat +++ b/erts/emulator/test/big_SUITE_data/borders.dat @@ -1114,3 +1114,38 @@ 1 = 16#800000000000001 rem (-16#800000000000000). 0 = 16#FFFFFFFFFFFFFFF800000000 rem 16#FFFFFFFFFFFFFFF80. +% ERL-450 bxor of big negative 2-pow +-(1 bsl 8) bxor -1 = 16#ff. +-(1 bsl 16) bxor -1 = 16#ffff. +-(1 bsl 24) bxor -1 = 16#ffffff. +-(1 bsl 32) bxor -1 = 16#ffffffff. +-(1 bsl 40) bxor -1 = 16#ffffffffff. +-(1 bsl 48) bxor -1 = 16#ffffffffffff. +-(1 bsl 56) bxor -1 = 16#ffffffffffffff. +-(1 bsl 64) bxor -1 = 16#ffffffffffffffff. +-(1 bsl 72) bxor -1 = 16#ffffffffffffffffff. +-(1 bsl 80) bxor -1 = 16#ffffffffffffffffffff. +-(1 bsl 88) bxor -1 = 16#ffffffffffffffffffffff. +-(1 bsl 96) bxor -1 = 16#ffffffffffffffffffffffff. +-(1 bsl 104) bxor -1 = 16#ffffffffffffffffffffffffff. +-(1 bsl 112) bxor -1 = 16#ffffffffffffffffffffffffffff. +-(1 bsl 120) bxor -1 = 16#ffffffffffffffffffffffffffffff. +-(1 bsl 128) bxor -1 = 16#ffffffffffffffffffffffffffffffff. +-(1 bsl 136) bxor -1 = 16#ffffffffffffffffffffffffffffffffff. +-(1 bsl 8) bxor 1 = -16#ff. +-(1 bsl 16) bxor 1 = -16#ffff. +-(1 bsl 24) bxor 1 = -16#ffffff. +-(1 bsl 32) bxor 1 = -16#ffffffff. +-(1 bsl 40) bxor 1 = -16#ffffffffff. +-(1 bsl 48) bxor 1 = -16#ffffffffffff. +-(1 bsl 56) bxor 1 = -16#ffffffffffffff. +-(1 bsl 64) bxor 1 = -16#ffffffffffffffff. +-(1 bsl 72) bxor 1 = -16#ffffffffffffffffff. +-(1 bsl 80) bxor 1 = -16#ffffffffffffffffffff. +-(1 bsl 88) bxor 1 = -16#ffffffffffffffffffffff. +-(1 bsl 96) bxor 1 = -16#ffffffffffffffffffffffff. +-(1 bsl 104) bxor 1 = -16#ffffffffffffffffffffffffff. +-(1 bsl 112) bxor 1 = -16#ffffffffffffffffffffffffffff. +-(1 bsl 120) bxor 1 = -16#ffffffffffffffffffffffffffffff. +-(1 bsl 128) bxor 1 = -16#ffffffffffffffffffffffffffffffff. +-(1 bsl 136) bxor 1 = -16#ffffffffffffffffffffffffffffffffff. diff --git a/erts/emulator/test/big_SUITE_data/literal_test.erl b/erts/emulator/test/big_SUITE_data/literal_test.erl index dc0adeb1ca..17c4db467a 100644 --- a/erts/emulator/test/big_SUITE_data/literal_test.erl +++ b/erts/emulator/test/big_SUITE_data/literal_test.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 7aba367e33..61536bacd7 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -1,24 +1,24 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(binary_SUITE). --compile({nowarn_deprecated_function, {erlang,hash,2}}). %% Tests binaries and the BIFs: %% list_to_binary/1 @@ -39,7 +39,7 @@ %% phash2(Binary, N) %% --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, @@ -58,7 +58,8 @@ ordering/1,unaligned_order/1,gc_test/1, bit_sized_binary_sizes/1, otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1, - otp_8180/1, trapping/1]). + otp_8180/1, trapping/1, large/1, + error_after_yield/1, cmp_old_impl/1]). %% Internal exports. -export([sleeper/0,trapping_loop/4]). @@ -76,7 +77,8 @@ all() -> bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep, - obsolete_funs, robustness, otp_8180, trapping]. + obsolete_funs, robustness, otp_8180, trapping, large, + error_after_yield, cmp_old_impl]. groups() -> []. @@ -103,17 +105,17 @@ end_per_testcase(_Func, _Config) -> copy_terms(Config) when is_list(Config) -> Self = self(), - ?line Pid = spawn_link(fun() -> copy_server(Self) end), + Pid = spawn_link(fun() -> copy_server(Self) end), F = fun(Term) -> Pid ! Term, receive Term -> ok; Other -> io:format("Sent: ~P\nGot back:~P", [Term,12,Other,12]), - ?t:fail(bad_term) + ct:fail(bad_term) end end, - ?line test_terms(F), + test_terms(F), ok. copy_server(Parent) -> @@ -126,154 +128,152 @@ copy_server(Parent) -> %% Tests list_to_binary/1, binary_to_list/1 and size/1, %% using flat lists. -conversions(suite) -> []; conversions(Config) when is_list(Config) -> - ?line test_bin([]), - ?line test_bin([1]), - ?line test_bin([1, 2]), - ?line test_bin([1, 2, 3]), - ?line test_bin(lists:seq(0, ?heap_binary_size)), - ?line test_bin(lists:seq(0, ?heap_binary_size+1)), - ?line test_bin(lists:seq(0, 255)), - ?line test_bin(lists:duplicate(50000, $@)), + test_bin([]), + test_bin([1]), + test_bin([1, 2]), + test_bin([1, 2, 3]), + test_bin(lists:seq(0, ?heap_binary_size)), + test_bin(lists:seq(0, ?heap_binary_size+1)), + test_bin(lists:seq(0, 255)), + test_bin(lists:duplicate(50000, $@)), %% Binary in list. List = [1,2,3,4,5], - ?line B1 = make_sub_binary(list_to_binary(List)), - ?line 5 = size(B1), - ?line 5 = size(make_unaligned_sub_binary(B1)), - ?line 40 = bit_size(B1), - ?line 40 = bit_size(make_unaligned_sub_binary(B1)), - ?line B2 = list_to_binary([42,B1,19]), - ?line B2 = list_to_binary([42,make_unaligned_sub_binary(B1),19]), - ?line B2 = iolist_to_binary(B2), - ?line B2 = iolist_to_binary(make_unaligned_sub_binary(B2)), - ?line 7 = size(B2), - ?line 7 = size(make_sub_binary(B2)), - ?line 56 = bit_size(B2), - ?line 56 = bit_size(make_sub_binary(B2)), - ?line [42,1,2,3,4,5,19] = binary_to_list(B2), - ?line [42,1,2,3,4,5,19] = binary_to_list(make_sub_binary(B2)), - ?line [42,1,2,3,4,5,19] = binary_to_list(make_unaligned_sub_binary(B2)), - ?line [42,1,2,3,4,5,19] = bitstring_to_list(B2), - ?line [42,1,2,3,4,5,19] = bitstring_to_list(make_sub_binary(B2)), - ?line [42,1,2,3,4,5,19] = bitstring_to_list(make_unaligned_sub_binary(B2)), + B1 = make_sub_binary(list_to_binary(List)), + 5 = size(B1), + 5 = size(make_unaligned_sub_binary(B1)), + 40 = bit_size(B1), + 40 = bit_size(make_unaligned_sub_binary(B1)), + B2 = list_to_binary([42,B1,19]), + B2 = list_to_binary([42,make_unaligned_sub_binary(B1),19]), + B2 = iolist_to_binary(B2), + B2 = iolist_to_binary(make_unaligned_sub_binary(B2)), + 7 = size(B2), + 7 = size(make_sub_binary(B2)), + 56 = bit_size(B2), + 56 = bit_size(make_sub_binary(B2)), + [42,1,2,3,4,5,19] = binary_to_list(B2), + [42,1,2,3,4,5,19] = binary_to_list(make_sub_binary(B2)), + [42,1,2,3,4,5,19] = binary_to_list(make_unaligned_sub_binary(B2)), + [42,1,2,3,4,5,19] = bitstring_to_list(B2), + [42,1,2,3,4,5,19] = bitstring_to_list(make_sub_binary(B2)), + [42,1,2,3,4,5,19] = bitstring_to_list(make_unaligned_sub_binary(B2)), ok. test_bin(List) -> - ?line Size = length(List), - ?line Bin = list_to_binary(List), - ?line Bin = iolist_to_binary(List), - ?line Bin = list_to_bitstring(List), - ?line Size = iolist_size(List), - ?line Size = iolist_size(Bin), - ?line Size = iolist_size(make_unaligned_sub_binary(Bin)), - ?line Size = size(Bin), - ?line Size = size(make_sub_binary(Bin)), - ?line Size = size(make_unaligned_sub_binary(Bin)), - ?line List = binary_to_list(Bin), - ?line List = binary_to_list(make_sub_binary(Bin)), - ?line List = binary_to_list(make_unaligned_sub_binary(Bin)), - ?line List = bitstring_to_list(Bin), - ?line List = bitstring_to_list(make_unaligned_sub_binary(Bin)). + Size = length(List), + Bin = list_to_binary(List), + Bin = iolist_to_binary(List), + Bin = list_to_bitstring(List), + Size = iolist_size(List), + Size = iolist_size(Bin), + Size = iolist_size(make_unaligned_sub_binary(Bin)), + Size = size(Bin), + Size = size(make_sub_binary(Bin)), + Size = size(make_unaligned_sub_binary(Bin)), + List = binary_to_list(Bin), + List = binary_to_list(make_sub_binary(Bin)), + List = binary_to_list(make_unaligned_sub_binary(Bin)), + List = bitstring_to_list(Bin), + List = bitstring_to_list(make_unaligned_sub_binary(Bin)). %% Tests list_to_binary/1, iolist_to_binary/1, list_to_bitstr/1, binary_to_list/1,3, %% bitstr_to_list/1, and size/1, using deep lists. deep_lists(Config) when is_list(Config) -> - ?line test_deep_list(["abc"]), - ?line test_deep_list([[12,13,[123,15]]]), - ?line test_deep_list([[12,13,[lists:seq(0, 255), []]]]), + test_deep_list(["abc"]), + test_deep_list([[12,13,[123,15]]]), + test_deep_list([[12,13,[lists:seq(0, 255), []]]]), ok. test_deep_list(List) -> - ?line FlatList = lists:flatten(List), - ?line Size = length(FlatList), - ?line Bin = list_to_binary(List), - ?line Bin = iolist_to_binary(List), - ?line Bin = iolist_to_binary(Bin), - ?line Bin = list_to_bitstring(List), - ?line Size = size(Bin), - ?line Size = iolist_size(List), - ?line Size = iolist_size(FlatList), - ?line Size = iolist_size(Bin), - ?line Bitsize = bit_size(Bin), - ?line Bitsize = 8*Size, - ?line FlatList = binary_to_list(Bin), - ?line FlatList = bitstring_to_list(Bin), + FlatList = lists:flatten(List), + Size = length(FlatList), + Bin = list_to_binary(List), + Bin = iolist_to_binary(List), + Bin = iolist_to_binary(Bin), + Bin = list_to_bitstring(List), + Size = size(Bin), + Size = iolist_size(List), + Size = iolist_size(FlatList), + Size = iolist_size(Bin), + Bitsize = bit_size(Bin), + Bitsize = 8*Size, + FlatList = binary_to_list(Bin), + FlatList = bitstring_to_list(Bin), io:format("testing plain binary..."), - ?line t_binary_to_list_3(FlatList, Bin, 1, Size), + t_binary_to_list_3(FlatList, Bin, 1, Size), io:format("testing unaligned sub binary..."), - ?line t_binary_to_list_3(FlatList, make_unaligned_sub_binary(Bin), 1, Size). + t_binary_to_list_3(FlatList, make_unaligned_sub_binary(Bin), 1, Size). t_binary_to_list_3(List, Bin, From, To) -> - ?line going_up(List, Bin, From, To), - ?line going_down(List, Bin, From, To), - ?line going_center(List, Bin, From, To). + going_up(List, Bin, From, To), + going_down(List, Bin, From, To), + going_center(List, Bin, From, To). going_up(List, Bin, From, To) when From =< To -> - ?line List = binary_to_list(Bin, From, To), - ?line going_up(tl(List), Bin, From+1, To); + List = binary_to_list(Bin, From, To), + going_up(tl(List), Bin, From+1, To); going_up(_List, _Bin, From, To) when From > To -> ok. going_down(List, Bin, From, To) when To > 0-> - ?line compare(List, binary_to_list(Bin, From, To), To-From+1), - ?line going_down(List, Bin, From, To-1); + compare(List, binary_to_list(Bin, From, To), To-From+1), + going_down(List, Bin, From, To-1); going_down(_List, _Bin, _From, _To) -> ok. going_center(List, Bin, From, To) when From >= To -> - ?line compare(List, binary_to_list(Bin, From, To), To-From+1), - ?line going_center(tl(List), Bin, From+1, To-1); + compare(List, binary_to_list(Bin, From, To), To-From+1), + going_center(tl(List), Bin, From+1, To-1); going_center(_List, _Bin, _From, _To) -> ok. compare([X|Rest1], [X|Rest2], Left) when Left > 0 -> - ?line compare(Rest1, Rest2, Left-1); + compare(Rest1, Rest2, Left-1); compare([_X|_], [_Y|_], _Left) -> - ?line test_server:fail(); + ct:fail("compare fail"); compare(_List, [], 0) -> ok. deep_bitstr_lists(Config) when is_list(Config) -> - ?line {<<7:3>>,[<<7:3>>]} = test_deep_bitstr([<<7:3>>]), - ?line {<<42,5:3>>=Bin,[42,<<5:3>>]=List} = test_deep_bitstr([42,<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([42|<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([<<42,5:3>>]), - ?line {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>|<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>,<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([[<<1:3>>,<<10:5>>],[],<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([[[<<1:3>>]|<<10:5>>],[],<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([[<<0:1>>,<<0:1>>,[],<<1:1>>,<<10:5>>], + {<<7:3>>,[<<7:3>>]} = test_deep_bitstr([<<7:3>>]), + {<<42,5:3>>=Bin,[42,<<5:3>>]=List} = test_deep_bitstr([42,<<5:3>>]), + {Bin,List} = test_deep_bitstr([42|<<5:3>>]), + {Bin,List} = test_deep_bitstr([<<42,5:3>>]), + {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>|<<5:3>>]), + {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>,<<5:3>>]), + {Bin,List} = test_deep_bitstr([[<<1:3>>,<<10:5>>],[],<<5:3>>]), + {Bin,List} = test_deep_bitstr([[[<<1:3>>]|<<10:5>>],[],<<5:3>>]), + {Bin,List} = test_deep_bitstr([[<<0:1>>,<<0:1>>,[],<<1:1>>,<<10:5>>], <<1:1>>,<<0:1>>,<<1:1>>]), ok. test_deep_bitstr(List) -> - %%?line {'EXIT',{badarg,_}} = list_to_binary(List), + %%{'EXIT',{badarg,_}} = list_to_binary(List), Bin = list_to_bitstring(List), {Bin,bitstring_to_list(Bin)}. -bad_list_to_binary(suite) -> []; bad_list_to_binary(Config) when is_list(Config) -> - ?line test_bad_bin(atom), - ?line test_bad_bin(42), - ?line test_bad_bin([1|2]), - ?line test_bad_bin([256]), - ?line test_bad_bin([255, [256]]), - ?line test_bad_bin([-1]), - ?line test_bad_bin([atom_in_list]), - ?line test_bad_bin([[<<8>>]|bad_tail]), + test_bad_bin(atom), + test_bad_bin(42), + test_bad_bin([1|2]), + test_bad_bin([256]), + test_bad_bin([255, [256]]), + test_bad_bin([-1]), + test_bad_bin([atom_in_list]), + test_bad_bin([[<<8>>]|bad_tail]), {'EXIT',{badarg,_}} = (catch list_to_binary(id(<<1,2,3>>))), {'EXIT',{badarg,_}} = (catch list_to_binary(id([<<42:7>>]))), {'EXIT',{badarg,_}} = (catch list_to_bitstring(id(<<1,2,3>>))), %% Funs used to be implemented as a type of binary internally. - ?line test_bad_bin(fun(X, Y) -> X*Y end), - ?line test_bad_bin([1,fun(X) -> X + 1 end,2|fun() -> 0 end]), - ?line test_bad_bin([fun(X) -> X + 1 end]), + test_bad_bin(fun(X, Y) -> X*Y end), + test_bad_bin([1,fun(X) -> X + 1 end,2|fun() -> 0 end]), + test_bad_bin([fun(X) -> X + 1 end]), %% Test iolists that do not fit in the address space. %% Unfortunately, it would be too slow to test in a 64-bit emulator. @@ -284,15 +284,15 @@ bad_list_to_binary(Config) when is_list(Config) -> huge_iolists() -> FourGigs = 1 bsl 32, - ?line Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++ + Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++ [1 bsl N || N <- lists:seq(33, 37)], - ?line Base = <<0:(1 bsl 20)/unit:8>>, + Base = <<0:(1 bsl 20)/unit:8>>, [begin L = build_iolist(Sz, Base), - ?line {'EXIT',{system_limit,_}} = (catch list_to_binary([L])), - ?line {'EXIT',{system_limit,_}} = (catch list_to_bitstring([L])), - ?line {'EXIT',{system_limit,_}} = (catch binary:list_to_bin([L])), - ?line {'EXIT',{system_limit,_}} = (catch iolist_to_binary(L)) + {'EXIT',{system_limit,_}} = (catch list_to_binary([L])), + {'EXIT',{system_limit,_}} = (catch list_to_bitstring([L])), + {'EXIT',{system_limit,_}} = (catch binary:list_to_bin([L])), + {'EXIT',{system_limit,_}} = (catch iolist_to_binary(L)) end || Sz <- Sizes], ok. @@ -302,15 +302,15 @@ test_bad_bin(List) -> {'EXIT',{badarg,_}} = (catch list_to_bitstring(List)), {'EXIT',{badarg,_}} = (catch iolist_size(List)). -bad_binary_to_list(doc) -> "Tries binary_to_list/1,3 with bad arguments."; +%% Tries binary_to_list/1,3 with bad arguments. bad_binary_to_list(Config) when is_list(Config) -> - ?line bad_bin_to_list(fun(X) -> X * 42 end), + bad_bin_to_list(fun(X) -> X * 42 end), GoodBin = list_to_binary(lists:seq(1, 10)), - ?line bad_bin_to_list(fun(X) -> X * 44 end, 1, 2), - ?line bad_bin_to_list(GoodBin, 0, 1), - ?line bad_bin_to_list(GoodBin, 2, 1), - ?line bad_bin_to_list(GoodBin, 11, 11), + bad_bin_to_list(fun(X) -> X * 44 end, 1, 2), + bad_bin_to_list(GoodBin, 0, 1), + bad_bin_to_list(GoodBin, 2, 1), + bad_bin_to_list(GoodBin, 11, 11), {'EXIT',{badarg,_}} = (catch binary_to_list(id(<<42:7>>))), ok. @@ -324,63 +324,61 @@ bad_bin_to_list(Bin, First, Last) -> %% Tries to split a binary at all possible positions. -t_split_binary(suite) -> []; t_split_binary(Config) when is_list(Config) -> - ?line L = lists:seq(0, ?heap_binary_size-5), %Heap binary. - ?line B = list_to_binary(L), - ?line split(L, B, size(B)), + L = lists:seq(0, ?heap_binary_size-5), %Heap binary. + B = list_to_binary(L), + split(L, B, size(B)), %% Sub binary of heap binary. - ?line split(L, make_sub_binary(B), size(B)), + split(L, make_sub_binary(B), size(B)), {X,_Y} = split_binary(B, size(B) div 2), - ?line split(binary_to_list(X), X, size(X)), + split(binary_to_list(X), X, size(X)), %% Unaligned sub binary of heap binary. - ?line split(L, make_unaligned_sub_binary(B), size(B)), + split(L, make_unaligned_sub_binary(B), size(B)), {X,_Y} = split_binary(B, size(B) div 2), - ?line split(binary_to_list(X), X, size(X)), + split(binary_to_list(X), X, size(X)), %% Reference-counted binary. - ?line L2 = lists:seq(0, ?heap_binary_size+1), - ?line B2 = list_to_binary(L2), - ?line split(L2, B2, size(B2)), + L2 = lists:seq(0, ?heap_binary_size+1), + B2 = list_to_binary(L2), + split(L2, B2, size(B2)), %% Sub binary of reference-counted binary. - ?line split(L2, make_sub_binary(B2), size(B2)), + split(L2, make_sub_binary(B2), size(B2)), {X2,_Y2} = split_binary(B2, size(B2) div 2), - ?line split(binary_to_list(X2), X2, size(X2)), + split(binary_to_list(X2), X2, size(X2)), %% Unaligned sub binary of reference-counted binary. - ?line split(L2, make_unaligned_sub_binary(B2), size(B2)), + split(L2, make_unaligned_sub_binary(B2), size(B2)), {X2,_Y2} = split_binary(B2, size(B2) div 2), - ?line split(binary_to_list(X2), X2, size(X2)), + split(binary_to_list(X2), X2, size(X2)), ok. split(L, B, Pos) when Pos > 0 -> - ?line {B1, B2} = split_binary(B, Pos), - ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)), - ?line B2 = list_to_binary(lists:nthtail(Pos, L)), - ?line split(L, B, Pos-1); + {B1, B2} = split_binary(B, Pos), + B1 = list_to_binary(lists:sublist(L, 1, Pos)), + B2 = list_to_binary(lists:nthtail(Pos, L)), + split(L, B, Pos-1); split(_L, _B, 0) -> ok. -bad_split(doc) -> "Tries split_binary/2 with bad arguments."; -bad_split(suite) -> []; +%% Tries split_binary/2 with bad arguments. bad_split(Config) when is_list(Config) -> GoodBin = list_to_binary([1,2,3]), - ?line bad_split(GoodBin, -1), - ?line bad_split(GoodBin, 4), - ?line bad_split(GoodBin, a), + bad_split(GoodBin, -1), + bad_split(GoodBin, 4), + bad_split(GoodBin, a), %% Funs are a kind of binaries. - ?line bad_split(fun(_X) -> 1 end, 1), + bad_split(fun(_X) -> 1 end, 1), ok. bad_split(Bin, Pos) -> {'EXIT',{badarg,_}} = (catch split_binary(Bin, Pos)). -t_hash(doc) -> "Test hash/2 with different type of binaries."; +%% Test hash/2 with different type of binaries. t_hash(Config) when is_list(Config) -> test_hash([]), test_hash([253]), @@ -393,36 +391,33 @@ test_hash(List) -> Bin = list_to_binary(List), Sbin = make_sub_binary(List), Unaligned = make_unaligned_sub_binary(Sbin), - ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:hash/2), - ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash/2), - ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash2/2). + test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash/2), + test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash2/2). test_hash_1(Bin, Sbin, Unaligned, Hash) when is_function(Hash, 2) -> N = 65535, case {Hash(Bin, N),Hash(Sbin, N),Hash(Unaligned, N)} of {H,H,H} -> ok; {H1,H2,H3} -> - io:format("Different hash values: ~p, ~p, ~p\n", [H1,H2,H3]), - ?t:fail() + ct:fail("Different hash values: ~p, ~p, ~p\n", [H1,H2,H3]) end. -bad_size(doc) -> "Try bad arguments to size/1."; -bad_size(suite) -> []; +%% Try bad arguments to size/1. bad_size(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = (catch size(fun(X) -> X + 33 end)), + {'EXIT',{badarg,_}} = (catch size(fun(X) -> X + 33 end)), ok. bad_term_to_binary(Config) when is_list(Config) -> T = id({a,b,c}), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, not_a_list)), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [blurf])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,-1}])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,10}])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,cucumber}])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed}])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{version,1}|bad_tail])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,-1}])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,x}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, not_a_list)), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [blurf])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,-1}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,10}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,cucumber}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{version,1}|bad_tail])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,-1}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,x}])), ok. @@ -461,7 +456,7 @@ terms(Config) when is_list(Config) -> UnalignedC = make_unaligned_sub_binary(BinC), Term = binary_to_term_stress(UnalignedC) end, - ?line test_terms(TestFun), + test_terms(TestFun), ok. terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 -> @@ -473,7 +468,7 @@ terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 -> terms_compression_levels(_, _, _) -> ok. terms_float(Config) when is_list(Config) -> - ?line test_floats(fun(Term) -> + test_floats(fun(Term) -> Bin0 = term_to_binary(Term, [{minor_version,0}]), Term = binary_to_term_stress(Bin0), Bin1 = term_to_binary(Term), @@ -489,22 +484,21 @@ terms_float(Config) when is_list(Config) -> float_middle_endian(Config) when is_list(Config) -> %% Testing for roundtrip is not enough. - ?line <<131,70,63,240,0,0,0,0,0,0>> = term_to_binary(1.0, [{minor_version,1}]), - ?line 1.0 = binary_to_term_stress(<<131,70,63,240,0,0,0,0,0,0>>). + <<131,70,63,240,0,0,0,0,0,0>> = term_to_binary(1.0, [{minor_version,1}]), + 1.0 = binary_to_term_stress(<<131,70,63,240,0,0,0,0,0,0>>). external_size(Config) when is_list(Config) -> %% Build a term whose external size only fits in a big num (on 32-bit CPU). - ?line external_size_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF), + external_size_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF), %% Test that the same binary aligned and unaligned has the same external size. - ?line Bin = iolist_to_binary([1,2,3,96]), - ?line Unaligned = make_unaligned_sub_binary(Bin), + Bin = iolist_to_binary([1,2,3,96]), + Unaligned = make_unaligned_sub_binary(Bin), case {erlang:external_size(Bin),erlang:external_size(Unaligned)} of {X,X} -> ok; {Sz1,Sz2} -> - io:format(" Aligned size: ~p\n", [Sz1]), - io:format("Unaligned size: ~p\n", [Sz2]), - ?line ?t:fail() + ct:fail(" Aligned size: ~p\n" + "Unaligned size: ~p\n", [Sz1,Sz2]) end, true = (erlang:external_size(Bin) =:= erlang:external_size(Bin, [{minor_version, 1}])), true = (erlang:external_size(Unaligned) =:= erlang:external_size(Unaligned, [{minor_version, 1}])). @@ -518,28 +512,29 @@ external_size_1(Term, Size0, Limit) when Size0 < Limit -> external_size_1(_, _, _) -> ok. t_iolist_size(Config) when is_list(Config) -> - ?line Seed = now(), - ?line io:format("Seed: ~p", [Seed]), - ?line random:seed(Seed), - ?line Base = <<0:(1 bsl 20)/unit:8>>, - ?line Powers = [1 bsl N || N <- lists:seq(2, 37)], - ?line Sizes0 = [[N - random:uniform(N div 2), - lists:seq(N-2, N+2), - N+N div 2, - N + random:uniform(N div 2)] || - N <- Powers], + _ = rand:uniform(), %Seed generator + io:format("Seed: ~p", [rand:export_seed()]), + + Base = <<0:(1 bsl 20)/unit:8>>, + Powers = [1 bsl N || N <- lists:seq(2, 37)], + Sizes0 = [[N - rand:uniform(N div 2), + lists:seq(N-2, N+2), + N+N div 2, + N + rand:uniform(N div 2)] || + N <- Powers], + %% Test sizes around 1^32 more thoroughly. FourGigs = 1 bsl 32, - ?line Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0, - ?line Sizes2 = lists:flatten(Sizes1), - ?line Sizes = lists:usort(Sizes2), + Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0, + Sizes2 = lists:flatten(Sizes1), + Sizes = lists:usort(Sizes2), io:format("~p sizes:", [length(Sizes)]), io:format("~p\n", [Sizes]), - ?line [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes], + _ = [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes], ok. build_iolist(N, Base) when N < 16 -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <<Bin:N/binary,_/binary>> = Base, Bin; @@ -547,7 +542,7 @@ build_iolist(N, Base) when N < 16 -> lists:seq(1, N) end; build_iolist(N, Base) when N =< byte_size(Base) -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <<Bin:N/binary,_/binary>> = Base, Bin; @@ -565,7 +560,7 @@ build_iolist(N, Base) when N =< byte_size(Base) -> end end; build_iolist(N0, Base) -> - Small = random:uniform(15), + Small = rand:uniform(15), Seq = lists:seq(1, Small), N = N0 - Small, case N rem 2 of @@ -578,33 +573,35 @@ build_iolist(N0, Base) -> end. -bad_binary_to_term_2(doc) -> "OTP-4053."; -bad_binary_to_term_2(suite) -> []; +%% OTP-4053 bad_binary_to_term_2(Config) when is_list(Config) -> - ?line {ok, N} = test_server:start_node(plopp, slave, []), - ?line R = rpc:call(N, erlang, binary_to_term, [<<131,111,255,255,255,0>>]), - ?line case R of + {ok, N} = test_server:start_node(plopp, slave, []), + R = rpc:call(N, erlang, binary_to_term, [<<131,111,255,255,255,0>>]), + case R of {badrpc, {'EXIT', _}} -> ok; _Other -> - test_server:fail({rpcresult, R}) + ct:fail({rpcresult, R}) end, - ?line test_server:stop_node(N), + test_server:stop_node(N), ok. -bad_binary_to_term(doc) -> "Try bad input to binary_to_term/1."; +%% Try bad input to binary_to_term/1. bad_binary_to_term(Config) when is_list(Config) -> - ?line bad_bin_to_term(an_atom), - ?line bad_bin_to_term({an,tuple}), - ?line bad_bin_to_term({a,list}), - ?line bad_bin_to_term(fun() -> self() end), - ?line bad_bin_to_term(fun(X) -> 42*X end), - ?line bad_bin_to_term(fun(X, Y) -> {X,Y} end), - ?line bad_bin_to_term(fun(X, Y, Z) -> {X,Y,Z} end), - ?line bad_bin_to_term(bit_sized_binary(term_to_binary({you,should,'not',see,this,term}))), + bad_bin_to_term(an_atom), + bad_bin_to_term({an,tuple}), + bad_bin_to_term({a,list}), + bad_bin_to_term(fun() -> self() end), + bad_bin_to_term(fun(X) -> 42*X end), + bad_bin_to_term(fun(X, Y) -> {X,Y} end), + bad_bin_to_term(fun(X, Y, Z) -> {X,Y,Z} end), + bad_bin_to_term(bit_sized_binary(term_to_binary({you,should,'not',see,this,term}))), %% Bad float. - ?line bad_bin_to_term(<<131,70,-1:64>>), + bad_bin_to_term(<<131,70,-1:64>>), + + %% Truncated UTF8 character (ERL-474) + bad_bin_to_term(<<131,119,1,194,163>>), ok. bad_bin_to_term(BadBin) -> @@ -613,25 +610,24 @@ bad_bin_to_term(BadBin) -> bad_bin_to_term(BadBin,Opts) -> {'EXIT',{badarg,_}} = (catch binary_to_term_stress(BadBin,Opts)). -safe_binary_to_term2(doc) -> "Test safety options for binary_to_term/2"; +%% Test safety options for binary_to_term/2 safe_binary_to_term2(Config) when is_list(Config) -> - ?line bad_bin_to_term(<<131,100,0,14,"undefined_atom">>, [safe]), - ?line bad_bin_to_term(<<131,100,0,14,"other_bad_atom">>, [safe]), + bad_bin_to_term(<<131,100,0,14,"undefined_atom">>, [safe]), + bad_bin_to_term(<<131,100,0,14,"other_bad_atom">>, [safe]), BadHostAtom = <<100,0,14,"badguy@badhost">>, Empty = <<0,0,0,0>>, 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 = binary_to_term_stress(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom + bad_bin_to_term(BadRef, [safe]), % good ref, with a bad atom + fullsweep_after = binary_to_term_stress(<<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]), + bad_bin_to_term(BadExtFun, [safe]), ok. %% Tests bad input to binary_to_term/1. -bad_terms(suite) -> []; bad_terms(Config) when is_list(Config) -> - ?line test_terms(fun corrupter/1), + test_terms(fun corrupter/1), {'EXIT',{badarg,_}} = (catch binary_to_term(<<131,$M,3:32,0,11,22,33>>)), {'EXIT',{badarg,_}} = (catch binary_to_term(<<131,$M,3:32,9,11,22,33>>)), {'EXIT',{badarg,_}} = (catch binary_to_term(<<131,$M,0:32,1,11,22,33>>)), @@ -664,7 +660,7 @@ corrupter(Term) -> corrupter0(Term). corrupter0(Term) -> - ?line try + try S = io_lib:format("About to corrupt: ~P", [Term,12]), io:put_chars(S) catch @@ -672,42 +668,41 @@ corrupter0(Term) -> io:format("About to corrupt: <<bit-level-binary:~p", [bit_size(Term)]) end, - ?line Bin = term_to_binary(Term), - ?line corrupter(Bin, size(Bin)-1), - ?line CompressedBin = term_to_binary(Term, [compressed]), - ?line corrupter(CompressedBin, size(CompressedBin)-1). + Bin = term_to_binary(Term), + corrupter(Bin, size(Bin)-1), + CompressedBin = term_to_binary(Term, [compressed]), + corrupter(CompressedBin, size(CompressedBin)-1). corrupter(Bin, Pos) when Pos >= 0 -> - ?line {ShorterBin, Rest} = split_binary(Bin, Pos), - ?line catch binary_to_term_stress(ShorterBin), %% emulator shouldn't crash - ?line MovedBin = list_to_binary([ShorterBin]), - ?line catch binary_to_term_stress(MovedBin), %% emulator shouldn't crash + {ShorterBin, Rest} = split_binary(Bin, Pos), + catch binary_to_term_stress(ShorterBin), %% emulator shouldn't crash + MovedBin = list_to_binary([ShorterBin]), + catch binary_to_term_stress(MovedBin), %% emulator shouldn't crash %% Bit faults, shouldn't crash <<Byte,Tail/binary>> = Rest, Fun = fun(M) -> FaultyByte = Byte bxor M, catch binary_to_term_stress(<<ShorterBin/binary, FaultyByte, Tail/binary>>) end, - ?line lists:foreach(Fun,[1,2,4,8,16,32,64,128,255]), - ?line corrupter(Bin, Pos-1); + lists:foreach(Fun,[1,2,4,8,16,32,64,128,255]), + corrupter(Bin, Pos-1); corrupter(_Bin, _) -> ok. -more_bad_terms(suite) -> []; more_bad_terms(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line BadFile = filename:join(Data, "bad_binary"), - ?line ok = io:format("File: ~s\n", [BadFile]), - ?line case file:read_file(BadFile) of + Data = proplists:get_value(data_dir, Config), + BadFile = filename:join(Data, "bad_binary"), + ok = io:format("File: ~s\n", [BadFile]), + case file:read_file(BadFile) of {ok,Bin} -> - ?line {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)), + {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)), ok; Other -> - ?line ?t:fail(Other) + ct:fail(Other) end. otp_5484(Config) when is_list(Config) -> - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, @@ -720,7 +715,7 @@ otp_5484(Config) when is_list(Config) -> 255, 106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, @@ -732,13 +727,13 @@ otp_5484(Config) when is_list(Config) -> 2, 106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( %% A old-type fun in a list containing a bad creator pid. <<131,108,0,0,0,1,117,0,0,0,0,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,255,255,0,25,255,0,0,0,0,100,0,1,116,97,0,98,6,142,121,72,106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( %% A new-type fun in a list containing a bad creator pid. @@ -750,7 +745,7 @@ otp_5484(Config) when is_list(Config) -> 106, %[] instead of an atom. 0,0,0,27,0,0,0,0,0,106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( %% A new-type fun in a list containing a bad module. @@ -761,7 +756,7 @@ otp_5484(Config) when is_list(Config) -> 107,0,1,64, %String instead of atom (same length). 97,0,98,6,64,82,230,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( %% A new-type fun in a list containing a bad index. @@ -773,7 +768,7 @@ otp_5484(Config) when is_list(Config) -> 104,0, %Tuple {} instead of integer. 98,6,64,82,230,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( %% A new-type fun in a list containing a bad unique value. @@ -787,46 +782,46 @@ otp_5484(Config) when is_list(Config) -> 103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)), %% An absurdly large atom. - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress(iolist_to_binary([<<131,100,65000:16>>| lists:duplicate(65000, 42)]))), %% Longer than 255 characters. - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress(iolist_to_binary([<<131,100,256:16>>| lists:duplicate(256, 42)]))), %% OTP-7218. Thanks to Matthew Dempsky. Also make sure that we %% cover the other error cases for external funs (EXPORT_EXT). - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, 113, %EXPORT_EXP 97,13, %Integer: 13 97,13, %Integer: 13 97,13>>)), %Integer: 13 - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, 113, %EXPORT_EXP 100,0,1,64, %Atom: '@' 97,13, %Integer: 13 97,13>>)), %Integer: 13 - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, 113, %EXPORT_EXP 100,0,1,64, %Atom: '@' 100,0,1,64, %Atom: '@' 106>>)), %NIL - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, 113, %EXPORT_EXP 100,0,1,64, %Atom: '@' 100,0,1,64, %Atom: '@' 98,255,255,255,255>>)), %Integer: -1 - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, 113, %EXPORT_EXP @@ -835,7 +830,7 @@ otp_5484(Config) when is_list(Config) -> 113,97,13,97,13,97,13>>)), %fun 13:13/13 %% Bad funs. - ?line {'EXIT',_} = (catch binary_to_term_stress(fake_fun(0, lists:seq(0, 256)))), + {'EXIT',_} = (catch binary_to_term_stress(fake_fun(0, lists:seq(0, 256)))), ok. fake_fun(Arity, Env0) -> @@ -858,9 +853,9 @@ fake_fun(Arity, Env0) -> %% More bad terms submitted by Matthias Lang. otp_5933(Config) when is_list(Config) -> - ?line try_bad_lengths(<<131,$m>>), %binary - ?line try_bad_lengths(<<131,$n>>), %bignum - ?line try_bad_lengths(<<131,$o>>), %huge bignum + try_bad_lengths(<<131,$m>>), %binary + try_bad_lengths(<<131,$n>>), %bignum + try_bad_lengths(<<131,$o>>), %huge bignum ok. try_bad_lengths(B) -> @@ -879,7 +874,7 @@ otp_6817(Config) when is_list(Config) -> %% Floats are only validated when the heap fragment has been allocated. BadFloat = <<131,99,53,46,48,$X,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,101,45,48,49,0,0,0,0,0>>, - ?line otp_6817_try_bin(BadFloat), + otp_6817_try_bin(BadFloat), %% {Binary,BadFloat}: When the error in float is discovered, a refc-binary %% has been allocated and the list of refc-binaries goes through the @@ -899,7 +894,7 @@ otp_6817(Config) when is_list(Config) -> 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248, 249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48, 48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>, - ?line otp_6817_try_bin(BinAndFloat), + otp_6817_try_bin(BinAndFloat), %% {Fun,BadFloat} FunAndFloat = @@ -907,14 +902,14 @@ otp_6817(Config) when is_list(Config) -> 71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111, 110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48, $Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>, - ?line otp_6817_try_bin(FunAndFloat), + otp_6817_try_bin(FunAndFloat), %% [ExternalPid|BadFloat] ExtPidAndFloat = <<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101, 114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48, 48,48,48,48,48,101,43,48,48,0,0,0,0,0>>, - ?line otp_6817_try_bin(ExtPidAndFloat), + otp_6817_try_bin(ExtPidAndFloat), ok. otp_6817_try_bin(Bin) -> @@ -932,8 +927,7 @@ otp_6817_try_bin(Bin) -> %% Will crash if the bug is present. erlang:garbage_collect(). -otp_8117(doc) -> "Some bugs in binary_to_term when 32-bit integers are negative."; -otp_8117(suite) -> []; +%% Some bugs in binary_to_term when 32-bit integers are negative. otp_8117(Config) when is_list(Config) -> [otp_8117_do(Op,-(1 bsl N)) || Op <- ['fun',named_fun,list,tuple], N <- lists:seq(0,31)], @@ -942,23 +936,22 @@ otp_8117(Config) when is_list(Config) -> otp_8117_do('fun',Neg) -> % Fun with negative num_free FunBin = term_to_binary(fun() -> ok end), - ?line <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin, - ?line bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>); + <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin, + bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>); otp_8117_do(named_fun,Neg) -> % Named fun with negative num_free FunBin = term_to_binary(fun F() -> F end), - ?line <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin, - ?line bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>); + <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin, + bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>); otp_8117_do(list,Neg) -> %% List with negative length - ?line bad_bin_to_term(<<131,104,2,108,Neg:32,97,11,104,1,97,12,97,13,106,97,14>>); + bad_bin_to_term(<<131,104,2,108,Neg:32,97,11,104,1,97,12,97,13,106,97,14>>); otp_8117_do(tuple,Neg) -> %% Tuple with negative arity - ?line bad_bin_to_term(<<131,104,2,105,Neg:32,97,11,97,12,97,13,97,14>>). + bad_bin_to_term(<<131,104,2,105,Neg:32,97,11,97,12,97,13,97,14>>). -ordering(doc) -> "Tests ordering of binaries."; -ordering(suite) -> []; +%% Tests ordering of binaries. ordering(Config) when is_list(Config) -> B1 = list_to_binary([7,8,9]), B2 = make_sub_binary([1,2,3,4]), @@ -967,58 +960,58 @@ ordering(Config) when is_list(Config) -> %% From R8 binaries are compared as strings. - ?line false = B1 == B2, - ?line false = B1 =:= B2, - ?line true = B1 /= B2, - ?line true = B1 =/= B2, + false = B1 == B2, + false = B1 =:= B2, + true = B1 /= B2, + true = B1 =/= B2, - ?line true = B1 > B2, - ?line true = B2 < B3, - ?line true = B2 =< B1, - ?line true = B2 =< B3, + true = B1 > B2, + true = B2 < B3, + true = B2 =< B1, + true = B2 =< B3, - ?line true = B2 =:= Unaligned, - ?line true = B2 == Unaligned, - ?line true = Unaligned < B3, - ?line true = Unaligned =< B3, + true = B2 =:= Unaligned, + true = B2 == Unaligned, + true = Unaligned < B3, + true = Unaligned =< B3, %% Binaries are greater than all other terms. - ?line true = B1 > 0, - ?line true = B1 > 39827491247298471289473333333333333333333333333333, - ?line true = B1 > -3489274937438742190467869234328742398347, - ?line true = B1 > 3.14, - ?line true = B1 > [], - ?line true = B1 > [a], - ?line true = B1 > {a}, - ?line true = B1 > self(), - ?line true = B1 > make_ref(), - ?line true = B1 > xxx, - ?line true = B1 > fun() -> 1 end, - ?line true = B1 > fun erlang:send/2, - - ?line Path = ?config(priv_dir, Config), - ?line AFile = filename:join(Path, "vanilla_file"), - ?line Port = open_port(AFile, [out]), - ?line true = B1 > Port, - - ?line true = B1 >= 0, - ?line true = B1 >= 39827491247298471289473333333333333333333333333333, - ?line true = B1 >= -3489274937438742190467869234328742398347, - ?line true = B1 >= 3.14, - ?line true = B1 >= [], - ?line true = B1 >= [a], - ?line true = B1 >= {a}, - ?line true = B1 >= self(), - ?line true = B1 >= make_ref(), - ?line true = B1 >= xxx, - ?line true = B1 >= fun() -> 1 end, - ?line true = B1 >= fun erlang:send/2, - ?line true = B1 >= Port, + true = B1 > 0, + true = B1 > 39827491247298471289473333333333333333333333333333, + true = B1 > -3489274937438742190467869234328742398347, + true = B1 > 3.14, + true = B1 > [], + true = B1 > [a], + true = B1 > {a}, + true = B1 > self(), + true = B1 > make_ref(), + true = B1 > xxx, + true = B1 > fun() -> 1 end, + true = B1 > fun erlang:send/2, + + Path = proplists:get_value(priv_dir, Config), + AFile = filename:join(Path, "vanilla_file"), + Port = open_port(AFile, [out]), + true = B1 > Port, + + true = B1 >= 0, + true = B1 >= 39827491247298471289473333333333333333333333333333, + true = B1 >= -3489274937438742190467869234328742398347, + true = B1 >= 3.14, + true = B1 >= [], + true = B1 >= [a], + true = B1 >= {a}, + true = B1 >= self(), + true = B1 >= make_ref(), + true = B1 >= xxx, + true = B1 >= fun() -> 1 end, + true = B1 >= fun erlang:send/2, + true = B1 >= Port, ok. -%% Test that comparisions between binaries with different alignment work. +%% Test that comparison between binaries with different alignment work. unaligned_order(Config) when is_list(Config) -> L = lists:seq(0, 7), [test_unaligned_order(I, J) || I <- L, J <- L], @@ -1027,153 +1020,153 @@ unaligned_order(Config) when is_list(Config) -> test_unaligned_order(I, J) -> Align = {I,J}, io:format("~p ~p", [I,J]), - ?line true = test_unaligned_order_1('=:=', <<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>, + true = test_unaligned_order_1('=:=', <<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>, <<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>, Align), - ?line false = test_unaligned_order_1('=/=', <<1,2,3>>, <<1,2,3>>, Align), - ?line true = test_unaligned_order_1('==', <<4,5,6>>, <<4,5,6>>, Align), - ?line false = test_unaligned_order_1('/=', <<1,2,3>>, <<1,2,3>>, Align), + false = test_unaligned_order_1('=/=', <<1,2,3>>, <<1,2,3>>, Align), + true = test_unaligned_order_1('==', <<4,5,6>>, <<4,5,6>>, Align), + false = test_unaligned_order_1('/=', <<1,2,3>>, <<1,2,3>>, Align), - ?line true = test_unaligned_order_1('<', <<1,2>>, <<1,2,3>>, Align), - ?line true = test_unaligned_order_1('=<', <<1,2>>, <<1,2,3>>, Align), - ?line true = test_unaligned_order_1('=<', <<1,2,7,8>>, <<1,2,7,8>>, Align), + true = test_unaligned_order_1('<', <<1,2>>, <<1,2,3>>, Align), + true = test_unaligned_order_1('=<', <<1,2>>, <<1,2,3>>, Align), + true = test_unaligned_order_1('=<', <<1,2,7,8>>, <<1,2,7,8>>, Align), ok. test_unaligned_order_1(Op, A, B, {Aa,Ba}) -> erlang:Op(unaligned_sub_bin(A, Aa), unaligned_sub_bin(B, Ba)). test_terms(Test_Func) -> - ?line Test_Func(atom), - ?line Test_Func(''), - ?line Test_Func('a'), - ?line Test_Func('ab'), - ?line Test_Func('abc'), - ?line Test_Func('abcd'), - ?line Test_Func('abcde'), - ?line Test_Func('abcdef'), - ?line Test_Func('abcdefg'), - ?line Test_Func('abcdefgh'), - - ?line Test_Func(fun() -> ok end), + Test_Func(atom), + Test_Func(''), + Test_Func('a'), + Test_Func('ab'), + Test_Func('abc'), + Test_Func('abcd'), + Test_Func('abcde'), + Test_Func('abcdef'), + Test_Func('abcdefg'), + Test_Func('abcdefgh'), + + Test_Func(fun() -> ok end), X = id([a,{b,c},c]), Y = id({x,y,z}), Z = id(1 bsl 8*257), - ?line Test_Func(fun() -> X end), - ?line Test_Func(fun() -> {X,Y} end), - ?line Test_Func([fun() -> {X,Y,Z} end, + Test_Func(fun() -> X end), + Test_Func(fun() -> {X,Y} end), + Test_Func([fun() -> {X,Y,Z} end, fun() -> {Z,X,Y} end, fun() -> {Y,Z,X} end]), - ?line Test_Func({trace_ts,{even_bigger,{some_data,fun() -> ok end}},{1,2,3}}), - ?line Test_Func({trace_ts,{even_bigger,{some_data,<<1,2,3,4,5,6,7,8,9,10>>}}, + Test_Func({trace_ts,{even_bigger,{some_data,fun() -> ok end}},{1,2,3}}), + Test_Func({trace_ts,{even_bigger,{some_data,<<1,2,3,4,5,6,7,8,9,10>>}}, {1,2,3}}), - ?line Test_Func(1), - ?line Test_Func(42), - ?line Test_Func(-23), - ?line Test_Func(256), - ?line Test_Func(25555), - ?line Test_Func(-3333), + Test_Func(1), + Test_Func(42), + Test_Func(-23), + Test_Func(256), + Test_Func(25555), + Test_Func(-3333), - ?line Test_Func(1.0), + Test_Func(1.0), - ?line Test_Func(183749783987483978498378478393874), - ?line Test_Func(-37894183749783987483978498378478393874), + Test_Func(183749783987483978498378478393874), + Test_Func(-37894183749783987483978498378478393874), Very_Big = very_big_num(), - ?line Test_Func(Very_Big), - ?line Test_Func(-Very_Big+1), - - ?line Test_Func([]), - ?line Test_Func("abcdef"), - ?line Test_Func([a, b, 1, 2]), - ?line Test_Func([a|b]), - - ?line Test_Func({}), - ?line Test_Func({1}), - ?line Test_Func({a, b}), - ?line Test_Func({a, b, c}), - ?line Test_Func(list_to_tuple(lists:seq(0, 255))), - ?line Test_Func(list_to_tuple(lists:seq(0, 256))), - - ?line Test_Func(make_ref()), - ?line Test_Func([make_ref(), make_ref()]), - - ?line Test_Func(make_port()), - - ?line Test_Func(make_pid()), - - ?line Test_Func(Bin0 = list_to_binary(lists:seq(0, 14))), - ?line Test_Func(Bin1 = list_to_binary(lists:seq(0, ?heap_binary_size))), - ?line Test_Func(Bin2 = list_to_binary(lists:seq(0, ?heap_binary_size+1))), - ?line Test_Func(Bin3 = list_to_binary(lists:seq(0, 255))), - - ?line Test_Func(make_unaligned_sub_binary(Bin0)), - ?line Test_Func(make_unaligned_sub_binary(Bin1)), - ?line Test_Func(make_unaligned_sub_binary(Bin2)), - ?line Test_Func(make_unaligned_sub_binary(Bin3)), - - ?line Test_Func(make_sub_binary(lists:seq(42, 43))), - ?line Test_Func(make_sub_binary([42,43,44])), - ?line Test_Func(make_sub_binary([42,43,44,45])), - ?line Test_Func(make_sub_binary([42,43,44,45,46])), - ?line Test_Func(make_sub_binary([42,43,44,45,46,47])), - ?line Test_Func(make_sub_binary([42,43,44,45,46,47,48])), - ?line Test_Func(make_sub_binary(lists:seq(42, 49))), - ?line Test_Func(make_sub_binary(lists:seq(0, 14))), - ?line Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size))), - ?line Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size+1))), - ?line Test_Func(make_sub_binary(lists:seq(0, 255))), - - ?line Test_Func(make_unaligned_sub_binary(lists:seq(42, 43))), - ?line Test_Func(make_unaligned_sub_binary([42,43,44])), - ?line Test_Func(make_unaligned_sub_binary([42,43,44,45])), - ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46])), - ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47])), - ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47,48])), - ?line Test_Func(make_unaligned_sub_binary(lists:seq(42, 49))), - ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, 14))), - ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size))), - ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size+1))), - ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, 255))), + Test_Func(Very_Big), + Test_Func(-Very_Big+1), + + Test_Func([]), + Test_Func("abcdef"), + Test_Func([a, b, 1, 2]), + Test_Func([a|b]), + + Test_Func({}), + Test_Func({1}), + Test_Func({a, b}), + Test_Func({a, b, c}), + Test_Func(list_to_tuple(lists:seq(0, 255))), + Test_Func(list_to_tuple(lists:seq(0, 256))), + + Test_Func(make_ref()), + Test_Func([make_ref(), make_ref()]), + + Test_Func(make_port()), + + Test_Func(make_pid()), + + Test_Func(Bin0 = list_to_binary(lists:seq(0, 14))), + Test_Func(Bin1 = list_to_binary(lists:seq(0, ?heap_binary_size))), + Test_Func(Bin2 = list_to_binary(lists:seq(0, ?heap_binary_size+1))), + Test_Func(Bin3 = list_to_binary(lists:seq(0, 255))), + + Test_Func(make_unaligned_sub_binary(Bin0)), + Test_Func(make_unaligned_sub_binary(Bin1)), + Test_Func(make_unaligned_sub_binary(Bin2)), + Test_Func(make_unaligned_sub_binary(Bin3)), + + Test_Func(make_sub_binary(lists:seq(42, 43))), + Test_Func(make_sub_binary([42,43,44])), + Test_Func(make_sub_binary([42,43,44,45])), + Test_Func(make_sub_binary([42,43,44,45,46])), + Test_Func(make_sub_binary([42,43,44,45,46,47])), + Test_Func(make_sub_binary([42,43,44,45,46,47,48])), + Test_Func(make_sub_binary(lists:seq(42, 49))), + Test_Func(make_sub_binary(lists:seq(0, 14))), + Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size))), + Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size+1))), + Test_Func(make_sub_binary(lists:seq(0, 255))), + + Test_Func(make_unaligned_sub_binary(lists:seq(42, 43))), + Test_Func(make_unaligned_sub_binary([42,43,44])), + Test_Func(make_unaligned_sub_binary([42,43,44,45])), + Test_Func(make_unaligned_sub_binary([42,43,44,45,46])), + Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47])), + Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47,48])), + Test_Func(make_unaligned_sub_binary(lists:seq(42, 49))), + Test_Func(make_unaligned_sub_binary(lists:seq(0, 14))), + Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size))), + Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size+1))), + Test_Func(make_unaligned_sub_binary(lists:seq(0, 255))), %% Bit level binaries. - ?line Test_Func(<<1:1>>), - ?line Test_Func(<<2:2>>), - ?line Test_Func(<<42:10>>), - ?line Test_Func(list_to_bitstring([<<5:6>>|lists:seq(0, 255)])), + Test_Func(<<1:1>>), + Test_Func(<<2:2>>), + Test_Func(<<42:10>>), + Test_Func(list_to_bitstring([<<5:6>>|lists:seq(0, 255)])), - ?line Test_Func(F = fun(A) -> 42*A end), - ?line Test_Func(lists:duplicate(32, F)), + Test_Func(F = fun(A) -> 42*A end), + Test_Func(lists:duplicate(32, F)), - ?line Test_Func(FF = fun binary_SUITE:all/0), - ?line Test_Func(lists:duplicate(32, FF)), + Test_Func(FF = fun binary_SUITE:all/0), + Test_Func(lists:duplicate(32, FF)), ok. test_floats(Test_Func) -> - ?line Test_Func(5.5), - ?line Test_Func(-15.32), - ?line Test_Func(1.2435e25), - ?line Test_Func(1.2333e-20), - ?line Test_Func(199.0e+15), + Test_Func(5.5), + Test_Func(-15.32), + Test_Func(1.2435e25), + Test_Func(1.2333e-20), + Test_Func(199.0e+15), ok. very_big_num() -> very_big_num(33, 1). very_big_num(Left, Result) when Left > 0 -> - ?line very_big_num(Left-1, Result*256); + very_big_num(Left-1, Result*256); very_big_num(0, Result) -> - ?line Result. + Result. make_port() -> - ?line open_port({spawn, efile}, [eof]). + open_port({spawn, efile}, [eof]). make_pid() -> - ?line spawn_link(?MODULE, sleeper, []). + spawn_link(?MODULE, sleeper, []). sleeper() -> - ?line receive after infinity -> ok end. + receive after infinity -> ok end. %% Test that binaries are garbage collected properly. @@ -1213,7 +1206,7 @@ gc_test1(Pid) -> receive {Pid,done} -> ok after 10000 -> - ?line ?t:fail() + ct:fail("timeout") end. %% Like split binary, but returns REFC binaries. Only useful for gc_test/1. @@ -1232,7 +1225,7 @@ gc() -> gc1() -> ok. bit_sized_binary_sizes(Config) when is_list(Config) -> - ?line [bsbs_1(A) || A <- lists:seq(1, 8)], + [bsbs_1(A) || A <- lists:seq(1, 8)], ok. bsbs_1(A) -> @@ -1274,13 +1267,13 @@ obsolete_funs(Config) when is_list(Config) -> X = id({1,2,3}), Y = id([a,b,c,d]), Z = id({x,y,z}), - ?line obsolete_fun(fun() -> ok end), - ?line obsolete_fun(fun() -> X end), - ?line obsolete_fun(fun(A) -> {A,X} end), - ?line obsolete_fun(fun() -> {X,Y} end), - ?line obsolete_fun(fun() -> {X,Y,Z} end), + obsolete_fun(fun() -> ok end), + obsolete_fun(fun() -> X end), + obsolete_fun(fun(A) -> {A,X} end), + obsolete_fun(fun() -> {X,Y} end), + obsolete_fun(fun() -> {X,Y,Z} end), - ?line obsolete_fun(fun ?MODULE:all/1), + obsolete_fun(fun ?MODULE:all/1), erts_debug:set_internal_state(available_internal_state, false), ok. @@ -1307,41 +1300,41 @@ no_fun_roundtrip(Term) -> %% but recognized by binary_to_term/1. robustness(Config) when is_list(Config) -> - ?line [] = binary_to_term_stress(<<131,107,0,0>>), %Empty string. - ?line [] = binary_to_term_stress(<<131,108,0,0,0,0,106>>), %Zero-length list. + [] = binary_to_term_stress(<<131,107,0,0>>), %Empty string. + [] = binary_to_term_stress(<<131,108,0,0,0,0,106>>), %Zero-length list. %% {[],a} where [] is a zero-length list. - ?line {[],a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,106,100,0,1,97>>), + {[],a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,106,100,0,1,97>>), %% {42,a} where 42 is a zero-length list with 42 in the tail. - ?line {42,a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,97,42,100,0,1,97>>), + {42,a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,97,42,100,0,1,97>>), %% {{x,y},a} where {x,y} is a zero-length list with {x,y} in the tail. - ?line {{x,y},a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0, + {{x,y},a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0, 104,2,100,0,1,120,100,0,1, 121,100,0,1,97>>), %% Bignums fitting in 32 bits. - ?line 16#7FFFFFFF = binary_to_term_stress(<<131,98,127,255,255,255>>), - ?line -1 = binary_to_term_stress(<<131,98,255,255,255,255>>), + 16#7FFFFFFF = binary_to_term_stress(<<131,98,127,255,255,255>>), + -1 = binary_to_term_stress(<<131,98,255,255,255,255>>), ok. %% OTP-8180: Test several terms that have been known to crash the emulator. %% (Thanks to Scott Lystig Fritchie.) otp_8180(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line Wc = filename:join(Data, "zzz.*"), + Data = proplists:get_value(data_dir, Config), + Wc = filename:join(Data, "zzz.*"), Files = filelib:wildcard(Wc), [run_otp_8180(F) || F <- Files], ok. run_otp_8180(Name) -> io:format("~s", [Name]), - ?line {ok,Bins} = file:consult(Name), + {ok,Bins} = file:consult(Name), [begin io:format("~p\n", [Bin]), - ?line {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)) + {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)) end || Bin <- Bins], ok. @@ -1351,7 +1344,16 @@ trapping(Config) when is_list(Config)-> do_trapping(5, term_to_binary, fun() -> [lists:duplicate(2000000,2000000)] end), do_trapping(5, binary_to_term, - fun() -> [term_to_binary(lists:duplicate(2000000,2000000))] end). + fun() -> [term_to_binary(lists:duplicate(2000000,2000000))] end), + do_trapping(5, binary_to_list, + fun() -> [list_to_binary(lists:duplicate(2000000,$x))] end), + do_trapping(5, list_to_binary, + fun() -> [lists:duplicate(2000000,$x)] end), + do_trapping(5, bitstring_to_list, + fun() -> [list_to_bitstring([lists:duplicate(2000000,$x),<<7:4>>])] end), + do_trapping(5, list_to_bitstring, + fun() -> [[lists:duplicate(2000000,$x),<<7:4>>]] end) + . do_trapping(0, _, _) -> ok; @@ -1359,17 +1361,19 @@ do_trapping(N, Bif, ArgFun) -> io:format("N=~p: Do ~p ~s gc.\n", [N, Bif, case N rem 2 of 0 -> "with"; 1 -> "without" end]), Pid = spawn(?MODULE,trapping_loop,[Bif, ArgFun, 1000, self()]), receive ok -> ok end, - receive after 100 -> ok end, Ref = make_ref(), case N rem 2 of - 0 -> erlang:garbage_collect(Pid, [{async,Ref}]), - receive after 100 -> ok end; + 0 -> + erlang:garbage_collect(Pid, [{async,Ref}]), + receive after 1 -> ok end; 1 -> void end, - exit(Pid,kill), + exit(Pid, kill), case N rem 2 of - 0 -> receive {garbage_collect, Ref, _} -> ok end; - 1 -> void + 0 -> + receive {garbage_collect, Ref, _} -> ok end; + 1 -> + void end, receive after 1 -> ok end, do_trapping(N-1, Bif, ArgFun). @@ -1384,9 +1388,189 @@ trapping_loop2(Bif,Args,N) -> apply(erlang,Bif,Args), trapping_loop2(Bif, Args, N-1). +large(Config) when is_list(Config) -> + List = lists:flatten(lists:map(fun (_) -> + [0,1,2,3,4,5,6,7,8] + end, + lists:seq(1, 131072))), + Bin = list_to_binary(List), + List = binary_to_list(Bin), + PartList = lists:reverse(tl(tl(lists:reverse(tl(tl(List)))))), + PartList = binary_to_list(Bin, 3, length(List)-2), + ListBS = List ++ [<<7:4>>], + ListBS = bitstring_to_list(list_to_bitstring(ListBS)), + BitStr1 = list_to_bitstring(lists:duplicate(1024*1024, [<<1,5:3>>])), + BitStr1 = list_to_bitstring(bitstring_to_list(BitStr1)), + BitStr2 = list_to_bitstring([lists:duplicate(512*1024, [<<1,5:3>>]), + Bin]), + BitStr2 = list_to_bitstring(bitstring_to_list(BitStr2)), + ok. + +error_after_yield(Config) when is_list(Config) -> + L2BTrap = {erts_internal, list_to_binary_continue, 1}, + error_after_yield(badarg, erlang, list_to_binary, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap), + error_after_yield(badarg, erlang, iolist_to_binary, 1, fun () -> [[list2iolist(mk_list(1000000)), oops]] end, L2BTrap), + error_after_yield(badarg, erlang, list_to_bitstring, 1, fun () -> [[list2bitstrlist(mk_list(1000000)), oops]] end, L2BTrap), + error_after_yield(badarg, binary, list_to_bin, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap), + + B2TTrap = {erts_internal, binary_to_term_trap, 1}, + + error_after_yield(badarg, erlang, binary_to_term, 1, fun () -> [error_after_yield_bad_ext_term()] end, B2TTrap), + error_after_yield(badarg, erlang, binary_to_term, 2, fun () -> [error_after_yield_bad_ext_term(), [safe]] end, B2TTrap), + + case erlang:system_info(wordsize) of + 4 -> + SysLimitSz = 1 bsl 32, + error_after_yield(system_limit, erlang, list_to_binary, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap), + error_after_yield(system_limit, erlang, iolist_to_binary, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap), + error_after_yield(system_limit, erlang, list_to_bitstring, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap), + error_after_yield(system_limit, binary, list_to_bin, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap); + 8 -> + % Takes waaaay to long time to test system_limit on 64-bit archs... + ok + end, + ok. + +error_after_yield(Type, M, F, AN, AFun, TrapFunc) -> + io:format("Testing ~p for ~p:~p/~p~n", [Type, M, F, AN]), + Tracer = self(), + {Pid, Mon} = spawn_monitor(fun () -> + A = AFun(), + try + erlang:yield(), + erlang:trace(self(),true,[running,{tracer,Tracer}]), + apply(M, F, A), + exit({unexpected_success, {M, F, A}}) + catch + error:Type -> + erlang:trace(self(),false,[running,{tracer,Tracer}]), + %% We threw the exception from the native + %% function we trapped to, but we want + %% the BIF that originally was called + %% to appear in the stack trace. + [{M, F, A, _} | _] = erlang:get_stacktrace() + end + end), + receive + {'DOWN', Mon, process, Pid, Reason} -> + normal = Reason + end, + TD = erlang:trace_delivered(Pid), + receive + {trace_delivered, Pid, TD} -> + NoYields = error_after_yield_sched(Pid, TrapFunc, 0), + io:format("No of yields: ~p~n", [NoYields]), + true = NoYields > 2 + end, + ok. + +error_after_yield_sched(P, TrapFunc, N) -> + receive + {trace, P, out, TrapFunc} -> + receive + {trace, P, in, TrapFunc} -> + error_after_yield_sched(P, TrapFunc, N+1) + after 0 -> + exit(trap_sched_mismatch) + end; + {trace, P, out, Func} -> + receive + {trace, P, in, Func} -> + error_after_yield_sched(P, TrapFunc, N) + after 0 -> + exit(other_sched_mismatch) + end + after 0 -> + N + end. + +error_after_yield_bad_ext_term() -> + TupleSz = 2000000, + <<131, % Version magic + AtomExt/binary>> = term_to_binary(an_atom_we_use_for_this), + BadAtomExt = [100, %% ATOM_EXT + 255, 255, % Invalid size of 65535 bytes + "oops"], + + %% Produce a large tuple where the last element is invalid + list_to_binary([131, %% Version magic + 105, %% LARGE_TUPLE_EXT + <<TupleSz:32/big>>, %% Tuple size + lists:duplicate(TupleSz-1, AtomExt), %% Valid atoms + BadAtomExt]). %% Invalid atom at the end + +cmp_old_impl(Config) when is_list(Config) -> + %% Compare results from new yielding implementations with + %% old non yielding implementations + Cookie = atom_to_list(erlang:get_cookie()), + Rel = "r16b_latest", + case test_server:is_release_available(Rel) of + false -> + {skipped, "No "++Rel++" available"}; + true -> + {ok, Node} = test_server:start_node(list_to_atom(atom_to_list(?MODULE)++"_"++Rel), + peer, + [{args, " -setcookie "++Cookie}, + {erl, [{release, Rel}]}]), + + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(100))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1000))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10000))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(100000))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1000000))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10000000))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list_lb(10000000))]}), + + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(100))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1000))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10000))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(100000))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1000000))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10000000))]}), + + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(100))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1000))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10000))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(100000))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1000000))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10000000))]}), + + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(100)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1000)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10000)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(100000)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1000000)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10000000)))]}), + + test_server:stop_node(Node), + + ok + end. %% Utilities. +huge_iolist(Lim) -> + Sz = 1024, + huge_iolist(list_to_binary(mk_list(Sz)), Sz, Lim). + +huge_iolist(X, Sz, Lim) when Sz >= Lim -> + X; +huge_iolist(X, Sz, Lim) -> + huge_iolist([X, X], Sz*2, Lim). + +cmp_node(Node, {M, F, A}) -> + Res = rpc:call(Node, M, F, A), + Res = apply(M, F, A), + ok. + make_sub_binary(Bin) when is_binary(Bin) -> {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), B; @@ -1410,7 +1594,7 @@ bit_sized_binary(Bin0) -> unaligned_sub_bin(Bin, 0) -> Bin; unaligned_sub_bin(Bin0, Offs) -> - F = random:uniform(256), + F = rand:uniform(256), Roffs = 8-Offs, Bin1 = <<F:Offs,Bin0/binary,F:Roffs>>, Sz = size(Bin0), @@ -1467,3 +1651,78 @@ get_reds() -> erts_debug:set_internal_state(available_internal_state, true), get_reds() end. + +-define(LARGE_BIN, (512*1024+10)). +-define(LARGE_BIN_LIM, (1024*1024)). + +mk_list(0, Acc) -> + Acc; +mk_list(Sz, Acc) -> + mk_list(Sz-1, [$A+(Sz band 63) | Acc]). + +mk_list(Sz) when Sz >= ?LARGE_BIN_LIM -> + SzLeft = Sz - ?LARGE_BIN, + SzHd = SzLeft div 2, + SzTl = SzLeft - SzHd, + [mk_list(SzHd, []), erlang:list_to_binary(mk_list(?LARGE_BIN, [])), mk_list(SzTl, [])]; +mk_list(Sz) -> + mk_list(Sz, []). + +mk_list_lb(Sz) when Sz >= ?LARGE_BIN_LIM -> + SzLeft = Sz - ?LARGE_BIN, + SzHd = SzLeft div 2, + SzTl = SzLeft - SzHd, + [mk_list(SzHd, []), erlang:list_to_binary(mk_list(?LARGE_BIN, [])), mk_list(SzTl, [])]; +mk_list_lb(Sz) -> + mk_list(Sz, []). + + +list2iolist(List) -> + list2iolist(List, []). + +list2iolist([], Acc) -> + Acc; +list2iolist([X0, X1, X2, X3, X4, X5 | Xs], Acc) when is_integer(X0), 0 =< X0, X0 < 256, + is_integer(X1), 0 =< X1, X1 < 256, + is_integer(X2), 0 =< X2, X2 < 256, + is_integer(X3), 0 =< X3, X3 < 256, + is_integer(X4), 0 =< X4, X4 < 256, + is_integer(X5), 0 =< X5, X5 < 256 -> + NewAcc = case (X0+X1+X2+X3+X4+X5) band 3 of + 0 -> + [Acc, [[[[[[[[[[[[X0,[],<<"">>,X1]]]]]]]]],[X2,X3]],[],[],[],[],X4],X5]]; + 1 -> + [Acc, [], erlang:list_to_binary([X0, X1, X2, X3, X4, X5])]; + 2 -> + [Acc, [[[[X0|erlang:list_to_binary([X1])],[X2|erlang:list_to_binary([X3])],[X4|erlang:list_to_binary([X5])]]]|<<"">>]]; + 3 -> + [Acc, X0, X1, X2, <<"">>, [], X3, X4 | erlang:list_to_binary([X5])] + end, + list2iolist(Xs, NewAcc); +list2iolist([X | Xs], Acc) -> + list2iolist(Xs, [Acc,X]). + +list2bitstrlist(List) -> + [list2bitstrlist(List, []), <<4:7>>]. + +list2bitstrlist([], Acc) -> + Acc; +list2bitstrlist([X0, X1, X2, X3, X4, X5 | Xs], Acc) when is_integer(X0), 0 =< X0, X0 < 256, + is_integer(X1), 0 =< X1, X1 < 256, + is_integer(X2), 0 =< X2, X2 < 256, + is_integer(X3), 0 =< X3, X3 < 256, + is_integer(X4), 0 =< X4, X4 < 256, + is_integer(X5), 0 =< X5, X5 < 256 -> + NewAcc = case (X0+X1+X2+X3+X4+X5) band 3 of + 0 -> + [Acc, [[[[[[[[[[[[X0,[],<<"">>,X1]]]]]]]]],[X2,X3]],[],[],[],[],X4],X5]]; + 1 -> + [Acc, [], <<X0:X1>>, <<X2:X3>>, <<X4:X5>>]; + 2 -> + [Acc, [[[[X0|<<X1:X2>>],X3]],[X4|erlang:list_to_binary([X5])]|<<"">>]]; + 3 -> + [Acc, X0, X1, X2, <<"">>, [], X3, X4 | erlang:list_to_binary([X5])] + end, + list2bitstrlist(Xs, NewAcc); +list2bitstrlist([X | Xs], Acc) -> + list2bitstrlist(Xs, [Acc,X]). diff --git a/erts/emulator/test/bs_bincomp_SUITE.erl b/erts/emulator/test/bs_bincomp_SUITE.erl index f1c2dff560..c481e93e41 100644 --- a/erts/emulator/test/bs_bincomp_SUITE.erl +++ b/erts/emulator/test/bs_bincomp_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -130,7 +131,7 @@ tracing(Config) when is_list(Config) -> random_binary() -> Seq = [1,2,3,4,5,6,7,8,9,10], - << <<($a + random:uniform($z - $a)):8>> || _ <- Seq >>. + << <<($a + rand:uniform($z - $a)):8>> || _ <- Seq >>. random_binaries(N) when N > 0 -> random_binary(), diff --git a/erts/emulator/test/bs_bit_binaries_SUITE.erl b/erts/emulator/test/bs_bit_binaries_SUITE.erl index 7f2cd1e881..d393bc5b91 100644 --- a/erts/emulator/test/bs_bit_binaries_SUITE.erl +++ b/erts/emulator/test/bs_bit_binaries_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,7 +30,7 @@ big_binary_to_and_from_list/1,send_and_receive/1, send_and_receive_alot/1,append/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -56,9 +57,9 @@ end_per_group(_GroupName, Config) -> misc(Config) when is_list(Config) -> - ?line <<1:100>> = id(<<1:100>>), - ?line {ok,ok} = {match(7),match(9)}, - ?line {ok,ok} = {match1(15),match1(31)}, + <<1:100>> = id(<<1:100>>), + {ok,ok} = {match(7),match(9)}, + {ok,ok} = {match1(15),match1(31)}, ok. @@ -75,70 +76,70 @@ match1(N) -> ok. test_bit_size(Config) when is_list(Config) -> - ?line 101 = bit_size(<<1:101>>), - ?line 1001 = bit_size(<<1:1001>>), - ?line 80 = bit_size(<<1:80>>), - ?line 800 = bit_size(<<1:800>>), - ?line Bin = <<0:16#1000000>>, - ?line BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), - ?line 16#10000001 = erlang:bit_size(BigBin), + 101 = bit_size(<<1:101>>), + 1001 = bit_size(<<1:1001>>), + 80 = bit_size(<<1:80>>), + 800 = bit_size(<<1:800>>), + Bin = <<0:16#1000000>>, + BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + 16#10000001 = erlang:bit_size(BigBin), %% Only run these on computers with lots of memory %% HugeBin = list_to_bitstring([BigBin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), %% 16#100000011 = bit_size(HugeBin), - ?line 0 = bit_size(<<>>), + 0 = bit_size(<<>>), ok. horrid_match(Config) when is_list(Config) -> - ?line <<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, - ?line <<42:24/little>> = B, + <<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, + <<42:24/little>> = B, ok. test_bitstr(Config) when is_list(Config) -> - ?line <<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>, - ?line <<1:1,6>> = B, - ?line B = <<1:1,6>>, + <<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>, + <<1:1,6>> = B, + B = <<1:1,6>>, ok. asymmetric_tests(Config) when is_list(Config) -> - ?line <<1:12>> = <<0,1:4>>, - ?line <<0,1:4>> = <<1:12>>, - ?line <<1:1,X/bitstring>> = <<128,255,0,0:2>>, - ?line <<1,254,0,0:1>> = X, - ?line X = <<1,254,0,0:1>>, - ?line <<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>, - ?line <<1,254,0,0:1>> = X1, - ?line X1 = <<1,254,0,0:1>>, + <<1:12>> = <<0,1:4>>, + <<0,1:4>> = <<1:12>>, + <<1:1,X/bitstring>> = <<128,255,0,0:2>>, + <<1,254,0,0:1>> = X, + X = <<1,254,0,0:1>>, + <<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>, + <<1,254,0,0:1>> = X1, + X1 = <<1,254,0,0:1>>, ok. big_asymmetric_tests(Config) when is_list(Config) -> - ?line <<1:875,1:12>> = <<1:875,0,1:4>>, - ?line <<1:875,0,1:4>> = <<1:875,1:12>>, - ?line <<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>, - ?line <<1,254,0,0:1,1:875>> = X, - ?line X = <<1,254,0,0:1,1:875>>, - ?line <<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>, - ?line <<1,254,0,0:1,1:875>> = X1, - ?line X1 = <<1,254,0,0:1,1:875>>, + <<1:875,1:12>> = <<1:875,0,1:4>>, + <<1:875,0,1:4>> = <<1:875,1:12>>, + <<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>, + <<1,254,0,0:1,1:875>> = X, + X = <<1,254,0,0:1,1:875>>, + <<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>, + <<1,254,0,0:1,1:875>> = X1, + X1 = <<1,254,0,0:1,1:875>>, ok. binary_to_and_from_list(Config) when is_list(Config) -> - ?line <<1,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>)), - ?line [1,2,3,4,<<1:1>>] = bitstring_to_list(<<1,2,3,4,1:1>>), - ?line <<1:1,1,2,3,4>> = list_to_bitstring([<<1:1>>,1,2,3,4]), - ?line [128,129,1,130,<<0:1>>] = bitstring_to_list(<<1:1,1,2,3,4>>), + <<1,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>)), + [1,2,3,4,<<1:1>>] = bitstring_to_list(<<1,2,3,4,1:1>>), + <<1:1,1,2,3,4>> = list_to_bitstring([<<1:1>>,1,2,3,4]), + [128,129,1,130,<<0:1>>] = bitstring_to_list(<<1:1,1,2,3,4>>), ok. big_binary_to_and_from_list(Config) when is_list(Config) -> - ?line <<1:800,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)), - ?line [1,2,3,4|_Rest1] = bitstring_to_list(<<1,2,3,4,1:800,1:1>>), - ?line <<1:801,1,2,3,4>> = list_to_bitstring([<<1:801>>,1,2,3,4]), + <<1:800,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)), + [1,2,3,4|_Rest1] = bitstring_to_list(<<1,2,3,4,1:800,1:1>>), + <<1:801,1,2,3,4>> = list_to_bitstring([<<1:801>>,1,2,3,4]), ok. send_and_receive(Config) when is_list(Config) -> - ?line Bin = <<1,2:7>>, + Bin = <<1,2:7>>, Pid = spawn_link(fun() -> receiver(Bin) end), - ?line Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, - ?line receive + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive ok -> ok end. @@ -175,8 +176,8 @@ receiver_alot(Bin) -> append(Config) when is_list(Config) -> cs_init(), - ?line <<(-1):256/signed-unit:8>> = cs(do_append(id(<<>>), 256*8)), - ?line <<(-1):256/signed-unit:8>> = cs(do_append2(id(<<>>), 256*4)), + <<(-1):256/signed-unit:8>> = cs(do_append(id(<<>>), 256*8)), + <<(-1):256/signed-unit:8>> = cs(do_append2(id(<<>>), 256*4)), <<(-1):256/signed-unit:8>> = cs(do_append3(id(<<>>), 256*8)), cs_end(). diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index 1a8724d63b..ce50bcdd86 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,40 +22,33 @@ -module(bs_construct_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, + init_per_suite/1, end_per_suite/1, test1/1, test2/1, test3/1, test4/1, test5/1, testf/1, not_used/1, in_guard/1, mem_leak/1, coerce_to_float/1, bjorn/1, huge_float_field/1, huge_binary/1, system_limit/1, badarg/1, copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1, - otp_7422/1, zero_width/1, bad_append/1]). + otp_7422/1, zero_width/1, bad_append/1, bs_add_overflow/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [test1, test2, test3, test4, test5, testf, not_used, in_guard, mem_leak, coerce_to_float, bjorn, huge_float_field, huge_binary, system_limit, badarg, copy_writable_binary, kostis, dynamic, bs_add, otp_7422, zero_width, - bad_append]. - -groups() -> - []. + bad_append, bs_add_overflow]. init_per_suite(Config) -> Config. end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. + application:stop(os_mon). big(1) -> 57285702734876389752897683. @@ -67,9 +61,9 @@ r(L) -> -define(T(B, L), {B, ??B, L}). -define(N(B), {B, ??B, unknown}). --define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). +-define(FAIL(Expr), fail_check(catch Expr, ??Expr, [])). --define(FAIL_VARS(Expr, Vars), ?line fail_check(catch Expr, ??Expr, Vars)). +-define(FAIL_VARS(Expr, Vars), fail_check(catch Expr, ??Expr, Vars)). l(I_13, I_big1) -> [ @@ -188,7 +182,7 @@ one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) -> true -> io:format("ERROR: Compiled: ~p. Expected ~p. Got ~p.~n", [Str, Bytes, binary_to_list(C_bin)]), - test_server:fail(comp) + ct:fail(comp) end, if E_bin == Bin -> @@ -196,7 +190,7 @@ one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) -> true -> io:format("ERROR: Interpreted: ~p. Expected ~p. Got ~p.~n", [Str, Bytes, binary_to_list(E_bin)]), - test_server:fail(comp) + ct:fail(comp) end; one_test({C_bin, E_bin, Str, Result}) -> io:format(" ~s ~p~n", [Str, C_bin]), @@ -217,7 +211,7 @@ one_test({C_bin, E_bin, Str, Result}) -> io:format("ERROR: Compiled not equal to interpreted:" "~n ~p, ~p.~n", [binary_to_list(C_bin), binary_to_list(E_bin)]), - test_server:fail(comp); + ct:fail(comp); 0 -> ok; %% For situations where the final bits may not matter, like @@ -252,23 +246,22 @@ fail_check({'EXIT',{badarg,_}}, Str, Vars) -> try evaluate(Str, Vars) of Res -> io:format("Interpreted result: ~p", [Res]), - ?t:fail(did_not_fail_in_intepreted_code) + ct:fail(did_not_fail_in_intepreted_code) catch error:badarg -> ok end; fail_check(Res, _, _) -> io:format("Compiled result: ~p", [Res]), - ?t:fail(did_not_fail_in_compiled_code). + ct:fail(did_not_fail_in_compiled_code). %%% Simple working cases -test1(suite) -> []; test1(Config) when is_list(Config) -> - ?line I_13 = i(13), - ?line I_big1 = big(1), - ?line Vars = [{'I_13', I_13}, + I_13 = i(13), + I_big1 = big(1), + Vars = [{'I_13', I_13}, {'I_big1', I_big1}], - ?line lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1), Vars)). + lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1), Vars)). %%% Misc @@ -284,10 +277,9 @@ gen(N, S, A) -> gen_l(N, S, A) -> [?T(<<A:S/little, A:(N-S)/little>>, comp(N, A, S))]. -test2(suite) -> []; test2(Config) when is_list(Config) -> - ?line test2(0, 8, 2#10101010101010101), - ?line test2(0, 8, 2#1111111111). + test2(0, 8, 2#10101010101010101), + test2(0, 8, 2#1111111111). test2(End, End, _) -> ok; @@ -312,10 +304,9 @@ t3() -> ?N(<<>>) ]. -test3(suite) -> []; test3(Config) when is_list(Config) -> - ?line Vars = [], - ?line lists:foreach(fun one_test/1, eval_list(t3(), Vars)). + Vars = [], + lists:foreach(fun one_test/1, eval_list(t3(), Vars)). gen_u(N, S, A) -> [?N(<<A:S, A:(N-S)>>)]. @@ -323,10 +314,9 @@ gen_u(N, S, A) -> gen_u_l(N, S, A) -> [?N(<<A:S/little, A:(N-S)/little>>)]. -test4(suite) -> []; test4(Config) when is_list(Config) -> - ?line test4(0, 16, 2#10101010101010101), - ?line test4(0, 16, 2#1111111111). + test4(0, 16, 2#10101010101010101), + test4(0, 16, 2#1111111111). test4(End, End, _) -> ok; @@ -344,11 +334,10 @@ gen_b(N, S, A) -> [?T(<<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>, binary_to_list(<<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>))]. -test5(suite) -> []; -test5(doc) -> ["OTP-3995"]; +%% OTP-3995 test5(Config) when is_list(Config) -> - ?line test5(0, 8, <<73>>), - ?line test5(0, 8, <<68>>). + test5(0, 8, <<73>>), + test5(0, 8, <<68>>). test5(End, End, _) -> ok; @@ -362,47 +351,46 @@ test5(S, A) -> lists:foreach(fun one_test/1, eval_list(gen_b(N, S, A), Vars)). %%% Failure cases -testf(suite) -> []; testf(Config) when is_list(Config) -> - ?line ?FAIL(<<3.14>>), - ?line ?FAIL(<<<<1,2>>>>), + ?FAIL(<<3.14>>), + ?FAIL(<<<<1,2>>>>), - ?line ?FAIL(<<2.71/binary>>), - ?line ?FAIL(<<24334/binary>>), - ?line ?FAIL(<<24334344294788947129487129487219847/binary>>), + ?FAIL(<<2.71/binary>>), + ?FAIL(<<24334/binary>>), + ?FAIL(<<24334344294788947129487129487219847/binary>>), BigInt = id(24334344294788947129487129487219847), - ?line ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]), - ?line ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]), - ?line ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]), + ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]), + ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]), + ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]), %% One negative field size, but the sum of field sizes will be 1 byte. %% Make sure that we reject that properly. I_minus_777 = id(-777), I_minus_2047 = id(-2047), - ?line ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>, + ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>, ordsets:from_list([{'I_minus_777',I_minus_777}, {'I_minus_2047',I_minus_2047}])), - ?line ?FAIL(<<<<1,2,3>>/float>>), + ?FAIL(<<<<1,2,3>>/float>>), %% Negative field widths. - ?line testf_1(-8, <<1,2,3,4,5>>), - ?line ?FAIL(<<0:(-(1 bsl 100))>>), + testf_1(-8, <<1,2,3,4,5>>), + ?FAIL(<<0:(-(1 bsl 100))>>), - ?line ?FAIL(<<42:(-16)>>), - ?line ?FAIL(<<3.14:(-8)/float>>), - ?line ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), - ?line ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), - ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), - ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?FAIL(<<42:(-16)>>), + ?FAIL(<<3.14:(-8)/float>>), + ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), + ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), + ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?FAIL(<<<<23,56,0,2>>:(anka)>>), %% Unit failures. - ?line ?FAIL(<<<<1:1>>/binary>>), + ?FAIL(<<<<1:1>>/binary>>), Sz = id(1), - ?line ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]), - ?line {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>), - ?line ?FAIL(<<<<7,8,9>>/binary-unit:16>>), - ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>), - ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>), + ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]), + {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>), + ?FAIL(<<<<7,8,9>>/binary-unit:16>>), + ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>), + ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>), ok. @@ -412,14 +400,13 @@ testf_1(W, B) -> ?FAIL_VARS(<<3.14:W/float>>, Vars), ?FAIL_VARS(<<B:W/binary>>, [{'B',B}|Vars]). -not_used(doc) -> - "Test that constructed binaries that are not used will still give an exception."; +%% Test that constructed binaries that are not used will still give an exception. not_used(Config) when is_list(Config) -> - ?line ok = not_used1(3, <<"dum">>), - ?line {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")), - ?line {'EXIT',{badarg,_}} = (catch not_used2(444, -2)), - ?line {'EXIT',{badarg,_}} = (catch not_used2(444, anka)), - ?line {'EXIT',{badarg,_}} = (catch not_used3(444)), + ok = not_used1(3, <<"dum">>), + {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")), + {'EXIT',{badarg,_}} = (catch not_used2(444, -2)), + {'EXIT',{badarg,_}} = (catch not_used2(444, anka)), + {'EXIT',{badarg,_}} = (catch not_used3(444)), ok. not_used1(I, BinString) -> @@ -435,11 +422,11 @@ not_used3(I) -> ok. in_guard(Config) when is_list(Config) -> - ?line 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), - ?line 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), - ?line 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), - ?line 3 = in_guard(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3), - ?line 3 = in_guard(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226), + 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), + 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), + 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), + 3 = in_guard(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3), + 3 = in_guard(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226), nope = in_guard(<<1>>, 42, b), nope = in_guard(<<1>>, a, b), nope = in_guard(<<1,2>>, 1, 1), @@ -453,16 +440,16 @@ in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3; in_guard(Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> cant_happen; in_guard(_, _, _) -> nope. -mem_leak(doc) -> "Make sure that construction has no memory leak"; +%% Make sure that construction has no memory leak mem_leak(Config) when is_list(Config) -> - ?line B = make_bin(16, <<0>>), - ?line mem_leak(1024, B), + B = make_bin(16, <<0>>), + mem_leak(1024, B), ok. mem_leak(0, _) -> ok; mem_leak(N, B) -> - ?line big_bin(B, <<23>>), - ?line {'EXIT',{badarg,_}} = (catch big_bin(B, bad)), + big_bin(B, <<23>>), + {'EXIT',{badarg,_}} = (catch big_bin(B, bad)), mem_leak(N-1, B). big_bin(B1, B2) -> @@ -476,18 +463,18 @@ make_bin(0, Acc) -> Acc; make_bin(N, Acc) -> make_bin(N-1, <<Acc/binary,Acc/binary>>). -define(COF(Int0), - ?line (fun(Int) -> + (fun(Int) -> true = <<Int:32/float>> =:= <<(float(Int)):32/float>>, true = <<Int:64/float>> =:= <<(float(Int)):64/float>> end)(nonliteral(Int0)), - ?line true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>, - ?line true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). + true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>, + true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). -define(COF64(Int0), - ?line (fun(Int) -> + (fun(Int) -> true = <<Int:64/float>> =:= <<(float(Int)):64/float>> end)(nonliteral(Int0)), - ?line true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). + true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). nonliteral(X) -> X. @@ -506,7 +493,7 @@ coerce_to_float(Config) when is_list(Config) -> ok. bjorn(Config) when is_list(Config) -> - ?line error = bjorn_1(), + error = bjorn_1(), ok. bjorn_1() -> @@ -534,76 +521,81 @@ do_something() -> throw(blurf). huge_float_field(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>), - ?line huge_float_check(catch <<0.0:67108865/float-unit:64>>), - ?line huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>), - ?line huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>), -%% ?line huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>), - ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>), -%% ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>), + {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>), + huge_float_check(catch <<0.0:67108865/float-unit:64>>), + huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>), + huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>), +%% huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>), + huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>), +%% huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>), ok. huge_float_check({'EXIT',{system_limit,_}}) -> ok; huge_float_check({'EXIT',{badarg,_}}) -> ok. huge_binary(Config) when is_list(Config) -> - ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), - ?line garbage_collect(), + ct:timetrap({seconds, 60}), + 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), + garbage_collect(), + FreeMem = free_mem(), + io:format("Free memory (Mb): ~p\n", [FreeMem]), {Shift,Return} = case free_mem() of - undefined -> {32,ok}; - Mb when Mb > 600 -> {32,ok}; - Mb when Mb > 300 -> {31,"Limit huge binaries to 256 Mb"}; - _ -> {30,"Limit huge binary to 128 Mb"} + undefined -> + %% This test has to be inlined inside the case to + %% use a literal Shift + garbage_collect(), + id(<<0:((1 bsl 32)-1)>>), + {32,ok}; + Mb when Mb > 600 -> + garbage_collect(), + id(<<0:((1 bsl 32)-1)>>), + {32,ok}; + Mb when Mb > 300 -> + garbage_collect(), + id(<<0:((1 bsl 31)-1)>>), + {31,"Limit huge binaries to 256 Mb"}; + Mb when Mb > 200 -> + garbage_collect(), + id(<<0:((1 bsl 30)-1)>>), + {30,"Limit huge binary to 128 Mb"}; + _ -> + garbage_collect(), + id(<<0:((1 bsl 29)-1)>>), + {29,"Limit huge binary to 64 Mb"} end, - ?line garbage_collect(), - ?line id(<<0:((1 bsl Shift)-1)>>), - ?line garbage_collect(), - ?line id(<<0:(id((1 bsl Shift)-1))>>), - ?line garbage_collect(), + garbage_collect(), + id(<<0:((1 bsl Shift)-1)>>), + garbage_collect(), + id(<<0:(id((1 bsl Shift)-1))>>), + garbage_collect(), case Return of ok -> ok; Comment -> {comment, Comment} end. +%% Return the amount of free memory in Mb. free_mem() -> - Cmd = "uname; free", - Output = string:tokens(os:cmd(Cmd), "\n"), - io:format("Output from command ~p\n~p\n",[Cmd,Output]), - case Output of - [OS, ColumnNames, Values | _] -> - case string:str(OS,"Linux") of - 0 -> - io:format("Unknown OS\n",[]), - undefined; - _ -> - case {string:tokens(ColumnNames, " \t"), - string:tokens(Values, " \t")} of - {[_,_,"free"|_],["Mem:",_,_,FreeKb|_]} -> - list_to_integer(FreeKb) div 1024; - _ -> - io:format("Failed to parse output from 'free':\n",[]), - undefined - end - end; - _ -> - io:format("Too few lines in output\n",[]), - undefined + {ok,Apps} = application:ensure_all_started(os_mon), + Mem = memsup:get_system_memory_data(), + [ok = application:stop(App)||App <- Apps], + case proplists:get_value(free_memory,Mem) of + undefined -> undefined; + Val -> Val div (1024*1024) end. - system_limit(Config) when is_list(Config) -> WordSize = erlang:system_info(wordsize), BitsPerWord = WordSize * 8, - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{system_limit,_}} = (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{system_limit,_}} = (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{system_limit,_}} = (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), %% Would fail to load. - ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), - ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), case WordSize of 4 -> @@ -613,60 +605,52 @@ system_limit(Config) when is_list(Config) -> end. system_limit_32() -> - ?line {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), - ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), - ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), - ?line {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), - ?line {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), - ?line {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), - ?line {'EXIT',{system_limit,_}} = - (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), %% The size would be silently truncated, resulting in a crash. - ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), - ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), %% Would fail to load. - ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), - ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), ok. badarg(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = - (catch <<0:(id(1 bsl 100)),0:(id(-1))>>), - ?line {'EXIT',{badarg,_}} = - (catch <<0:(id(1 bsl 100)),0:(id(-(1 bsl 70)))>>), - ?line {'EXIT',{badarg,_}} = - (catch <<0:(id(-(1 bsl 70))),0:(id(1 bsl 100))>>), - - ?line {'EXIT',{badarg,_}} = - (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>), - + {'EXIT',{badarg,_}} = (catch <<0:(id(1 bsl 100)),0:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<0:(id(1 bsl 100)),0:(id(-(1 bsl 70)))>>), + {'EXIT',{badarg,_}} = (catch <<0:(id(-(1 bsl 70))),0:(id(1 bsl 100))>>), + {'EXIT',{badarg,_}} = (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>), ok. copy_writable_binary(Config) when is_list(Config) -> - ?line [copy_writable_binary_1(I) || I <- lists:seq(0, 256)], + [copy_writable_binary_1(I) || I <- lists:seq(0, 256)], ok. copy_writable_binary_1(_) -> - ?line Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>, - ?line SubBin = make_sub_bin(Bin0), - ?line id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier. - ?line Pid = spawn(fun() -> + Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>, + SubBin = make_sub_bin(Bin0), + id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier. + Pid = spawn(fun() -> copy_writable_binary_holder(Bin0, SubBin) end), - ?line Tab = ets:new(holder, []), - ?line ets:insert(Tab, {17,Bin0}), - ?line ets:insert(Tab, {42,SubBin}), - ?line id(<<Bin0/binary,0:(64*1024*8)>>), - ?line Pid ! self(), - ?line [{17,Bin0}] = ets:lookup(Tab, 17), - ?line [{42,Bin0}] = ets:lookup(Tab, 42), + Tab = ets:new(holder, []), + ets:insert(Tab, {17,Bin0}), + ets:insert(Tab, {42,SubBin}), + id(<<Bin0/binary,0:(64*1024*8)>>), + Pid ! self(), + [{17,Bin0}] = ets:lookup(Tab, 17), + [{42,Bin0}] = ets:lookup(Tab, 42), receive {Pid,Bin0,Bin0} -> ok; Other -> - io:format("Unexpected message: ~p", [Other]), - ?line ?t:fail() + ct:fail("Unexpected message: ~p", [Other]) end, ok. @@ -707,8 +691,8 @@ have_250_terabytes_of_ram() -> false. %% give the same result. dynamic(Config) when is_list(Config) -> - ?line dynamic_1(fun dynamic_big/5), - ?line dynamic_1(fun dynamic_little/5), + dynamic_1(fun dynamic_big/5), + dynamic_1(fun dynamic_little/5), ok. dynamic_1(Dynamic) -> @@ -787,32 +771,32 @@ bs_add(Config) when is_list(Config) -> return], %% Write assembly file and assemble it. - ?line PrivDir = ?config(priv_dir, Config), - ?line RootName = filename:join(PrivDir, atom_to_list(Mod)), - ?line AsmFile = RootName ++ ".S", - ?line {ok,Fd} = file:open(AsmFile, [write]), - ?line [io:format(Fd, "~p. \n", [T]) || T <- Code], - ?line ok = file:close(Fd), - ?line {ok,Mod} = compile:file(AsmFile, [from_asm,report,{outdir,PrivDir}]), - ?line LoadRc = code:load_abs(RootName), - ?line {module,_Module} = LoadRc, + PrivDir = proplists:get_value(priv_dir, Config), + RootName = filename:join(PrivDir, atom_to_list(Mod)), + AsmFile = RootName ++ ".S", + {ok,Fd} = file:open(AsmFile, [write]), + [io:format(Fd, "~p. \n", [T]) || T <- Code], + ok = file:close(Fd), + {ok,Mod} = compile:file(AsmFile, [from_asm,report,{outdir,PrivDir}]), + LoadRc = code:load_abs(RootName), + {module,_Module} = LoadRc, %% Find smallest positive bignum. - ?line SmallestBig = smallest_big(), - ?line io:format("~p\n", [SmallestBig]), - ?line Expected = SmallestBig + N, + SmallestBig = smallest_big(), + io:format("~p\n", [SmallestBig]), + Expected = SmallestBig + N, DoTest = fun() -> exit(Mod:bs_add(SmallestBig, -SmallestBig)) end, - ?line {Pid,Mref} = spawn_monitor(DoTest), + {Pid,Mref} = spawn_monitor(DoTest), receive {'DOWN',Mref,process,Pid,Res} -> ok end, - ?line Expected = Res, + Expected = Res, %% Clean up. - ?line ok = file:delete(AsmFile), - ?line ok = file:delete(code:which(Mod)), + ok = file:delete(AsmFile), + ok = file:delete(code:which(Mod)), ok. @@ -853,17 +837,17 @@ otp_7422_bin(N) when N < 512 -> otp_7422_bin(_) -> ok. zero_width(Config) when is_list(Config) -> - ?line Z = id(0), + Z = id(0), Small = id(42), Big = id(1 bsl 128), - ?line <<>> = <<Small:Z>>, - ?line <<>> = <<Small:0>>, - ?line <<>> = <<Big:Z>>, - ?line <<>> = <<Big:0>>, + <<>> = <<Small:Z>>, + <<>> = <<Small:0>>, + <<>> = <<Big:Z>>, + <<>> = <<Big:0>>, - ?line {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), - ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>), - ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>), + {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), + {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>), + {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>), ok. @@ -910,5 +894,42 @@ append_unit_8(Bin) -> append_unit_16(Bin) -> <<Bin/binary-unit:16,0:1>>. - +%% Produce a large result of bs_add that, if cast to signed int, would overflow +%% into a negative number that fits a smallnum. +bs_add_overflow(_Config) -> + Memsize = memsize(), + io:format("Memsize = ~w Bytes~n", [Memsize]), + case erlang:system_info(wordsize) of + 8 -> + {skip, "64-bit architecture"}; + _ when Memsize < (2 bsl 30) -> + {skip, "Less then 2 GB of memory"}; + 4 -> + {'EXIT', {system_limit, _}} = (catch bs_add_overflow_signed()), + {'EXIT', {system_limit, _}} = (catch bs_add_overflow_unsigned()), + ok + end. + +bs_add_overflow_signed() -> + %% Produce a large result of bs_add that, if cast to signed int, would + %% overflow into a negative number that fits a smallnum. + Large = <<0:((1 bsl 30)-1)>>, + <<Large/bits, Large/bits, Large/bits, Large/bits, + Large/bits, Large/bits, Large/bits, Large/bits, + Large/bits>>. + +bs_add_overflow_unsigned() -> + %% Produce a large result of bs_add that goes beyond the limit of an + %% unsigned word. This used to succeed but produced an incorrect result + %% where B =:= C! + A = <<0:((1 bsl 32)-8)>>, + B = <<2, 3>>, + C = <<A/binary,1,B/binary>>, + true = byte_size(B) < byte_size(C). + id(I) -> I. + +memsize() -> + application:ensure_all_started(os_mon), + {Tot,_Used,_} = memsup:get_memory_data(), + Tot. diff --git a/erts/emulator/test/bs_match_bin_SUITE.erl b/erts/emulator/test/bs_match_bin_SUITE.erl index 96e69dbc0b..f5c996ae9e 100644 --- a/erts/emulator/test/bs_match_bin_SUITE.erl +++ b/erts/emulator/test/bs_match_bin_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,7 +24,7 @@ init_per_group/2,end_per_group/2, byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -46,33 +47,33 @@ end_per_group(_GroupName, Config) -> Config. -byte_split_binary(doc) -> "Tries to split a binary at all byte-aligned positions."; +%% Tries to split a binary at all byte-aligned positions. byte_split_binary(Config) when is_list(Config) -> - ?line L = lists:seq(0, 57), - ?line B = mkbin(L), - ?line byte_split(L, B, size(B)), - ?line Unaligned = make_unaligned_sub_binary(B), - ?line byte_split(L, Unaligned, size(Unaligned)). + L = lists:seq(0, 57), + B = mkbin(L), + byte_split(L, B, size(B)), + Unaligned = make_unaligned_sub_binary(B), + byte_split(L, Unaligned, size(Unaligned)). byte_split(L, B, Pos) when Pos >= 0 -> - ?line Sz1 = Pos, - ?line Sz2 = size(B) - Pos, - ?line <<B1:Sz1/binary,B2:Sz2/binary>> = B, - ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)), - ?line B2 = list_to_binary(lists:nthtail(Pos, L)), - ?line byte_split(L, B, Pos-1); + Sz1 = Pos, + Sz2 = size(B) - Pos, + <<B1:Sz1/binary,B2:Sz2/binary>> = B, + B1 = list_to_binary(lists:sublist(L, 1, Pos)), + B2 = list_to_binary(lists:nthtail(Pos, L)), + byte_split(L, B, Pos-1); byte_split(_, _, _) -> ok. -bit_split_binary(doc) -> "Tries to split a binary at all positions."; +%% Tries to split a binary at all positions. bit_split_binary(Config) when is_list(Config) -> Fun = fun(Bin, List, SkipBef, N) -> - ?line SkipAft = 8*size(Bin) - N - SkipBef, + SkipAft = 8*size(Bin) - N - SkipBef, %%io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), - ?line <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin, - ?line OutBin = make_bin_from_list(List, N) + <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin, + OutBin = make_bin_from_list(List, N) end, - ?line bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)), - ?line bit_split_binary1(Fun, + bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)), + bit_split_binary1(Fun, make_unaligned_sub_binary(erlang:md5(<<1,2,3>>))), ok. @@ -118,19 +119,19 @@ make_unaligned_sub_binary(Bin0) -> id(I) -> I. match_huge_bin(Config) when is_list(Config) -> - ?line Bin = <<0:(1 bsl 27),13:8>>, - ?line skip_huge_bin_1(1 bsl 27, Bin), - ?line 16777216 = match_huge_bin_1(1 bsl 27, Bin), + Bin = <<0:(1 bsl 27),13:8>>, + skip_huge_bin_1(1 bsl 27, Bin), + 16777216 = match_huge_bin_1(1 bsl 27, Bin), %% Test overflowing the size of a binary field. - ?line nomatch = overflow_huge_bin_skip_32(Bin), - ?line nomatch = overflow_huge_bin_32(Bin), - ?line nomatch = overflow_huge_bin_skip_64(Bin), - ?line nomatch = overflow_huge_bin_64(Bin), + nomatch = overflow_huge_bin_skip_32(Bin), + nomatch = overflow_huge_bin_32(Bin), + nomatch = overflow_huge_bin_skip_64(Bin), + nomatch = overflow_huge_bin_64(Bin), %% Size in variable - ?line ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)), - ?line ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), ok. diff --git a/erts/emulator/test/bs_match_int_SUITE.erl b/erts/emulator/test/bs_match_int_SUITE.erl index ce03ecb548..e913dc98b0 100644 --- a/erts/emulator/test/bs_match_int_SUITE.erl +++ b/erts/emulator/test/bs_match_int_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% @@ -23,7 +24,7 @@ integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1, match_huge_int/1,bignum/1,unaligned_32_bit/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [seq/2]). @@ -50,22 +51,22 @@ end_per_group(_GroupName, Config) -> integer(Config) when is_list(Config) -> - ?line 0 = get_int(mkbin([])), - ?line 0 = get_int(mkbin([0])), - ?line 42 = get_int(mkbin([42])), - ?line 255 = get_int(mkbin([255])), - ?line 256 = get_int(mkbin([1,0])), - ?line 257 = get_int(mkbin([1,1])), - ?line 258 = get_int(mkbin([1,2])), - ?line 258 = get_int(mkbin([1,2])), - ?line 65534 = get_int(mkbin([255,254])), - ?line 16776455 = get_int(mkbin([255,253,7])), - ?line 4245492555 = get_int(mkbin([253,13,19,75])), - ?line 4294967294 = get_int(mkbin([255,255,255,254])), - ?line 4294967295 = get_int(mkbin([255,255,255,255])), - ?line Eight = [200,1,19,128,222,42,97,111], - ?line cmp128(Eight, uint(Eight)), - ?line fun_clause(catch get_int(mkbin(seq(1,5)))), + 0 = get_int(mkbin([])), + 0 = get_int(mkbin([0])), + 42 = get_int(mkbin([42])), + 255 = get_int(mkbin([255])), + 256 = get_int(mkbin([1,0])), + 257 = get_int(mkbin([1,1])), + 258 = get_int(mkbin([1,2])), + 258 = get_int(mkbin([1,2])), + 65534 = get_int(mkbin([255,254])), + 16776455 = get_int(mkbin([255,253,7])), + 4245492555 = get_int(mkbin([253,13,19,75])), + 4294967294 = get_int(mkbin([255,255,255,254])), + 4294967295 = get_int(mkbin([255,255,255,255])), + Eight = [200,1,19,128,222,42,97,111], + cmp128(Eight, uint(Eight)), + fun_clause(catch get_int(mkbin(seq(1,5)))), ok. get_int(Bin) -> @@ -88,13 +89,13 @@ cmp128(<<I:128>>, I) -> equal; cmp128(_, _) -> not_equal. signed_integer(Config) when is_list(Config) -> - ?line {no_match,_} = sint(mkbin([])), - ?line {no_match,_} = sint(mkbin([1,2,3])), - ?line 127 = sint(mkbin([127])), - ?line -1 = sint(mkbin([255])), - ?line -128 = sint(mkbin([128])), - ?line 42 = sint(mkbin([42,255])), - ?line 127 = sint(mkbin([127,255])). + {no_match,_} = sint(mkbin([])), + {no_match,_} = sint(mkbin([1,2,3])), + 127 = sint(mkbin([127])), + -1 = sint(mkbin([255])), + -128 = sint(mkbin([128])), + 42 = sint(mkbin([42,255])), + 127 = sint(mkbin([127,255])). sint(Bin) -> case Bin of @@ -129,7 +130,7 @@ dynamic(Bin, S1, S2, A, B) -> _Other -> erlang:error(badmatch, [Bin,S1,S2,A,B]) end. -more_dynamic(doc) -> "Extract integers at different alignments and of different sizes."; +%% Extract integers at different alignments and of different sizes. more_dynamic(Config) when is_list(Config) -> % Unsigned big-endian numbers. @@ -138,7 +139,7 @@ more_dynamic(Config) when is_list(Config) -> <<_:SkipBef,Int:N,_:SkipAft>> = Bin, Int = make_int(List, N, 0) end, - ?line more_dynamic1(Unsigned, erlang:md5(mkbin([42]))), + more_dynamic1(Unsigned, erlang:md5(mkbin([42]))), %% Signed big-endian numbers. Signed = fun(Bin, List, SkipBef, N) -> @@ -150,10 +151,10 @@ more_dynamic(Config) when is_list(Config) -> io:format("Bin = ~p,", [Bin]), io:format("SkipBef = ~p, N = ~p", [SkipBef,N]), io:format("Expected ~p, got ~p", [Int,Other]), - ?t:fail() + ct:fail(signed_big_endian_fail) end end, - ?line more_dynamic1(Signed, erlang:md5(mkbin([43]))), + more_dynamic1(Signed, erlang:md5(mkbin([43]))), %% Unsigned little-endian numbers. UnsLittle = fun(Bin, List, SkipBef, N) -> @@ -161,7 +162,7 @@ more_dynamic(Config) when is_list(Config) -> <<_:SkipBef,Int:N/little,_:SkipAft>> = Bin, Int = make_int(big_to_little(List, N), N, 0) end, - ?line more_dynamic1(UnsLittle, erlang:md5(mkbin([44]))), + more_dynamic1(UnsLittle, erlang:md5(mkbin([44]))), %% Signed little-endian numbers. SignLittle = fun(Bin, List, SkipBef, N) -> @@ -170,7 +171,7 @@ more_dynamic(Config) when is_list(Config) -> Little = big_to_little(List, N), Int = make_signed_int(Little, N) end, - ?line more_dynamic1(SignLittle, erlang:md5(mkbin([45]))), + more_dynamic1(SignLittle, erlang:md5(mkbin([45]))), ok. @@ -226,39 +227,39 @@ mkbin(L) when is_list(L) -> list_to_binary(L). mml(Config) when is_list(Config) -> - ?line single_byte_binary = mml_choose(<<42>>), - ?line multi_byte_binary = mml_choose(<<42,43>>). + single_byte_binary = mml_choose(<<42>>), + multi_byte_binary = mml_choose(<<42,43>>). mml_choose(<<_A:8>>) -> single_byte_binary; mml_choose(<<_A:8,_T/binary>>) -> multi_byte_binary. match_huge_int(Config) when is_list(Config) -> Sz = 1 bsl 27, - ?line Bin = <<0:Sz,13:8>>, - ?line skip_huge_int_1(Sz, Bin), - ?line 0 = match_huge_int_1(Sz, Bin), + Bin = <<0:Sz,13:8>>, + skip_huge_int_1(Sz, Bin), + 0 = match_huge_int_1(Sz, Bin), %% Test overflowing the size of an integer field. - ?line nomatch = overflow_huge_int_skip_32(Bin), + nomatch = overflow_huge_int_skip_32(Bin), case erlang:system_info(wordsize) of 4 -> - ?line nomatch = overflow_huge_int_32(Bin); + nomatch = overflow_huge_int_32(Bin); 8 -> %% An attempt will be made to allocate heap space for %% the bignum (which will probably fail); only if the - %% allocation succeds will the matching fail because + %% allocation succeeds will the matching fail because %% the binary is too small. ok end, - ?line nomatch = overflow_huge_int_skip_64(Bin), - ?line nomatch = overflow_huge_int_64(Bin), + nomatch = overflow_huge_int_skip_64(Bin), + nomatch = overflow_huge_int_64(Bin), %% Test overflowing the size of an integer field using variables as sizes. - ?line Sizes = case erlang:system_info(wordsize) of + Sizes = case erlang:system_info(wordsize) of 4 -> lists:seq(25, 32); 8 -> [] end ++ lists:seq(50, 64), - ?line ok = overflow_huge_int_unit128(Bin, Sizes), + ok = overflow_huge_int_unit128(Bin, Sizes), ok. @@ -325,19 +326,19 @@ overflow_huge_int_64(<<Int:9223372036854775808/unit:128,0,_/binary>>) -> {8,Int} overflow_huge_int_64(_) -> nomatch. bignum(Config) when is_list(Config) -> - ?line Bin = id(<<42,0:1024/unit:8,43>>), - ?line <<42:1025/little-integer-unit:8,_:8>> = Bin, - ?line <<_:8,43:1025/integer-unit:8>> = Bin, + Bin = id(<<42,0:1024/unit:8,43>>), + <<42:1025/little-integer-unit:8,_:8>> = Bin, + <<_:8,43:1025/integer-unit:8>> = Bin, - ?line BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>), - ?line <<258254417031933722623:(512+9)/unit:8>> = BignumBin, + BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>), + <<258254417031933722623:(512+9)/unit:8>> = BignumBin, erlang:garbage_collect(), %Search for holes in debug-build. ok. unaligned_32_bit(Config) when is_list(Config) -> %% There used to be a risk for heap overflow (fixed in R11B-5). - ?line L = unaligned_32_bit_1(<<-1:(64*1024)>>), - ?line unaligned_32_bit_verify(L, 1638). + L = unaligned_32_bit_1(<<-1:(64*1024)>>), + unaligned_32_bit_verify(L, 1638). unaligned_32_bit_1(<<1:1,U:32,_:7,T/binary>>) -> [U|unaligned_32_bit_1(T)]; diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl index b0904acbe9..17759d78f3 100644 --- a/erts/emulator/test/bs_match_misc_SUITE.erl +++ b/erts/emulator/test/bs_match_misc_SUITE.erl @@ -1,34 +1,36 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2011. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(bs_match_misc_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1, kenneth/1,encode_binary/1,native/1,happi/1, size_var/1,wiger/1,x0_context/1,huge_float_field/1, writable_binary_matched/1,otp_7198/1,unordered_bindings/1, float_middle_endian/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. all() -> [bound_var, bound_tail, t_float, little_float, sean, @@ -36,39 +38,24 @@ all() -> x0_context, huge_float_field, writable_binary_matched, otp_7198, unordered_bindings, float_middle_endian]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -bound_var(doc) -> "Test matching of bound variables."; +%% Test matching of bound variables. bound_var(Config) when is_list(Config) -> - ?line ok = bound_var(42, 13, <<42,13>>), - ?line nope = bound_var(42, 13, <<42,255>>), - ?line nope = bound_var(42, 13, <<154,255>>), + ok = bound_var(42, 13, <<42,13>>), + nope = bound_var(42, 13, <<42,255>>), + nope = bound_var(42, 13, <<154,255>>), ok. bound_var(A, B, <<A:8,B:8>>) -> ok; bound_var(_, _, _) -> nope. -bound_tail(doc) -> "Test matching of a bound tail."; +%% Test matching of a bound tail. bound_tail(Config) when is_list(Config) -> - ?line ok = bound_tail(<<>>, <<13,14>>), - ?line ok = bound_tail(<<2,3>>, <<1,1,2,3>>), - ?line nope = bound_tail(<<2,3>>, <<1,1,2,7>>), - ?line nope = bound_tail(<<2,3>>, <<1,1,2,3,4>>), - ?line nope = bound_tail(<<2,3>>, <<>>), + ok = bound_tail(<<>>, <<13,14>>), + ok = bound_tail(<<2,3>>, <<1,1,2,3>>), + nope = bound_tail(<<2,3>>, <<1,1,2,7>>), + nope = bound_tail(<<2,3>>, <<1,1,2,3,4>>), + nope = bound_tail(<<2,3>>, <<>>), ok. bound_tail(T, <<_:16,T/binary>>) -> ok; @@ -78,26 +65,26 @@ t_float(Config) when is_list(Config) -> F = f1(), G = f_one(), - ?line G = match_float(<<63,128,0,0>>, 32, 0), - ?line G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0), + G = match_float(<<63,128,0,0>>, 32, 0), + G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0), - ?line fcmp(F, match_float(<<F:32/float>>, 32, 0)), - ?line fcmp(F, match_float(<<F:64/float>>, 64, 0)), - ?line fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)), - ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), - ?line fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), - ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + fcmp(F, match_float(<<F:32/float>>, 32, 0)), + fcmp(F, match_float(<<F:64/float>>, 64, 0)), + fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)), + fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), + fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), + fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), - ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)), - ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)), + {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)), + {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)), ok. float_middle_endian(Config) when is_list(Config) -> F = 9007199254740990.0, % turns to -NaN when word-swapped - ?line fcmp(F, match_float(<<F:64/float>>, 64, 0)), - ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), - ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + fcmp(F, match_float(<<F:64/float>>, 64, 0)), + fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), + fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), ok. @@ -114,15 +101,15 @@ little_float(Config) when is_list(Config) -> F = f2(), G = f_one(), - ?line G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0), - ?line G = match_float_little(<<0,0,128,63>>, 32, 0), + G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0), + G = match_float_little(<<0,0,128,63>>, 32, 0), - ?line fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)), - ?line fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)), - ?line fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)), - ?line fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)), - ?line fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)), - ?line fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)), + fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)), + fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)), + fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)), + fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)), + fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)), + fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)), ok. @@ -150,16 +137,16 @@ f_one() -> 1.0. sean(Config) when is_list(Config) -> - ?line small = sean1(<<>>), - ?line small = sean1(<<1>>), - ?line small = sean1(<<1,2>>), - ?line small = sean1(<<1,2,3>>), - ?line large = sean1(<<1,2,3,4>>), - - ?line small = sean1(<<4>>), - ?line small = sean1(<<4,5>>), - ?line small = sean1(<<4,5,6>>), - ?line {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)), + small = sean1(<<>>), + small = sean1(<<1>>), + small = sean1(<<1,2>>), + small = sean1(<<1,2,3>>), + large = sean1(<<1,2,3,4>>), + + small = sean1(<<4>>), + small = sean1(<<4,5>>), + small = sean1(<<4,5,6>>), + {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)), ok. sean1(<<B/binary>>) when byte_size(B) < 4 -> small; @@ -291,28 +278,28 @@ getBase64Char(_Else) -> -define(M(F), <<F>> = <<F>>). native(Config) when is_list(Config) -> - ?line ?M(3.14:64/native-float), - ?line ?M(333:16/native), - ?line ?M(38658345:32/native), + ?M(3.14:64/native-float), + ?M(333:16/native), + ?M(38658345:32/native), case <<1:16/native>> of <<0,1>> -> native_big(); <<1,0>> -> native_little() end. native_big() -> - ?line <<37.33:64/native-float>> = <<37.33:64/big-float>>, - ?line <<3974:16/native-integer>> = <<3974:16/big-integer>>, + <<37.33:64/native-float>> = <<37.33:64/big-float>>, + <<3974:16/native-integer>> = <<3974:16/big-integer>>, {comment,"Big endian"}. native_little() -> - ?line <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>, - ?line <<7974:16/native-integer>> = <<7974:16/little-integer>>, + <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>, + <<7974:16/native-integer>> = <<7974:16/little-integer>>, {comment,"Little endian"}. happi(Config) when is_list(Config) -> Bin = <<".123">>, - ?line <<"123">> = lex_digits1(Bin, 1, []), - ?line <<"123">> = lex_digits2(Bin, 1, []), + <<"123">> = lex_digits1(Bin, 1, []), + <<"123">> = lex_digits2(Bin, 1, []), ok. lex_digits1(<<$., Rest/binary>>,_Val,_Acc) -> @@ -333,16 +320,16 @@ dec(A) -> A-$0. size_var(Config) when is_list(Config) -> - ?line {<<45>>,<<>>} = split(<<1:16,45>>), - ?line {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>), - ?line {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>), + {<<45>>,<<>>} = split(<<1:16,45>>), + {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>), + {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>), - ?line {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>), + {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>), - ?line {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>), - ?line {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)), + {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>), + {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)), - ?line <<"cdef">> = skip(<<2:8,"abcdef">>), + <<"cdef">> = skip(<<2:8,"abcdef">>), ok. @@ -358,11 +345,11 @@ split_2(<<N0:8,N:N0,B:N/binary,T/binary>>) -> skip(<<N:8,_:N/binary,T/binary>>) -> T. wiger(Config) when is_list(Config) -> - ?line ok1 = wcheck(<<3>>), - ?line ok2 = wcheck(<<1,2,3>>), - ?line ok3 = wcheck(<<4>>), - ?line {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>), - ?line {error,<<>>} = wcheck(<<>>), + ok1 = wcheck(<<3>>), + ok2 = wcheck(<<1,2,3>>), + ok3 = wcheck(<<4>>), + {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>), + {error,<<>>} = wcheck(<<>>), ok. wcheck(<<A>>) when A==3-> @@ -395,24 +382,24 @@ x0_2(_, Bin) -> x0_3(_, Bin) -> case Bin of - <<_:72,7:8,_/binary>> -> - ?line ?t:fail(); - <<_:64,0:16,_/binary>> -> - ?line ?t:fail(); - <<_:64,42:16,123456:32,_/binary>> -> - ok + <<_:72,7:8,_/binary>> -> + ct:fail(bs_matched_1); + <<_:64,0:16,_/binary>> -> + ct:fail(bs_matched_2); + <<_:64,42:16,123456:32,_/binary>> -> + ok end. huge_float_field(Config) when is_list(Config) -> Sz = 1 bsl 27, - ?line Bin = <<0:Sz>>, + Bin = <<0:Sz>>, - ?line nomatch = overflow_huge_float_skip_32(Bin), - ?line nomatch = overflow_huge_float_32(Bin), + nomatch = overflow_huge_float_skip_32(Bin), + nomatch = overflow_huge_float_32(Bin), - ?line ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)), - ?line ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), ok. overflow_huge_float_skip_32(<<_:4294967296/float,0,_/binary>>) -> 1; % 1 bsl 32 @@ -454,15 +441,15 @@ overflow_huge_float(_, []) -> ok. overflow_huge_float_unit128(Bin, [Sz0|Sizes]) -> Sz = id(1 bsl Sz0), case Bin of - <<_:Sz/float-unit:128,0,_/binary>> -> - {error,Sz}; - _ -> - case Bin of - <<Var:Sz/float-unit:128,0,_/binary>> -> - {error,Sz,Var}; - _ -> - overflow_huge_float_unit128(Bin, Sizes) - end + <<_:Sz/float-unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<Var:Sz/float-unit:128,0,_/binary>> -> + {error,Sz,Var}; + _ -> + overflow_huge_float_unit128(Bin, Sizes) + end end; overflow_huge_float_unit128(_, []) -> ok. @@ -472,25 +459,24 @@ overflow_huge_float_unit128(_, []) -> ok. %% writable_binary_matched(Config) when is_list(Config) -> - ?line WritableBin = create_writeable_binary(), - ?line writable_binary_matched(WritableBin, WritableBin, 500). + WritableBin = create_writeable_binary(), + writable_binary_matched(WritableBin, WritableBin, 500). writable_binary_matched(<<0>>, _, N) -> - if - N =:= 0 -> ok; - true -> - put(grow_heap, [N|get(grow_heap)]), - ?line WritableBin = create_writeable_binary(), - ?line writable_binary_matched(WritableBin, WritableBin, N-1) + if N =:= 0 -> ok; + true -> + put(grow_heap, [N|get(grow_heap)]), + WritableBin = create_writeable_binary(), + writable_binary_matched(WritableBin, WritableBin, N-1) end; writable_binary_matched(<<B:8,T/binary>>, WritableBin0, N) -> - ?line WritableBin = writable_binary(WritableBin0, B), + WritableBin = writable_binary(WritableBin0, B), writable_binary_matched(T, WritableBin, N). writable_binary(WritableBin0, B) when is_binary(WritableBin0) -> %% Heavy append to force the binary to move. - ?line WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>, - ?line id(<<(id(0)):128/unit:8>>), + WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>, + id(<<(id(0)):128/unit:8>>), WritableBin. create_writeable_binary() -> @@ -501,7 +487,7 @@ otp_7198(Config) when is_list(Config) -> %% increase the number of saved positions, the thing word was not updated %% to account for the new size. Therefore, if there was a garbage collection, %% the new slots would be included in the garbage collection. - ?line [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)], + [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)], ok. do_otp_7198(FillerSize) -> @@ -511,8 +497,7 @@ do_otp_7198(FillerSize) -> {'DOWN',Ref,process,Pid,normal} -> ok; {'DOWN',Ref,process,Pid,Reason} -> - io:format("unexpected: ~p", [Reason]), - ?line ?t:fail() + ct:fail("unexpected: ~p", [Reason]) end. do_otp_7198_test(_) -> @@ -539,27 +524,27 @@ otp_7198_scan(<<>>, TokAcc) -> otp_7198_scan(<<D, Z, Rest/binary>>, TokAcc) when (D =:= $D orelse D =:= $d) and ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> - otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); + otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); otp_7198_scan(<<D>>, TokAcc) when (D =:= $D) or (D =:= $d) -> - otp_7198_scan(<<>>, ['AND' | TokAcc]); + otp_7198_scan(<<>>, ['AND' | TokAcc]); otp_7198_scan(<<N, Z, Rest/binary>>, TokAcc) when (N =:= $N orelse N =:= $n) and ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> - otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); + otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); otp_7198_scan(<<C, Rest/binary>>, TokAcc) when (C >= $A) and (C =< $Z); (C >= $a) and (C =< $z); (C >= $0) and (C =< $9) -> - case Rest of - <<$:, R/binary>> -> - otp_7198_scan(R, [{'FIELD', C} | TokAcc]); - _ -> - otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) - end. + case Rest of + <<$:, R/binary>> -> + otp_7198_scan(R, [{'FIELD', C} | TokAcc]); + _ -> + otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) + end. unordered_bindings(Config) when is_list(Config) -> {<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} = diff --git a/erts/emulator/test/bs_match_tail_SUITE.erl b/erts/emulator/test/bs_match_tail_SUITE.erl index 1397f2069c..cbebc554c7 100644 --- a/erts/emulator/test/bs_match_tail_SUITE.erl +++ b/erts/emulator/test/bs_match_tail_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -20,61 +21,46 @@ -module(bs_match_tail_SUITE). -author('[email protected]'). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,aligned/1,unaligned/1,zero_tail/1]). +-export([all/0, suite/0, + aligned/1,unaligned/1,zero_tail/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [aligned, unaligned, zero_tail]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -aligned(doc) -> "Test aligned tails."; +%% Test aligned tails. aligned(Config) when is_list(Config) -> - ?line Tail1 = mkbin([]), - ?line {258,Tail1} = al_get_tail_used(mkbin([1,2])), - ?line Tail2 = mkbin(lists:seq(1, 127)), - ?line {35091,Tail2} = al_get_tail_used(mkbin([137,19|Tail2])), - - ?line 64896 = al_get_tail_unused(mkbin([253,128])), - ?line 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])), - - ?line Tail3 = mkbin(lists:seq(0, 19)), - ?line {0,Tail1} = get_dyn_tail_used(Tail1, 0), - ?line {0,Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0), - ?line {73,Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8), - - ?line 0 = get_dyn_tail_unused(mkbin([]), 0), - ?line 233 = get_dyn_tail_unused(mkbin([233]), 8), - ?line 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8), + Tail1 = mkbin([]), + {258,Tail1} = al_get_tail_used(mkbin([1,2])), + Tail2 = mkbin(lists:seq(1, 127)), + {35091,Tail2} = al_get_tail_used(mkbin([137,19|Tail2])), + + 64896 = al_get_tail_unused(mkbin([253,128])), + 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])), + + Tail3 = mkbin(lists:seq(0, 19)), + {0,Tail1} = get_dyn_tail_used(Tail1, 0), + {0,Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0), + {73,Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8), + + 0 = get_dyn_tail_unused(mkbin([]), 0), + 233 = get_dyn_tail_unused(mkbin([233]), 8), + 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8), ok. al_get_tail_used(<<A:16,T/binary>>) -> {A,T}. al_get_tail_unused(<<A:16,_/binary>>) -> A. -unaligned(doc) -> "Test that an non-aligned tail cannot be matched out."; +%% Test that an non-aligned tail cannot be matched out. unaligned(Config) when is_list(Config) -> - ?line {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))), - ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), - ?line {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), - ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)), + {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))), + {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), + {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), + {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)), ok. get_tail_used(<<A:1,T/binary>>) -> {A,T}. @@ -89,11 +75,11 @@ get_dyn_tail_unused(Bin, Sz) -> <<A:Sz,_/binary>> = Bin, A. -zero_tail(doc) -> "Test that zero tails are tested correctly."; +%% Test that zero tails are tested correctly. zero_tail(Config) when is_list(Config) -> - ?line 7 = (catch test_zero_tail(mkbin([7]))), - ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))), - ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))), + 7 = (catch test_zero_tail(mkbin([7]))), + {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))), + {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))), ok. test_zero_tail(<<A:8>>) -> A. @@ -101,7 +87,3 @@ test_zero_tail(<<A:8>>) -> A. test_zero_tail2(<<_A:4,_B:4>>) -> ok. mkbin(L) when is_list(L) -> list_to_binary(L). - - - - diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl index 4ab7d674a6..a344f5c456 100644 --- a/erts/emulator/test/bs_utf_SUITE.erl +++ b/erts/emulator/test/bs_utf_SUITE.erl @@ -1,70 +1,47 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(bs_utf_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, +-export([all/0, suite/0, utf8_roundtrip/1,utf16_roundtrip/1,utf32_roundtrip/1, utf8_illegal_sequences/1,utf16_illegal_sequences/1, utf32_illegal_sequences/1, bad_construction/1]). --include_lib("test_server/include/test_server.hrl"). - --define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). +-include_lib("common_test/include/ct.hrl"). -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(6)), - [{watchdog,Dog}|Config]. +-define(FAIL(Expr), fail_check(catch Expr, ??Expr, [])). -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 6}}]. all() -> [utf8_roundtrip, utf16_roundtrip, utf32_roundtrip, utf8_illegal_sequences, utf16_illegal_sequences, utf32_illegal_sequences, bad_construction]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - utf8_roundtrip(Config) when is_list(Config) -> - ?line utf8_roundtrip(0, 16#D7FF), - ?line utf8_roundtrip(16#E000, 16#10FFFF), + utf8_roundtrip(0, 16#D7FF), + utf8_roundtrip(16#E000, 16#10FFFF), ok. utf8_roundtrip(First, Last) when First =< Last -> @@ -82,10 +59,9 @@ utf16_roundtrip(Config) when is_list(Config) -> Big = fun utf16_big_roundtrip/1, Little = fun utf16_little_roundtrip/1, PidRefs = [spawn_monitor(fun() -> - do_utf16_roundtrip(Fun) - end) || Fun <- [Big,Little]], - [receive {'DOWN',Ref,process,Pid,Reason} -> normal=Reason end || - {Pid,Ref} <- PidRefs], + do_utf16_roundtrip(Fun) + end) || Fun <- [Big,Little]], + [receive {'DOWN',Ref,process,Pid,Reason} -> normal=Reason end || {Pid,Ref} <- PidRefs], ok. do_utf16_roundtrip(Fun) -> @@ -153,20 +129,20 @@ utf32_little_roundtrip(Char) -> ok. utf8_illegal_sequences(Config) when is_list(Config) -> - ?line fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. - ?line fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. + fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. + fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. %% Illegal first character. - ?line [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)], + [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)], %% Short sequences. - ?line short_sequences(16#80, 16#10FFFF), + short_sequences(16#80, 16#10FFFF), %% Overlong sequences. (Using more bytes than necessary %% is not allowed.) - ?line overlong(0, 127, 2), - ?line overlong(128, 16#7FF, 3), - ?line overlong(16#800, 16#FFFF, 4), + overlong(0, 127, 2), + overlong(128, 16#7FF, 3), + overlong(16#800, 16#FFFF, 4), ok. fail_range(Char, End) when Char =< End -> @@ -186,9 +162,9 @@ short_sequences(Char, End) -> short_sequences_1(Char, Step, End) when Char =< End -> CharEnd = lists:min([Char+Step-1,End]), [spawn_monitor(fun() -> - io:format("~p - ~p\n", [Char,CharEnd]), - do_short_sequences(Char, CharEnd) - end)|short_sequences_1(Char+Step, Step, End)]; + io:format("~p - ~p\n", [Char,CharEnd]), + do_short_sequences(Char, CharEnd) + end)|short_sequences_1(Char+Step, Step, End)]; short_sequences_1(_, _, _) -> []. do_short_sequences(Char, End) when Char =< End -> @@ -227,9 +203,9 @@ overlong(_, _, _) -> ok. overlong(Char, NumBytes) when NumBytes < 5 -> case int_to_utf8(Char, NumBytes) of <<Char/utf8>>=Bin -> - ?t:fail({illegal_encoding_accepted,Bin,Char}); + ct:fail({illegal_encoding_accepted,Bin,Char}); <<OtherChar/utf8>>=Bin -> - ?t:fail({illegal_encoding_accepted,Bin,Char,OtherChar}); + ct:fail({illegal_encoding_accepted,Bin,Char,OtherChar}); _ -> ok end, overlong(Char, NumBytes+1); @@ -240,16 +216,16 @@ fail(Bin) -> fail_1(make_unaligned(Bin)). fail_1(<<Char/utf8>>=Bin) -> - ?t:fail({illegal_encoding_accepted,Bin,Char}); + ct:fail({illegal_encoding_accepted,Bin,Char}); fail_1(_) -> ok. utf16_illegal_sequences(Config) when is_list(Config) -> - ?line utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. - ?line utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. + utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. + utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line lonely_hi_surrogate(16#D800, 16#DFFF), - ?line leading_lo_surrogate(16#DC00, 16#DFFF), + lonely_hi_surrogate(16#D800, 16#DFFF), + leading_lo_surrogate(16#DC00, 16#DFFF), ok. @@ -264,9 +240,9 @@ lonely_hi_surrogate(Char, End) when Char =< End -> BinLittle = <<Char:16/little>>, case {BinBig,BinLittle} of {<<Bad/big-utf16>>,_} -> - ?t:fail({lonely_hi_surrogate_accepted,Bad}); + ct:fail({lonely_hi_surrogate_accepted,Bad}); {_,<<Bad/little-utf16>>} -> - ?t:fail({lonely_hi_surrogate_accepted,Bad}); + ct:fail({lonely_hi_surrogate_accepted,Bad}); {_,_} -> ok end, @@ -283,9 +259,9 @@ leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End -> BinLittle = <<HiSurr:16/little,LoSurr:16/little>>, case {BinBig,BinLittle} of {<<Bad/big-utf16,_/bits>>,_} -> - ?t:fail({leading_lo_surrogate_accepted,Bad}); + ct:fail({leading_lo_surrogate_accepted,Bad}); {_,<<Bad/little-utf16,_/bits>>} -> - ?t:fail({leading_lo_surrogate_accepted,Bad}); + ct:fail({leading_lo_surrogate_accepted,Bad}); {_,_} -> ok end, @@ -293,20 +269,20 @@ leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End -> leading_lo_surrogate(_, _, _) -> ok. utf32_illegal_sequences(Config) when is_list(Config) -> - ?line utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. - ?line utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf32_fail_range(-100, -1), + utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. + utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. + utf32_fail_range(-100, -1), ok. utf32_fail_range(Char, End) when Char =< End -> {'EXIT',_} = (catch <<Char/big-utf32>>), {'EXIT',_} = (catch <<Char/little-utf32>>), case {<<Char:32>>,<<Char:32/little>>} of - {<<Unexpected/utf32>>,_} -> - ?line ?t:fail(Unexpected); - {_,<<Unexpected/little-utf32>>} -> - ?line ?t:fail(Unexpected); - {_,_} -> ok + {<<Unexpected/utf32>>,_} -> + ct:fail(Unexpected); + {_,<<Unexpected/little-utf32>>} -> + ct:fail(Unexpected); + {_,_} -> ok end, utf32_fail_range(Char+1, End); utf32_fail_range(_, _) -> ok. @@ -386,14 +362,14 @@ fail_check({'EXIT',{badarg,_}}, Str, Vars) -> try evaluate(Str, Vars) of Res -> io:format("Interpreted result: ~p", [Res]), - ?t:fail(did_not_fail_in_intepreted_code) + ct:fail(did_not_fail_in_intepreted_code) catch error:badarg -> ok end; fail_check(Res, _, _) -> io:format("Compiled result: ~p", [Res]), - ?t:fail(did_not_fail_in_compiled_code). + ct:fail(did_not_fail_in_compiled_code). evaluate(Str, Vars) -> {ok,Tokens,_} = @@ -405,4 +381,3 @@ evaluate(Str, Vars) -> end. id(I) -> I. - diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl index 4b4af0babe..4e7004a424 100644 --- a/erts/emulator/test/busy_port_SUITE.erl +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -1,39 +1,42 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(busy_port_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,end_per_testcase/2, +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2, io_to_busy/1, message_order/1, send_3/1, system_monitor/1, no_trap_exit/1, no_trap_exit_unlinked/1, trap_exit/1, multiple_writers/1, - hard_busy_driver/1, soft_busy_driver/1]). - --compile(export_all). + hard_busy_driver/1, soft_busy_driver/1, + scheduling_delay_busy/1, + scheduling_delay_busy_nosuspend/1, + scheduling_busy_link/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Internal exports. --export([init/2]). +-export([init/2,process_init/2,ack/2,call/2,cast/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [io_to_busy, message_order, send_3, system_monitor, @@ -42,19 +45,9 @@ all() -> scheduling_delay_busy,scheduling_delay_busy_nosuspend, scheduling_busy_link]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> +init_per_testcase(_Case, Config) when is_list(Config) -> + Killer = spawn(fun() -> killer_loop([]) end), + register(killer_process, Killer), Config. end_per_testcase(_Case, Config) when is_list(Config) -> @@ -70,22 +63,49 @@ end_per_testcase(_Case, Config) when is_list(Config) -> ok end end, + kill_processes(), Config. +kill_processes() -> + killer_process ! {get_pids,self()}, + receive + {pids_to_kill,Pids} -> ok + end, + _ = [begin + case erlang:is_process_alive(P) of + true -> + io:format("Killing ~p\n", [P]); + false -> + ok + end, + unlink(P), + exit(P, kill) + end || P <- Pids], + ok. + +killer_loop(Pids) -> + receive + {add_pid,Pid} -> + killer_loop([Pid|Pids]); + {get_pids,To} -> + To ! {pids_to_kill,Pids} + end. + +kill_me(Pid) -> + killer_process ! {add_pid,Pid}, + Pid. + %% Tests I/O operations to a busy port, to make sure a suspended send %% operation is correctly restarted. This used to crash Beam. -io_to_busy(suite) -> []; io_to_busy(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(30)), + ct:timetrap({seconds, 30}), - ?line start_busy_driver(Config), - ?line process_flag(trap_exit, true), - ?line Writer = fun_spawn(fun writer/0), - ?line Generator = fun_spawn(fun() -> generator(100, Writer) end), - ?line wait_for([Writer, Generator]), - - ?line test_server:timetrap_cancel(Dog), + start_busy_driver(Config), + process_flag(trap_exit, true), + Writer = fun_spawn(fun writer/0), + Generator = fun_spawn(fun() -> generator(100, Writer) end), + wait_for([Writer, Generator]), ok. generator(N, Writer) -> @@ -98,8 +118,10 @@ generator(0, Writer, _Data) -> %% Calling process_info(Pid, current_function) on a suspended process %% used to crash Beam. - {current_function, {erlang, send, 2}} = - process_info(Writer, current_function), + case process_info(Writer, [status,current_function]) of + [{status,suspended},{current_function,{erlang,send,2}}] -> ok; + [{status,suspended},{current_function,{erlang,bif_return_trap,_}}] -> ok + end, unlock_slave(); generator(N, Writer, Data) -> Writer ! {exec, Data}, @@ -127,31 +149,28 @@ forget(_) -> %% Test the interaction of busy ports and message sending. %% This used to cause the wrong message to be received. -message_order(suite) -> {req, dynamic_loading}; message_order(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - - ?line start_busy_driver(Config), - ?line Self = self(), - ?line Busy = fun_spawn(fun () -> send_to_busy_1(Self) end), - ?line receive after 1000 -> ok end, - ?line Busy ! first, - ?line Busy ! second, - ?line receive after 1 -> ok end, - ?line unlock_slave(), - ?line Busy ! third, - ?line receive - {Busy, first} -> - ok; - Other -> - test_server:fail({unexpected_message, Other}) - end, - - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({seconds, 10}), + + start_busy_driver(Config), + Self = self(), + Busy = fun_spawn(fun () -> send_to_busy_1(Self) end), + receive after 1000 -> ok end, + Busy ! first, + Busy ! second, + receive after 1 -> ok end, + unlock_slave(), + Busy ! third, + receive + {Busy, first} -> + ok; + Other -> + ct:fail({unexpected_message, Other}) + end, ok. send_to_busy_1(Parent) -> - {Owner, Slave} = get_slave(), + {_Owner, Slave} = get_slave(), (catch port_command(Slave, "set_me_busy")), (catch port_command(Slave, "hello")), (catch port_command(Slave, "hello again")), @@ -161,80 +180,64 @@ send_to_busy_1(Parent) -> end. %% Test the bif send/3 -send_3(suite) -> {req,dynamic_loading}; -send_3(doc) -> ["Test the BIF send/3"]; send_3(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), + ct:timetrap({seconds, 10}), %% - ?line start_busy_driver(Config), - ?line {Owner,Slave} = get_slave(), - ?line ok = erlang:send(Slave, {Owner,{command,"set busy"}}, - [nosuspend]), + start_busy_driver(Config), + {Owner,Slave} = get_slave(), + ok = erlang:send(Slave, {Owner,{command,"set busy"}}, [nosuspend]), receive after 100 -> ok end, % ensure command reached port - ?line nosuspend = erlang:send(Slave, {Owner,{command,"busy"}}, - [nosuspend]), - ?line unlock_slave(), - ?line ok = erlang:send(Slave, {Owner,{command,"not busy"}}, - [nosuspend]), - ?line ok = command(stop), - %% - ?line test_server:timetrap_cancel(Dog), + nosuspend = erlang:send(Slave, {Owner,{command,"busy"}}, [nosuspend]), + unlock_slave(), + ok = erlang:send(Slave, {Owner,{command,"not busy"}}, [nosuspend]), + ok = command(stop), ok. %% Test the erlang:system_monitor(Pid, [busy_port]) -system_monitor(suite) -> {req,dynamic_loading}; -system_monitor(doc) -> ["Test erlang:system_monitor({Pid,[busy_port]})."]; system_monitor(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Self = self(), - %% - ?line OldMonitor = erlang:system_monitor(Self, [busy_port]), - ?line {Self,[busy_port]} = erlang:system_monitor(), - ?line Void = make_ref(), - ?line start_busy_driver(Config), - ?line {Owner,Slave} = get_slave(), - ?line Master = command(get_master), - ?line Parent = self(), - ?line Busy = - spawn_link( - fun() -> - (catch port_command(Slave, "set busy")), - receive {Parent,alpha} -> ok end, - (catch port_command(Slave, "busy")), - (catch port_command(Slave, "free")), - Parent ! {self(),alpha}, - command(lock), - receive {Parent,beta} -> ok end, - command({port_command,"busy"}), - command({port_command,"free"}), - Parent ! {self(),beta} - end), - ?line Void = rec(Void), - ?line Busy ! {self(),alpha}, - ?line {monitor,Busy,busy_port,Slave} = rec(Void), - ?line unlock_slave(), - ?line {Busy,alpha} = rec(Void), - ?line Void = rec(Void), - ?line Busy ! {self(), beta}, - ?line {monitor,Owner,busy_port,Slave} = rec(Void), - ?line port_command(Master, "u"), - ?line {Busy,beta} = rec(Void), - ?line Void = rec(Void), - ?line _NewMonitor = erlang:system_monitor(OldMonitor), - ?line OldMonitor = erlang:system_monitor(), - ?line OldMonitor = erlang:system_monitor(OldMonitor), + ct:timetrap({seconds, 10}), + Self = self(), %% - ?line test_server:timetrap_cancel(Dog), + OldMonitor = erlang:system_monitor(Self, [busy_port]), + {Self,[busy_port]} = erlang:system_monitor(), + Void = make_ref(), + start_busy_driver(Config), + {Owner,Slave} = get_slave(), + Master = command(get_master), + Parent = self(), + Busy = spawn_link( + fun() -> + (catch port_command(Slave, "set busy")), + receive {Parent,alpha} -> ok end, + (catch port_command(Slave, "busy")), + (catch port_command(Slave, "free")), + Parent ! {self(),alpha}, + command(lock), + receive {Parent,beta} -> ok end, + command({port_command,"busy"}), + command({port_command,"free"}), + Parent ! {self(),beta} + end), + Void = rec(Void), + Busy ! {self(),alpha}, + {monitor,Busy,busy_port,Slave} = rec(Void), + unlock_slave(), + {Busy,alpha} = rec(Void), + Void = rec(Void), + Busy ! {self(), beta}, + {monitor,Owner,busy_port,Slave} = rec(Void), + port_command(Master, "u"), + {Busy,beta} = rec(Void), + Void = rec(Void), + _NewMonitor = erlang:system_monitor(OldMonitor), + OldMonitor = erlang:system_monitor(), + OldMonitor = erlang:system_monitor(OldMonitor), ok. - - rec(Tag) -> receive X -> X after 1000 -> Tag end. - - %% Assuming the following scenario, %% %% +---------------+ +-----------+ @@ -245,65 +248,59 @@ rec(Tag) -> %% %% tests that the suspended process is killed if the port is killed. -no_trap_exit(suite) -> []; no_trap_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line process_flag(trap_exit, true), - ?line Pid = fun_spawn(fun no_trap_exit_process/3, - [self(), linked, Config]), - ?line receive - {Pid, port_created, Port} -> - io:format("Process ~w created port ~w", [Pid, Port]), - ?line exit(Port, die); - Other1 -> - test_server:fail({unexpected_message, Other1}) - end, - ?line receive - {'EXIT', Pid, die} -> - ok; - Other2 -> - test_server:fail({unexpected_message, Other2}) - end, - - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({seconds, 10}), + process_flag(trap_exit, true), + Pid = fun_spawn(fun no_trap_exit_process/3, [self(), linked, Config]), + receive + {Pid, port_created, Port} -> + io:format("Process ~w created port ~w", [Pid, Port]), + exit(Port, die); + Other1 -> + ct:fail({unexpected_message, Other1}) + end, + receive + {'EXIT', Pid, die} -> + ok; + Other2 -> + ct:fail({unexpected_message, Other2}) + end, ok. %% The same scenario as above, but the port has been explicitly %% unlinked from the process. -no_trap_exit_unlinked(suite) -> []; no_trap_exit_unlinked(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line process_flag(trap_exit, true), - ?line Pid = fun_spawn(fun no_trap_exit_process/3, - [self(), unlink, Config]), - ?line receive - {Pid, port_created, Port} -> - io:format("Process ~w created port ~w", [Pid, Port]), - ?line exit(Port, die); - Other1 -> - test_server:fail({unexpected_message, Other1}) - end, - ?line receive - {'EXIT', Pid, normal} -> - ok; - Other2 -> - test_server:fail({unexpected_message, Other2}) - end, - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({seconds, 10}), + process_flag(trap_exit, true), + Pid = fun_spawn(fun no_trap_exit_process/3, + [self(), unlink, Config]), + receive + {Pid, port_created, Port} -> + io:format("Process ~w created port ~w", [Pid, Port]), + exit(Port, die); + Other1 -> + ct:fail({unexpected_message, Other1}) + end, + receive + {'EXIT', Pid, normal} -> + ok; + Other2 -> + ct:fail({unexpected_message, Other2}) + end, ok. no_trap_exit_process(ResultTo, Link, Config) -> - ?line load_busy_driver(Config), - ?line _Master = open_port({spawn, "busy_drv master"}, [eof]), - ?line Slave = open_port({spawn, "busy_drv slave"}, [eof]), - ?line case Link of - linked -> ok; - unlink -> unlink(Slave) - end, - ?line (catch port_command(Slave, "lock port")), - ?line ResultTo ! {self(), port_created, Slave}, - ?line (catch port_command(Slave, "suspend me")), + load_busy_driver(Config), + _Master = open_port({spawn, "busy_drv master"}, [eof]), + Slave = open_port({spawn, "busy_drv slave"}, [eof]), + case Link of + linked -> ok; + unlink -> unlink(Slave) + end, + (catch port_command(Slave, "lock port")), + ResultTo ! {self(), port_created, Slave}, + (catch port_command(Slave, "suspend me")), ok. %% Assuming the following scenario, @@ -317,36 +314,34 @@ no_trap_exit_process(ResultTo, Link, Config) -> %% tests that the suspended process is scheduled runnable and %% receives an 'EXIT' message if the port is killed. -trap_exit(suite) -> []; trap_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Pid = fun_spawn(fun busy_port_exit_process/2, [self(), Config]), - ?line receive + ct:timetrap({seconds, 10}), + Pid = fun_spawn(fun busy_port_exit_process/2, [self(), Config]), + receive {Pid, port_created, Port} -> io:format("Process ~w created port ~w", [Pid, Port]), - ?line unlink(Pid), - ?line {status, suspended} = process_info(Pid, status), - ?line exit(Port, die); + unlink(Pid), + {status, suspended} = process_info(Pid, status), + exit(Port, die); Other1 -> - test_server:fail({unexpected_message, Other1}) + ct:fail({unexpected_message, Other1}) end, - ?line receive + receive {Pid, ok} -> ok; Other2 -> - test_server:fail({unexpected_message, Other2}) + ct:fail({unexpected_message, Other2}) end, - ?line test_server:timetrap_cancel(Dog), ok. busy_port_exit_process(ResultTo, Config) -> - ?line process_flag(trap_exit, true), - ?line load_busy_driver(Config), - ?line _Master = open_port({spawn, "busy_drv master"}, [eof]), - ?line Slave = open_port({spawn, "busy_drv slave"}, [eof]), - ?line (catch port_command(Slave, "lock port")), - ?line ResultTo ! {self(), port_created, Slave}, - ?line (catch port_command(Slave, "suspend me")), + process_flag(trap_exit, true), + load_busy_driver(Config), + _Master = open_port({spawn, "busy_drv master"}, [eof]), + Slave = open_port({spawn, "busy_drv slave"}, [eof]), + (catch port_command(Slave, "lock port")), + ResultTo ! {self(), port_created, Slave}, + (catch port_command(Slave, "suspend me")), receive {'EXIT', Slave, die} -> ResultTo ! {self(), ok}; @@ -359,19 +354,18 @@ busy_port_exit_process(ResultTo, Config) -> %% This should work even if some of the processes have terminated %% in the meantime. -multiple_writers(suite) -> []; multiple_writers(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line start_busy_driver(Config), - ?line process_flag(trap_exit, true), + ct:timetrap({seconds, 10}), + start_busy_driver(Config), + process_flag(trap_exit, true), %% Start the waiters and make sure they have blocked. - ?line W1 = fun_spawn(fun quick_writer/0), - ?line W2 = fun_spawn(fun quick_writer/0), - ?line W3 = fun_spawn(fun quick_writer/0), - ?line W4 = fun_spawn(fun quick_writer/0), - ?line W5 = fun_spawn(fun quick_writer/0), - ?line test_server:sleep(500), % Make sure writers have blocked. + W1 = fun_spawn(fun quick_writer/0), + W2 = fun_spawn(fun quick_writer/0), + W3 = fun_spawn(fun quick_writer/0), + W4 = fun_spawn(fun quick_writer/0), + W5 = fun_spawn(fun quick_writer/0), + test_server:sleep(500), % Make sure writers have blocked. %% Kill two of the processes. exit(W1, kill), @@ -380,14 +374,12 @@ multiple_writers(Config) when is_list(Config) -> receive {'EXIT', W3, killed} -> ok end, %% Unlock the port. The surviving processes should be become runnable. - ?line unlock_slave(), - ?line wait_for([W2, W4, W5]), - - ?line test_server:timetrap_cancel(Dog), + unlock_slave(), + wait_for([W2, W4, W5]), ok. quick_writer() -> - {Owner, Port} = get_slave(), + {_Owner, Port} = get_slave(), (catch port_command(Port, "port to busy")), (catch port_command(Port, "lock me")), ok. @@ -399,205 +391,193 @@ soft_busy_driver(Config) when is_list(Config) -> hs_test(Config, false). hs_test(Config, HardBusy) when is_list(Config) -> - ?line DrvName = case HardBusy of - true -> 'hard_busy_drv'; - false -> 'soft_busy_drv' - end, - ?line erl_ddll:start(), - ?line Path = ?config(data_dir, Config), + DrvName = case HardBusy of + true -> 'hard_busy_drv'; + false -> 'soft_busy_drv' + end, + erl_ddll:start(), + Path = proplists:get_value(data_dir, Config), case erl_ddll:load_driver(Path, DrvName) of - ok -> ok; - {error, Error} -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - ?line ?t:fail() + ok -> ok; + {error, Error} -> + ct:fail(erl_ddll:format_error(Error)) end, - ?line Port = open_port({spawn, DrvName}, []), - + Port = open_port({spawn, DrvName}, []), + NotSuspended = fun (Proc) -> - chk_not_value({status,suspended}, - process_info(Proc, status)) - end, + chk_not_value({status,suspended}, + process_info(Proc, status)) + end, NotBusyEnd = fun (Proc, Res, Time) -> - receive - {Port, caller, Proc} -> ok - after - 500 -> exit(missing_caller_message) - end, - chk_value({return, true}, Res), - chk_range(0, Time, 100) - end, + receive + {Port, caller, Proc} -> ok + after + 500 -> exit(missing_caller_message) + end, + chk_value({return, true}, Res), + chk_range(0, Time, 100) + end, ForceEnd = fun (Proc, Res, Time) -> - case HardBusy of - false -> - NotBusyEnd(Proc, Res, Time); - true -> - chk_value({error, notsup}, Res), - chk_range(0, Time, 100), - receive - Msg -> exit({unexpected_msg, Msg}) - after - 500 -> ok - end - end - end, + case HardBusy of + false -> + NotBusyEnd(Proc, Res, Time); + true -> + chk_value({error, notsup}, Res), + chk_range(0, Time, 100), + receive + Msg -> exit({unexpected_msg, Msg}) + after + 500 -> ok + end + end + end, BadArg = fun (_Proc, Res, Time) -> - chk_value({error, badarg}, Res), - chk_range(0, Time, 100) - end, + chk_value({error, badarg}, Res), + chk_range(0, Time, 100) + end, %% Not busy %% Not busy; nosuspend option - ?line hs_busy_pcmd(Port, [nosuspend], NotSuspended, NotBusyEnd), + hs_busy_pcmd(Port, [nosuspend], NotSuspended, NotBusyEnd), %% Not busy; force option - ?line hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd), + hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd), %% Not busy; force and nosuspend option - ?line hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd), + hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd), %% Not busy; no option - ?line hs_busy_pcmd(Port, [], NotSuspended, NotBusyEnd), + hs_busy_pcmd(Port, [], NotSuspended, NotBusyEnd), %% Not busy; bad option - ?line hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg), + hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg), %% Make busy - ?line erlang:port_control(Port, $B, []), + erlang:port_control(Port, $B, []), %% Busy; nosuspend option - ?line hs_busy_pcmd(Port, [nosuspend], NotSuspended, - fun (_Proc, Res, Time) -> - chk_value({return, false}, Res), - chk_range(0, Time, 100), - receive - Msg -> exit({unexpected_msg, Msg}) - after - 500 -> ok - end - end), + hs_busy_pcmd(Port, [nosuspend], NotSuspended, + fun (_Proc, Res, Time) -> + chk_value({return, false}, Res), + chk_range(0, Time, 100), + receive + Msg -> exit({unexpected_msg, Msg}) + after + 500 -> ok + end + end), %% Busy; force option - ?line hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd), + hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd), %% Busy; force and nosuspend option - ?line hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd), + hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd), %% Busy; bad option - ?line hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg), + hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg), %% no option on busy port - ?line hs_busy_pcmd(Port, [], - fun (Proc) -> - receive after 1000 -> ok end, - chk_value({status,suspended}, - process_info(Proc, status)), - - %% Make not busy - erlang:port_control(Port, $N, []) - end, - fun (_Proc, Res, Time) -> - chk_value({return, true}, Res), - chk_range(1000, Time, 2000) - end), - - ?line true = erlang:port_close(Port), - ?line ok = erl_ddll:unload_driver(DrvName), - ?line ok = erl_ddll:stop(), - ?line ok. + hs_busy_pcmd(Port, [], + fun (Proc) -> + receive after 1000 -> ok end, + chk_value({status,suspended}, + process_info(Proc, status)), + + %% Make not busy + erlang:port_control(Port, $N, []) + end, + fun (_Proc, Res, Time) -> + chk_value({return, true}, Res), + chk_range(1000, Time, 2000) + end), + + true = erlang:port_close(Port), + ok = erl_ddll:unload_driver(DrvName), + ok = erl_ddll:stop(), + ok. hs_busy_pcmd(Prt, Opts, StartFun, EndFun) -> Tester = self(), P = spawn_link(fun () -> - erlang:yield(), - Tester ! {self(), doing_port_command}, - Start = now(), - Res = try {return, - port_command(Prt, [], Opts)} - catch Exception:Error -> {Exception, Error} - end, - End = now(), - Time = round(timer:now_diff(End, Start)/1000), - Tester ! {self(), port_command_result, Res, Time} - end), + erlang:yield(), + Tester ! {self(), doing_port_command}, + Start = erlang:monotonic_time(microsecond), + Res = try {return, + port_command(Prt, [], Opts)} + catch Exception:Error -> {Exception, Error} + end, + End = erlang:monotonic_time(microsecond), + Time = round((End - Start)/1000), + Tester ! {self(), port_command_result, Res, Time} + end), receive - {P, doing_port_command} -> - ok + {P, doing_port_command} -> + ok end, StartFun(P), receive - {P, port_command_result, Res, Time} -> - EndFun(P, Res, Time) + {P, port_command_result, Res, Time} -> + EndFun(P, Res, Time) end. scheduling_delay_busy(Config) -> - - Scenario = - [{1,{spawn,[{var,drvname},undefined]}}, - {2,{call,[{var,1},open_port]}}, - {3,{spawn,[{var,2},{var,1}]}}, - {0,{ack,[{var,1},{busy,1,250}]}}, - {0,{cast,[{var,3},{command,2}]}}, - [{0,{cast,[{var,3},{command,I}]}} - || I <- lists:seq(3,50)], - {0,{cast,[{var,3},take_control]}}, - {0,{cast,[{var,1},{new_owner,{var,3}}]}}, - {0,{cast,[{var,3},close]}}, - {0,{timer,sleep,[300]}}, - {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}}, - [{0,{cast,[{var,1},{command,I}]}} - || I <- lists:seq(101,127)] - ,{10,{call,[{var,3},get_data]}} - ], + Scenario = [{1,{spawn,[{var,drvname},undefined]}}, + {2,{call,[{var,1},open_port]}}, + {3,{spawn,[{var,2},{var,1}]}}, + {0,{ack,[{var,1},{busy,1,250}]}}, + {0,{cast,[{var,3},{command,2}]}}, + [{0,{cast,[{var,3},{command,I}]}} || I <- lists:seq(3,50)], + {0,{cast,[{var,3},take_control]}}, + {0,{cast,[{var,1},{new_owner,{var,3}}]}}, + {0,{cast,[{var,3},close]}}, + {0,{timer,sleep,[300]}}, + {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}}, + [{0,{cast,[{var,1},{command,I}]}} || I <- lists:seq(101,127)], + {10,{call,[{var,3},get_data]}}], Validation = [{seq,10,lists:seq(1,50)}], - port_scheduling(Scenario,Validation,?config(data_dir,Config)). + port_scheduling(Scenario,Validation,proplists:get_value(data_dir,Config)). scheduling_delay_busy_nosuspend(Config) -> - - Scenario = - [{1,{spawn,[{var,drvname},undefined]}}, - {2,{call,[{var,1},open_port]}}, - {0,{cast,[{var,1},{command,1,100}]}}, - {0,{cast,[{var,1},{busy,2}]}}, - {0,{timer,sleep,[200]}}, % ensure reached port - {10,{call,[{var,1},{command,3,[nosuspend]}]}}, - {0,{timer,sleep,[200]}}, - {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}}, - {0,{cast,[{var,1},close]}}, - {20,{call,[{var,1},get_data]}} - ], + Scenario = [{1,{spawn,[{var,drvname},undefined]}}, + {2,{call,[{var,1},open_port]}}, + {0,{cast,[{var,1},{command,1,100}]}}, + {0,{cast,[{var,1},{busy,2}]}}, + {0,{timer,sleep,[200]}}, % ensure reached port + {10,{call,[{var,1},{command,3,[nosuspend]}]}}, + {0,{timer,sleep,[200]}}, + {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}}, + {0,{cast,[{var,1},close]}}, + {20,{call,[{var,1},get_data]}}], Validation = [{eq,10,nosuspend},{seq,20,[1,2]}], - port_scheduling(Scenario,Validation,?config(data_dir,Config)). + port_scheduling(Scenario,Validation,proplists:get_value(data_dir,Config)). scheduling_busy_link(Config) -> - - Scenario = - [{1,{spawn,[{var,drvname},undefined]}}, - {2,{call,[{var,1},open_port]}}, - {3,{spawn,[{var,2},{var,1}]}}, - {0,{cast,[{var,1},unlink]}}, - {0,{cast,[{var,1},{busy,1}]}}, - {0,{cast,[{var,1},{command,2}]}}, - {0,{cast,[{var,1},link]}}, - {0,{timer,sleep,[1000]}}, - {0,{ack,[{var,3},take_control]}}, - {0,{cast,[{var,1},{new_owner,{var,3}}]}}, - {0,{cast,[{var,3},close]}}, - {10,{call,[{var,3},get_data]}}, - {20,{call,[{var,1},get_exit]}} - ], + Scenario = [{1,{spawn,[{var,drvname},undefined]}}, + {2,{call,[{var,1},open_port]}}, + {3,{spawn,[{var,2},{var,1}]}}, + {0,{cast,[{var,1},unlink]}}, + {0,{cast,[{var,1},{busy,1}]}}, + {0,{cast,[{var,1},{command,2}]}}, + {0,{cast,[{var,1},link]}}, + {0,{timer,sleep,[1000]}}, + {0,{ack,[{var,3},take_control]}}, + {0,{cast,[{var,1},{new_owner,{var,3}}]}}, + {0,{cast,[{var,3},close]}}, + {10,{call,[{var,3},get_data]}}, + {20,{call,[{var,1},get_exit]}}], Validation = [{seq,10,[1]}, {seq,20,[{'EXIT',noproc}]}], - port_scheduling(Scenario,Validation,?config(data_dir,Config)). + port_scheduling(Scenario,Validation,proplists:get_value(data_dir,Config)). process_init(DrvName,Owner) -> process_flag(trap_exit,true), @@ -696,11 +676,11 @@ handle_msg(close,Port,Owner,_Data) -> handle_msg(get_data,Port,_Owner,{[],_Exit}) -> %% Wait for data if it has not arrived yet receive - {Port,{data,Data}} -> - Data + {Port,{data,Data}} -> + Data after 2000 -> - pal("~p",[erlang:process_info(self())]), - exit(did_not_get_port_data) + pal("~p",[erlang:process_info(self())]), + exit(did_not_get_port_data) end; handle_msg(get_data,_Port,Owner,{Data,Exit}) -> pal("GetData",[]), @@ -750,8 +730,7 @@ port_scheduling(Scenario,Validation,Path) -> case erl_ddll:load_driver(Path, DrvName) of ok -> ok; {error, Error} -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - ?line ?t:fail() + ct:fail(erl_ddll:format_error(Error)) end, Data = run_scenario(lists:flatten(Scenario),[{drvname,DrvName}]), @@ -769,12 +748,13 @@ run_scenario([],Vars) -> run_command(_M,spawn,{Args,Opts}) -> Pid = spawn_opt(fun() -> apply(?MODULE,process_init,Args) end,[link|Opts]), + kill_me(Pid), pal("spawn(~p): ~p",[Args,Pid]), Pid; run_command(M,spawn,Args) -> run_command(M,spawn,{Args,[]}); run_command(Mod,Func,Args) -> - erlang:display({{Mod,Func,Args},now()}), + erlang:display({{Mod,Func,Args}, erlang:system_time(microsecond)}), apply(Mod,Func,Args). validate_scenario(Data,[{print,Var}|T]) -> @@ -857,14 +837,16 @@ wait_for(Pids) -> {'EXIT', Pid, normal} -> wait_for(lists:delete(Pid, Pids)); Other -> - test_server:fail({bad_exit, Other}) + ct:fail({bad_exit, Other}) end. fun_spawn(Fun) -> fun_spawn(Fun, []). fun_spawn(Fun, Args) -> - spawn_link(erlang, apply, [Fun, Args]). + Pid = spawn_link(erlang, apply, [Fun, Args]), + kill_me(Pid), + Pid. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% These routines provide a port which will become busy when the @@ -893,39 +875,38 @@ fun_spawn(Fun, Args) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% load_busy_driver(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line erl_ddll:start(), + DataDir = proplists:get_value(data_dir, Config), + erl_ddll:start(), case erl_ddll:load_driver(DataDir, "busy_drv") of ok -> ok; {error, Error} -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - ?line ?t:fail() + ct:fail(erl_ddll:format_error(Error)) end. %%% Interface functions. start_busy_driver(Config) when is_list(Config) -> - ?line Pid = spawn_link(?MODULE, init, [Config, self()]), - ?line receive + Pid = spawn_link(?MODULE, init, [Config, self()]), + receive {Pid, started} -> ok; Other -> - test_server:fail({unexpected_message, Other}) + ct:fail({unexpected_message, Other}) end. unlock_slave() -> command(unlock). get_slave() -> - ?line command(get_slave). + command(get_slave). %% Internal functions. command(Msg) -> - ?line whereis(busy_drv_server) ! {self(), Msg}, - ?line receive - {busy_drv_reply, Reply} -> - Reply + whereis(busy_drv_server) ! {self(), Msg}, + receive + {busy_drv_reply, Reply} -> + Reply end. %%% Server. diff --git a/erts/emulator/test/busy_port_SUITE_data/Makefile.src b/erts/emulator/test/busy_port_SUITE_data/Makefile.src index f7937bc8d3..ae6378a6ff 100644 --- a/erts/emulator/test/busy_port_SUITE_data/Makefile.src +++ b/erts/emulator/test/busy_port_SUITE_data/Makefile.src @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2013. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. 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. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # diff --git a/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c index 52c41f8ca5..c4e0f13f06 100644 --- a/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c +++ b/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. 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. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ diff --git a/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c index 7807b47e3d..ffaca18e90 100644 --- a/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c +++ b/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. 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. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ diff --git a/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c b/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c index 2008b33a72..296b3f21de 100644 --- a/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c +++ b/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. 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. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ diff --git a/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c index 30bcd86d1d..8a98f050f1 100644 --- a/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c +++ b/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. 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. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index ef1f2aa04c..1251d644ae 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% @@ -20,66 +21,46 @@ -module(call_trace_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - hipe/1,process_specs/1,basic/1,flags/1,errors/1,pam/1,change_pam/1, - return_trace/1,exception_trace/1,on_load/1,deep_exception/1, - upgrade/1, - exception_nocatch/1,bit_syntax/1]). +-export([all/0, suite/0, + init_per_testcase/2,end_per_testcase/2, + hipe/1,process_specs/1,basic/1,flags/1,errors/1,pam/1,change_pam/1, + return_trace/1,exception_trace/1,on_load/1,deep_exception/1, + upgrade/1, + exception_nocatch/1,bit_syntax/1]). %% Helper functions. -export([bar/0,foo/0,foo/1,foo/2,expect/1,worker_foo/1,pam_foo/2,nasty/0, - id/1,deep/3,deep_1/3,deep_2/2,deep_3/2,deep_4/1,deep_5/1, - bs_sum_a/2,bs_sum_b/2]). + id/1,deep/3,deep_1/3,deep_2/2,deep_3/2,deep_4/1,deep_5/1, + bs_sum_a/2,bs_sum_b/2]). %% Debug -export([abbr/1,abbr/2]). - --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(P, 20). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. -all() -> +all() -> Common = [errors, on_load], NotHipe = [process_specs, basic, flags, pam, change_pam, - upgrade, - return_trace, exception_trace, deep_exception, - exception_nocatch, bit_syntax], + upgrade, + return_trace, exception_trace, deep_exception, + exception_nocatch, bit_syntax], Hipe = [hipe], case test_server:is_native(call_trace_SUITE) of - true -> Hipe ++ Common; - false -> NotHipe ++ Common + true -> Hipe ++ Common; + false -> NotHipe ++ Common end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:seconds(30)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), + Config. +end_per_testcase(_Func, _Config) -> %% Reloading the module will clear all trace patterns, and %% in a debug-compiled emulator run assertions of the counters %% for the number of traced exported functions in this module. @@ -87,51 +68,63 @@ end_per_testcase(_Func, Config) -> c:l(?MODULE). hipe(Config) when is_list(Config) -> - ?line 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true), - ?line 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true, [local]), - ?line AllFuncs = erlang:trace_pattern({'_','_','_'}, true), + 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true), + 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true, [local]), + AllFuncs = erlang:trace_pattern({'_','_','_'}, true), %% Make sure that a traced, exported function can still be found. - ?line true = erlang:function_exported(error_handler, undefined_function, 3), - ?line AllFuncs = erlang:trace_pattern({'_','_','_'}, false), + true = erlang:function_exported(error_handler, undefined_function, 3), + AllFuncs = erlang:trace_pattern({'_','_','_'}, false), ok. -process_specs(doc) -> - "Tests 'all', 'new', and 'existing' for specifying processes."; -process_specs(suite) -> []; +%% Tests 'all', 'new', and 'existing' for specifying processes. process_specs(Config) when is_list(Config) -> - ?line Tracer = start_tracer(), - ?line {flags,[call]} = trace_info(self(), flags), - ?line {tracer,Tracer} = trace_info(self(), tracer), - ?line trace_func({?MODULE,worker_foo,1}, []), - - %% Test the 'new' flag. - - ?line {Work1A,Work1B} = start_and_trace(new, [1,2,3], A1B={3,2,1}), - {flags,[]} = trace_info(Work1A, flags), - {tracer,[]} = trace_info(Work1A, tracer), - {tracer,Tracer} = trace_info(Work1B, tracer), - {flags,[call]} = trace_info(Work1B, flags), - ?line expect({trace,Work1B,call,{?MODULE,worker_foo,[A1B]}}), - ?line unlink(Work1B), - ?line Mref = erlang:monitor(process, Work1B), - ?line exit(Work1B, kill), - receive - {'DOWN',Mref,_,_,_} -> ok - end, - ?line undefined = trace_info(Work1B, flags), - ?line {flags,[]} = trace_info(new, flags), - ?line {tracer,[]} = trace_info(new, tracer), - - %% Test the 'existing' flag. - ?line {Work2A,_Work2B} = start_and_trace(existing, A2A=[5,6,7], [7,6,5]), - ?line expect({trace,Work2A,call,{?MODULE,worker_foo,[A2A]}}), - - %% Test the 'all' flag. - ?line {Work3A,Work3B} = start_and_trace(all, A3A=[12,13], A3B=[13,12]), - ?line expect({trace,Work3A,call,{?MODULE,worker_foo,[A3A]}}), - ?line expect({trace,Work3B,call,{?MODULE,worker_foo,[A3B]}}), - + Tracer = start_tracer(), + {flags,[call]} = trace_info(self(), flags), + {tracer,Tracer} = trace_info(self(), tracer), + trace_func({?MODULE,worker_foo,1}, []), + + %% Test the 'new' and 'new_processes' flags. + + New = fun(Flag) -> + {Work1A,Work1B} = start_and_trace(Flag, [1,2,3], A1B={3,2,1}), + {flags,[]} = trace_info(Work1A, flags), + {tracer,[]} = trace_info(Work1A, tracer), + {tracer,Tracer} = trace_info(Work1B, tracer), + {flags,[call]} = trace_info(Work1B, flags), + expect({trace,Work1B,call,{?MODULE,worker_foo,[A1B]}}), + unlink(Work1B), + Mref = erlang:monitor(process, Work1B), + exit(Work1B, kill), + receive + {'DOWN',Mref,_,_,_} -> ok + end, + undefined = trace_info(Work1B, flags), + {flags,[]} = trace_info(Flag, flags), + {tracer,[]} = trace_info(Flag, tracer) + end, + New(new), + New(new_processes), + + %% Test the 'existing' and 'existing_processes' flags. + Existing = + fun(Flag) -> + {Work2A,_Work2B} = start_and_trace(Flag, A2A=[5,6,7], [7,6,5]), + expect({trace,Work2A,call,{?MODULE,worker_foo,[A2A]}}) + end, + Existing(existing), + Existing(existing_processes), + + %% Test the 'all' and 'processes' flags. + All = + fun(Flag) -> + {Work3A,Work3B} = start_and_trace(Flag, A3A=[12,13], A3B=[13,12]), + expect({trace,Work3A,call,{?MODULE,worker_foo,[A3A]}}), + expect({trace,Work3B,call,{?MODULE,worker_foo,[A3B]}}) + end, + All(all), + All(processes), + ok. start_and_trace(Flag, A1, A2) -> @@ -141,33 +134,33 @@ start_and_trace(Flag, A1, A2) -> call_worker(W1, A1), call_worker(W2, A2), case Flag of - new -> - {flags,[call]} = trace_info(new, flags), - {tracer,_} = trace_info(new, tracer); - _Other -> - ok + new -> + {flags,[call]} = trace_info(new, flags), + {tracer,_} = trace_info(new, tracer); + _Other -> + ok end, trace_pid(Flag, false, [call]), {W1,W2}. start_worker() -> - ?line spawn(fun worker_loop/0). + spawn(fun worker_loop/0). call_worker(Pid, Arg) -> Pid ! {self(),{call,Arg}}, receive - {result,Res} -> Res + {result,Res} -> Res after 5000 -> - ?line ?t:fail(no_answer_from_worker) + ct:fail(no_answer_from_worker) end. worker_loop() -> receive - {From,{call,Arg}} -> - From ! {result,?MODULE:worker_foo(Arg)}, - worker_loop(); - Other -> - exit({unexpected_message,Other}) + {From,{call,Arg}} -> + From ! {result,?MODULE:worker_foo(Arg)}, + worker_loop(); + Other -> + exit({unexpected_message,Other}) end. worker_foo(_Arg) -> @@ -176,98 +169,98 @@ worker_foo(_Arg) -> %% Basic test of the call tracing (we trace one process). basic(_Config) -> case test_server:is_native(lists) of - true -> {skip,"lists is native"}; - false -> basic() + true -> {skip,"lists is native"}; + false -> basic() end. basic() -> - ?line start_tracer(), - ?line trace_info(self(), flags), - ?line trace_info(self(), tracer), - ?line 0 = trace_func({?MODULE,no_such_function,0}, []), - ?line {traced,undefined} = - trace_info({?MODULE,no_such_function,0}, traced), - ?line {match_spec, undefined} = - trace_info({?MODULE,no_such_function,0}, match_spec), + start_tracer(), + trace_info(self(), flags), + trace_info(self(), tracer), + 0 = trace_func({?MODULE,no_such_function,0}, []), + {traced,undefined} = + trace_info({?MODULE,no_such_function,0}, traced), + {match_spec, undefined} = + trace_info({?MODULE,no_such_function,0}, match_spec), %% Trace some functions... - ?line trace_func({lists,'_','_'}, []), + trace_func({lists,'_','_'}, []), %% Make sure that tracing the same functions more than once %% does not cause any problems. - ?line 3 = trace_func({?MODULE,foo,'_'}, true), - ?line 3 = trace_func({?MODULE,foo,'_'}, true), - ?line 1 = trace_func({?MODULE,bar,0}, true), - ?line 1 = trace_func({?MODULE,bar,0}, true), - ?line {traced,global} = trace_info({?MODULE,bar,0}, traced), - ?line 1 = trace_func({erlang,list_to_integer,1}, true), - ?line {traced,global} = trace_info({erlang,list_to_integer,1}, traced), + 3 = trace_func({?MODULE,foo,'_'}, true), + 3 = trace_func({?MODULE,foo,'_'}, true), + 1 = trace_func({?MODULE,bar,0}, true), + 1 = trace_func({?MODULE,bar,0}, true), + {traced,global} = trace_info({?MODULE,bar,0}, traced), + 1 = trace_func({erlang,list_to_integer,1}, true), + {traced,global} = trace_info({erlang,list_to_integer,1}, traced), %% ... and call them... - ?line AList = [x,y,z], - ?line true = lists:member(y, AList), - ?line foo0 = ?MODULE:foo(), - ?line 4 = ?MODULE:foo(3), - ?line 11 = ?MODULE:foo(7, 4), - ?line ok = ?MODULE:bar(), - ?line 42 = list_to_integer(non_literal("42")), + AList = [x,y,z], + true = lists:member(y, AList), + foo0 = ?MODULE:foo(), + 4 = ?MODULE:foo(3), + 11 = ?MODULE:foo(7, 4), + ok = ?MODULE:bar(), + 42 = list_to_integer(non_literal("42")), %% ... make sure the we got trace messages (but not for ?MODULE:expect/1). - ?line Self = self(), - ?line ?MODULE:expect({trace,Self,call,{lists,member,[y,AList]}}), - ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[]}}), - ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[3]}}), - ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[7,4]}}), - ?line ?MODULE:expect({trace,Self,call,{?MODULE,bar,[]}}), - ?line ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["42"]}}), + Self = self(), + ?MODULE:expect({trace,Self,call,{lists,member,[y,AList]}}), + ?MODULE:expect({trace,Self,call,{?MODULE,foo,[]}}), + ?MODULE:expect({trace,Self,call,{?MODULE,foo,[3]}}), + ?MODULE:expect({trace,Self,call,{?MODULE,foo,[7,4]}}), + ?MODULE:expect({trace,Self,call,{?MODULE,bar,[]}}), + ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["42"]}}), %% Turn off trace for this module and call functions... - ?line trace_func({?MODULE,'_','_'}, false), - ?line {traced,false} = trace_info({?MODULE,bar,0}, traced), - ?line foo0 = ?MODULE:foo(), - ?line 4 = ?MODULE:foo(3), - ?line 11 = ?MODULE:foo(7, 4), - ?line ok = ?MODULE:bar(), - ?line [1,2,3,4,5,6,7,8,9,10] = lists:seq(1, 10), - ?line 777 = list_to_integer(non_literal("777")), + trace_func({?MODULE,'_','_'}, false), + {traced,false} = trace_info({?MODULE,bar,0}, traced), + foo0 = ?MODULE:foo(), + 4 = ?MODULE:foo(3), + 11 = ?MODULE:foo(7, 4), + ok = ?MODULE:bar(), + [1,2,3,4,5,6,7,8,9,10] = lists:seq(1, 10), + 777 = list_to_integer(non_literal("777")), %% ... turn on all trace messages... - ?line trace_func({'_','_','_'}, false), - ?line [b,a] = lists:reverse([a,b]), + trace_func({'_','_','_'}, false), + [b,a] = lists:reverse([a,b]), - %% Read out the remaing trace messages. + %% Read out the remaining trace messages. - ?line ?MODULE:expect({trace,Self,call,{lists,seq,[1,10]}}), - ?line ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["777"]}}), + ?MODULE:expect({trace,Self,call,{lists,seq,[1,10]}}), + ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["777"]}}), receive - Any -> - ?line ?t:fail({unexpected_message,Any}) + Any -> + ct:fail({unexpected_message,Any}) after 1 -> - ok + ok end, %% Turn on and then off tracing on all external functions. %% This might cause the emulator to crasch later if it doesn't %% restore all export entries properly. - ?line AllFuncs = trace_func({'_','_','_'}, true), + AllFuncs = trace_func({'_','_','_'}, true), io:format("AllFuncs = ~p", [AllFuncs]), %% Make sure that a traced, exported function can still be found. - ?line true = erlang:function_exported(error_handler, undefined_function, 3), - ?line AllFuncs = trace_func({'_','_','_'}, false), - ?line erlang:trace_delivered(all), + true = erlang:function_exported(error_handler, undefined_function, 3), + AllFuncs = trace_func({'_','_','_'}, false), + erlang:trace_delivered(all), receive - {trace_delivered,_,_} -> ok + {trace_delivered,_,_} -> ok end, c:flush(), % Print the traces messages. c:flush(), % Print the traces messages. - ?line {traced,false} = trace_info({erlang,list_to_integer,1}, traced), + {traced,false} = trace_info({erlang,list_to_integer,1}, traced), ok. @@ -286,8 +279,8 @@ foo(X, Y) -> X+Y. %% This test case was written to verify that we do not change %% any behaviour with the introduction of "block-free" upgrade in R16. %% In short: Do not refer to this test case as an authority of how it must work. -upgrade(doc) -> - "Test tracing on module being upgraded"; + +%% Test tracing on module being upgraded upgrade(Config) when is_list(Config) -> V1 = compile_version(my_upgrade_test, 1, Config), V2 = compile_version(my_upgrade_test, 2, Config), @@ -303,8 +296,8 @@ upgrade_do(V1, V2, TraceLocalVersion) -> trace_func({my_upgrade_test,'_','_'}, [], [global]), case TraceLocalVersion of - true -> trace_func({my_upgrade_test,local_version,0}, [], [local]); - _ -> ok + true -> trace_func({my_upgrade_test,local_version,0}, [], [local]); + _ -> ok end, 1 = my_upgrade_test:version(), 1 = my_upgrade_test:do_local(), @@ -319,15 +312,15 @@ upgrade_do(V1, V2, TraceLocalVersion) -> expect({trace,Self,call,{my_upgrade_test,do_local,[]}}), expect({trace,Self,call,{my_upgrade_test,do_real_local,[]}}), case TraceLocalVersion of - true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); - _ -> ok + true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); + _ -> ok end, expect({trace,Self,call,{my_upgrade_test,make_fun_exp,[]}}), expect({trace,Self,call,{my_upgrade_test,make_fun_local,[]}}), expect({trace,Self,call,{my_upgrade_test,version,[]}}), % F1_exp case TraceLocalVersion of - true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F1_loc - _ -> ok + true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F1_loc + _ -> ok end, {module,my_upgrade_test} = erlang:load_module(my_upgrade_test, V2), @@ -349,8 +342,8 @@ upgrade_do(V1, V2, TraceLocalVersion) -> trace_func({my_upgrade_test,'_','_'}, [], [global]), case TraceLocalVersion of - true -> trace_func({my_upgrade_test,local_version,0}, [], [local]); - _ -> ok + true -> trace_func({my_upgrade_test,local_version,0}, [], [local]); + _ -> ok end, 2 = my_upgrade_test:version(), 2 = my_upgrade_test:do_local(), @@ -362,13 +355,13 @@ upgrade_do(V1, V2, TraceLocalVersion) -> expect({trace,Self,call,{my_upgrade_test,do_local,[]}}), expect({trace,Self,call,{my_upgrade_test,do_real_local,[]}}), case TraceLocalVersion of - true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); - _ -> ok + true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); + _ -> ok end, expect({trace,Self,call,{my_upgrade_test,version,[]}}), % F2_exp case TraceLocalVersion of - true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F2_loc - _ -> ok + true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F2_loc + _ -> ok end, true = erlang:delete_module(my_upgrade_test), @@ -384,10 +377,10 @@ upgrade_do(V1, V2, TraceLocalVersion) -> ok. compile_version(Module, Version, Config) -> - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), File = filename:join(Data, atom_to_list(Module)), {ok,Module,Bin} = compile:file(File, [{d,'VERSION',Version}, - binary,report]), + binary,report]), Bin. @@ -396,162 +389,157 @@ compile_version(Module, Version, Config) -> %% Also, test the '{tracer,Pid}' option. flags(_Config) -> case test_server:is_native(filename) of - true -> {skip,"filename is native"}; - false -> flags() + true -> {skip,"filename is native"}; + false -> flags() end. flags() -> - ?line Tracer = start_tracer_loop(), - ?line trace_pid(self(), true, [call,{tracer,Tracer}]), + Tracer = start_tracer_loop(), + trace_pid(self(), true, [call,{tracer,Tracer}]), %% Trace some functions... - ?line trace_func({filename,'_','_'}, true), + trace_func({filename,'_','_'}, true), %% ... and call them... - ?line Self = self(), - ?line filename:absname("nisse"), - ?line ?MODULE:expect({trace,Self,call,{filename,absname,["nisse"]}}), - ?line trace_pid(Self, true, [call,arity]), - ?line filename:absname("kalle"), - ?line filename:absname("kalle", "/root"), - ?line ?MODULE:expect({trace,Self,call,{filename,absname,1}}), - ?line ?MODULE:expect({trace,Self,call,{filename,absname,2}}), - ?line trace_info(Self, flags), + Self = self(), + filename:absname("nisse"), + ?MODULE:expect({trace,Self,call,{filename,absname,["nisse"]}}), + trace_pid(Self, true, [call,arity]), + filename:absname("kalle"), + filename:absname("kalle", "/root"), + ?MODULE:expect({trace,Self,call,{filename,absname,1}}), + ?MODULE:expect({trace,Self,call,{filename,absname,2}}), + trace_info(Self, flags), %% Timestamp + arity. flag_test(fun() -> - ?line trace_pid(Self, true, [timestamp]), - ?line "dum" = filename:basename("/abcd/dum"), - ?line Ts = expect({trace_ts,Self,call,{filename,basename,1},ts}), - ?line trace_info(Self, flags), - Ts - end), + trace_pid(Self, true, [timestamp]), + "dum" = filename:basename("/abcd/dum"), + Ts = expect({trace_ts,Self,call,{filename,basename,1},ts}), + trace_info(Self, flags), + Ts + end), %% Timestamp. - ?line AnArg = "/abcd/hejsan", + AnArg = "/abcd/hejsan", flag_test(fun() -> - ?line trace_pid(Self, false, [arity]), - ?line "hejsan" = filename:basename(AnArg), - ?line Ts = expect({trace_ts,Self,call, - {filename,basename,[AnArg]},ts}), - ?line trace_info(Self, flags), - Ts - end), + trace_pid(Self, false, [arity]), + "hejsan" = filename:basename(AnArg), + Ts = expect({trace_ts,Self,call, + {filename,basename,[AnArg]},ts}), + trace_info(Self, flags), + Ts + end), %% All flags turned off. - ?line trace_pid(Self, false, [timestamp]), - ?line AnotherArg = filename:join(AnArg, "hoppsan"), - ?line "hoppsan" = filename:basename(AnotherArg), - ?line expect({trace,Self,call,{filename,join,[AnArg,"hoppsan"]}}), - ?line expect({trace,Self,call,{filename,basename,[AnotherArg]}}), - ?line trace_info(Self, flags), - + trace_pid(Self, false, [timestamp]), + AnotherArg = filename:join(AnArg, "hoppsan"), + "hoppsan" = filename:basename(AnotherArg), + expect({trace,Self,call,{filename,join,[AnArg,"hoppsan"]}}), + expect({trace,Self,call,{filename,basename,[AnotherArg]}}), + trace_info(Self, flags), + ok. flag_test(Test) -> Now = now(), Ts = Test(), case timer:now_diff(Ts, Now) of - Time when Time < 5*1000000 -> - %% Reasonable short time. - ok; - _Diff -> - %% Too large difference. - io:format("Now = ~p\n", [Now]), - io:format("Ts = ~p\n", [Ts]), - ?line ?t:fail() + Time when Time < 5*1000000 -> + %% Reasonable short time. + ok; + _Diff -> + %% Too large difference. + ct:fail("Now = ~p, Ts = ~p", [Now, Ts]) end, flag_test_cpu_timestamp(Test). flag_test_cpu_timestamp(Test) -> try erlang:trace(all, true, [cpu_timestamp]) of - _ -> - io:format("CPU timestamps"), - Ts = Test(), - erlang:trace(all, false, [cpu_timestamp]), - Origin = {0,0,0}, - Hour = 3600*1000000, - case timer:now_diff(Ts, Origin) of - Diff when Diff < 4*Hour -> - %% In the worst case, CPU timestamps count from when this - %% Erlang emulator was started. The above test is a conservative - %% test that all CPU timestamps should pass. - ok; - _Time -> - io:format("Strange CPU timestamp: ~p", [Ts]), - ?line ?t:fail() - end, - io:format("Turned off CPU timestamps") + _ -> + io:format("CPU timestamps"), + Ts = Test(), + erlang:trace(all, false, [cpu_timestamp]), + Origin = {0,0,0}, + Hour = 3600*1000000, + case timer:now_diff(Ts, Origin) of + Diff when Diff < 4*Hour -> + %% In the worst case, CPU timestamps count from when this + %% Erlang emulator was started. The above test is a conservative + %% test that all CPU timestamps should pass. + ok; + _Time -> + ct:fail("Strange CPU timestamp: ~p", [Ts]) + end, + io:format("Turned off CPU timestamps") catch - error:badarg -> ok + error:badarg -> ok end. -errors(doc) -> "Test bad arguments for trace/3 and trace_pattern/3."; -errors(suite) -> []; +%% Test bad arguments for trace/3 and trace_pattern/3. errors(Config) when is_list(Config) -> - ?line expect_badarg_pid(aaa, true, []), - ?line expect_badarg_pid({pid,dum}, false, []), - ?line expect_badarg_func({'_','_',1}, []), - ?line expect_badarg_func({'_',gosh,1}, []), - ?line expect_badarg_func({xxx,'_',2}, []), - ?line expect_badarg_func({xxx,yyy,b}, glurp), + expect_badarg_pid(aaa, true, []), + expect_badarg_pid({pid,dum}, false, []), + expect_badarg_func({'_','_',1}, []), + expect_badarg_func({'_',gosh,1}, []), + expect_badarg_func({xxx,'_',2}, []), + expect_badarg_func({xxx,yyy,b}, glurp), ok. expect_badarg_pid(What, How, Flags) -> case catch erlang:trace(What, How, Flags) of - {'EXIT',{badarg,Where}} -> - io:format("trace(~p, ~p, ~p) ->\n {'EXIT',{badarg,~p}}", - [What,How,Flags,Where]), - ok; - Other -> - io:format("trace(~p, ~p, ~p) -> ~p", - [What,How,Flags,Other]), - ?t:fail({unexpected,Other}) + {'EXIT',{badarg,Where}} -> + io:format("trace(~p, ~p, ~p) ->\n {'EXIT',{badarg,~p}}", + [What,How,Flags,Where]), + ok; + Other -> + io:format("trace(~p, ~p, ~p) -> ~p", + [What,How,Flags,Other]), + ct:fail({unexpected,Other}) end. expect_badarg_func(MFA, Pattern) -> case catch erlang:trace_pattern(MFA, Pattern) of - {'EXIT',{badarg,Where}} -> - io:format("trace_pattern(~p, ~p) ->\n {'EXIT',{badarg,~p}}", - [MFA,Pattern,Where]), - ok; - Other -> - io:format("trace_pattern(~p, ~p) -> ~p", - [MFA, Pattern, Other]), - ?t:fail({unexpected,Other}) + {'EXIT',{badarg,Where}} -> + io:format("trace_pattern(~p, ~p) ->\n {'EXIT',{badarg,~p}}", + [MFA,Pattern,Where]), + ok; + Other -> + io:format("trace_pattern(~p, ~p) -> ~p", + [MFA, Pattern, Other]), + ct:fail({unexpected,Other}) end. -pam(doc) -> "Basic test of PAM."; -pam(suite) -> []; +%% Basic test of PAM. pam(Config) when is_list(Config) -> - ?line start_tracer(), - ?line Self = self(), + start_tracer(), + Self = self(), %% Build the match program. - ?line Prog1 = {[{a,tuple},'$1'],[],[]}, - ?line Prog2 = {[{a,bigger,tuple},'$1'],[],[{message,'$1'}]}, - ?line MatchProg = [Prog1,Prog2], - ?line pam_trace(MatchProg), + Prog1 = {[{a,tuple},'$1'],[],[]}, + Prog2 = {[{a,bigger,tuple},'$1'],[],[{message,'$1'}]}, + MatchProg = [Prog1,Prog2], + pam_trace(MatchProg), %% Do some calls. - ?line ?MODULE:pam_foo(not_a_tuple, [a,b]), - ?line ?MODULE:pam_foo({a,tuple}, [a,list]), - ?line ?MODULE:pam_foo([this,one,will,'not',match], dummy_arg), - ?line LongList = lists:seq(1,10), - ?line ?MODULE:pam_foo({a,bigger,tuple}, LongList), + ?MODULE:pam_foo(not_a_tuple, [a,b]), + ?MODULE:pam_foo({a,tuple}, [a,list]), + ?MODULE:pam_foo([this,one,will,'not',match], dummy_arg), + LongList = lists:seq(1,10), + ?MODULE:pam_foo({a,bigger,tuple}, LongList), %% Check that we get the correct trace messages. - ?line expect({trace,Self,call,{?MODULE,pam_foo,[{a,tuple},[a,list]]}}), - ?line expect({trace,Self,call, - {?MODULE,pam_foo,[{a,bigger,tuple},LongList]}, - LongList}), + expect({trace,Self,call,{?MODULE,pam_foo,[{a,tuple},[a,list]]}}), + expect({trace,Self,call, + {?MODULE,pam_foo,[{a,bigger,tuple},LongList]}, + LongList}), - ?line trace_func({?MODULE,pam_foo,'_'}, false), + trace_func({?MODULE,pam_foo,'_'}, false), ok. pam_trace(Prog) -> @@ -566,38 +554,38 @@ pam_foo(A, B) -> %% Test changing PAM programs for a function. change_pam(_Config) -> case test_server:is_native(lists) of - true -> {skip,"lists is native"}; - false -> change_pam() + true -> {skip,"lists is native"}; + false -> change_pam() end. change_pam() -> - ?line start_tracer(), - ?line Self = self(), + start_tracer(), + Self = self(), %% Install the first match program. %% Test using timestamp at the same time. - ?line trace_pid(Self, true, [call,arity,timestamp]), - ?line Prog1 = [{['$1','$2'],[],[{message,'$1'}]}], - ?line change_pam_trace(Prog1), - ?line [x,y] = lists:append(id([x]), id([y])), - ?line {heap_size,_} = erlang:process_info(Self, heap_size), - ?line expect({trace_ts,Self,call,{lists,append,2},[x],ts}), - ?line expect({trace_ts,Self,call,{erlang,process_info,2},Self,ts}), + trace_pid(Self, true, [call,arity,timestamp]), + Prog1 = [{['$1','$2'],[],[{message,'$1'}]}], + change_pam_trace(Prog1), + [x,y] = lists:append(id([x]), id([y])), + {heap_size,_} = erlang:process_info(Self, heap_size), + expect({trace_ts,Self,call,{lists,append,2},[x],ts}), + expect({trace_ts,Self,call,{erlang,process_info,2},Self,ts}), %% Install a new PAM program. - ?line Prog2 = [{['$1','$2'],[],[{message,'$2'}]}], - ?line change_pam_trace(Prog2), - ?line [xx,yy] = lists:append(id([xx]), id([yy])), - ?line {current_function,_} = erlang:process_info(Self, current_function), - ?line expect({trace_ts,Self,call,{lists,append,2},[yy],ts}), - ?line expect({trace_ts,Self,call,{erlang,process_info,2},current_function,ts}), + Prog2 = [{['$1','$2'],[],[{message,'$2'}]}], + change_pam_trace(Prog2), + [xx,yy] = lists:append(id([xx]), id([yy])), + {current_function,_} = erlang:process_info(Self, current_function), + expect({trace_ts,Self,call,{lists,append,2},[yy],ts}), + expect({trace_ts,Self,call,{erlang,process_info,2},current_function,ts}), - ?line 1 = trace_func({lists,append,2}, false), - ?line 1 = trace_func({erlang,process_info,2}, false), - ?line {match_spec,false} = trace_info({lists,append,2}, match_spec), - ?line {match_spec,false} = trace_info({erlang,process_info,2}, match_spec), + 1 = trace_func({lists,append,2}, false), + 1 = trace_func({erlang,process_info,2}, false), + {match_spec,false} = trace_info({lists,append,2}, match_spec), + {match_spec,false} = trace_info({erlang,process_info,2}, match_spec), ok. @@ -610,71 +598,71 @@ change_pam_trace(Prog) -> return_trace(_Config) -> case test_server:is_native(lists) of - true -> {skip,"lists is native"}; - false -> return_trace() + true -> {skip,"lists is native"}; + false -> return_trace() end. return_trace() -> X = {save,me}, - ?line start_tracer(), - ?line Self = self(), + start_tracer(), + Self = self(), %% Test call and return trace and timestamp. - ?line trace_pid(Self, true, [call,timestamp]), + trace_pid(Self, true, [call,timestamp]), Stupid = {pointless,tuple}, - ?line Prog1 = [{['$1','$2'],[],[{return_trace},{message,{Stupid}}]}], - ?line 1 = trace_func({lists,append,2}, Prog1), - ?line 1 = trace_func({erlang,process_info,2}, Prog1), - ?line {match_spec,Prog1} = trace_info({lists,append,2}, match_spec), - ?line {match_spec,Prog1} = trace_info({erlang,process_info,2}, match_spec), + Prog1 = [{['$1','$2'],[],[{return_trace},{message,{Stupid}}]}], + 1 = trace_func({lists,append,2}, Prog1), + 1 = trace_func({erlang,process_info,2}, Prog1), + {match_spec,Prog1} = trace_info({lists,append,2}, match_spec), + {match_spec,Prog1} = trace_info({erlang,process_info,2}, match_spec), - ?line [x,y] = lists:append(id([x]), id([y])), + [x,y] = lists:append(id([x]), id([y])), Current = {current_function,{?MODULE,return_trace,0}}, - ?line Current = erlang:process_info(Self, current_function), - ?line expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}), - ?line expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}), - ?line expect({trace_ts,Self,call,{erlang,process_info,[Self,current_function]}, - Stupid,ts}), - ?line expect({trace_ts,Self,return_from,{erlang,process_info,2},Current,ts}), + Current = erlang:process_info(Self, current_function), + expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}), + expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}), + expect({trace_ts,Self,call,{erlang,process_info,[Self,current_function]}, + Stupid,ts}), + expect({trace_ts,Self,return_from,{erlang,process_info,2},Current,ts}), %% Try catch/exit. - ?line 1 = trace_func({?MODULE,nasty,0}, [{[],[],[{return_trace},{message,false}]}]), - ?line {'EXIT',good_bye} = (catch ?MODULE:nasty()), - ?line 1 = trace_func({?MODULE,nasty,0}, false), + 1 = trace_func({?MODULE,nasty,0}, [{[],[],[{return_trace},{message,false}]}]), + {'EXIT',good_bye} = (catch ?MODULE:nasty()), + 1 = trace_func({?MODULE,nasty,0}, false), %% Turn off trace. - ?line 1 = trace_func({lists,append,2}, false), - ?line 1 = trace_func({erlang,process_info,2}, false), - ?line {match_spec,false} = trace_info({lists,append,2}, match_spec), - ?line {match_spec,false} = trace_info({erlang,process_info,2}, match_spec), + 1 = trace_func({lists,append,2}, false), + 1 = trace_func({erlang,process_info,2}, false), + {match_spec,false} = trace_info({lists,append,2}, match_spec), + {match_spec,false} = trace_info({erlang,process_info,2}, match_spec), %% No timestamp, no trace message for call. - ?line trace_pid(Self, false, [timestamp]), - ?line Prog2 = [{['$1','$2'],[],[{return_trace},{message,false}]}, - {['$1'],[],[{return_trace},{message,false}]}], - ?line 1 = trace_func({lists,seq,2}, Prog2), - ?line 1 = trace_func({erlang,atom_to_list,1}, Prog2), - ?line {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec), - ?line {match_spec,Prog2} = trace_info({erlang,atom_to_list,1}, match_spec), + trace_pid(Self, false, [timestamp]), + Prog2 = [{['$1','$2'],[],[{return_trace},{message,false}]}, + {['$1'],[],[{return_trace},{message,false}]}], + 1 = trace_func({lists,seq,2}, Prog2), + 1 = trace_func({erlang,atom_to_list,1}, Prog2), + {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec), + {match_spec,Prog2} = trace_info({erlang,atom_to_list,1}, match_spec), - ?line lists:seq(2, 7), - ?line _ = atom_to_list(non_literal(nisse)), - ?line expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), - ?line expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), + lists:seq(2, 7), + _ = atom_to_list(non_literal(nisse)), + expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), + expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), %% Turn off trace. - ?line 1 = trace_func({lists,seq,2}, false), - ?line 1 = trace_func({erlang,atom_to_list,1}, false), - ?line {match_spec,false} = trace_info({lists,seq,2}, match_spec), - ?line {match_spec,false} = trace_info({erlang,atom_to_list,1}, match_spec), + 1 = trace_func({lists,seq,2}, false), + 1 = trace_func({erlang,atom_to_list,1}, false), + {match_spec,false} = trace_info({lists,seq,2}, match_spec), + {match_spec,false} = trace_info({erlang,atom_to_list,1}, match_spec), + + {save,me} = X, - ?line {save,me} = X, - ok. nasty() -> @@ -682,396 +670,393 @@ nasty() -> exception_trace(_Config) -> case test_server:is_native(lists) of - true -> {skip,"lists is native"}; - false -> exception_trace() + true -> {skip,"lists is native"}; + false -> exception_trace() end. exception_trace() -> X = {save,me}, - ?line start_tracer(), - ?line Self = self(), + start_tracer(), + Self = self(), %% Test call and return trace and timestamp. - ?line trace_pid(Self, true, [call,timestamp]), + trace_pid(Self, true, [call,timestamp]), Stupid = {pointless,tuple}, - ?line Prog1 = [{['$1','$2'],[],[{exception_trace},{message,{Stupid}}]}], - ?line 1 = trace_func({lists,append,2}, Prog1), - ?line 1 = trace_func({erlang,process_info,2}, Prog1), - ?line {match_spec,Prog1} = trace_info({lists,append,2}, match_spec), - ?line {match_spec,Prog1} = - trace_info({erlang,process_info,2}, match_spec), - - ?line [x,y] = lists:append(id([x]), id([y])), + Prog1 = [{['$1','$2'],[],[{exception_trace},{message,{Stupid}}]}], + 1 = trace_func({lists,append,2}, Prog1), + 1 = trace_func({erlang,process_info,2}, Prog1), + {match_spec,Prog1} = trace_info({lists,append,2}, match_spec), + {match_spec,Prog1} = + trace_info({erlang,process_info,2}, match_spec), + + [x,y] = lists:append(id([x]), id([y])), Current = {current_function,{?MODULE,exception_trace,0}}, - ?line Current = erlang:process_info(Self, current_function), - ?line expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}), - ?line expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}), - ?line expect({trace_ts,Self,call,{erlang,process_info, - [Self,current_function]}, - Stupid,ts}), - ?line expect({trace_ts,Self,return_from, - {erlang,process_info,2},Current,ts}), + Current = erlang:process_info(Self, current_function), + expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}), + expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}), + expect({trace_ts,Self,call,{erlang,process_info, + [Self,current_function]}, + Stupid,ts}), + expect({trace_ts,Self,return_from, + {erlang,process_info,2},Current,ts}), %% Try catch/exit. - ?line 1 = trace_func({?MODULE,nasty,0}, - [{[],[],[{exception_trace},{message,false}]}]), - ?line {'EXIT',good_bye} = (catch ?MODULE:nasty()), - ?line expect({trace_ts,Self,exception_from, - {?MODULE,nasty,0},{exit,good_bye},ts}), - ?line 1 = trace_func({?MODULE,nasty,0}, false), + 1 = trace_func({?MODULE,nasty,0}, + [{[],[],[{exception_trace},{message,false}]}]), + {'EXIT',good_bye} = (catch ?MODULE:nasty()), + expect({trace_ts,Self,exception_from, + {?MODULE,nasty,0},{exit,good_bye},ts}), + 1 = trace_func({?MODULE,nasty,0}, false), %% Turn off trace. - ?line 1 = trace_func({lists,append,2}, false), - ?line 1 = trace_func({erlang,process_info,2}, false), - ?line {match_spec,false} = trace_info({lists,append,2}, match_spec), - ?line {match_spec,false} = - trace_info({erlang,process_info,2}, match_spec), + 1 = trace_func({lists,append,2}, false), + 1 = trace_func({erlang,process_info,2}, false), + {match_spec,false} = trace_info({lists,append,2}, match_spec), + {match_spec,false} = + trace_info({erlang,process_info,2}, match_spec), %% No timestamp, no trace message for call. - ?line trace_pid(Self, false, [timestamp]), - ?line Prog2 = [{['$1','$2'],[],[{exception_trace},{message,false}]}, - {['$1'],[],[{exception_trace},{message,false}]}], - ?line 1 = trace_func({lists,seq,2}, Prog2), - ?line 1 = trace_func({erlang,atom_to_list,1}, Prog2), - ?line {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec), - ?line {match_spec,Prog2} = - trace_info({erlang,atom_to_list,1}, match_spec), + trace_pid(Self, false, [timestamp]), + Prog2 = [{['$1','$2'],[],[{exception_trace},{message,false}]}, + {['$1'],[],[{exception_trace},{message,false}]}], + 1 = trace_func({lists,seq,2}, Prog2), + 1 = trace_func({erlang,atom_to_list,1}, Prog2), + {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec), + {match_spec,Prog2} = + trace_info({erlang,atom_to_list,1}, match_spec), - ?line lists:seq(2, 7), - ?line _ = atom_to_list(non_literal(nisse)), - ?line expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), - ?line expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), + lists:seq(2, 7), + _ = atom_to_list(non_literal(nisse)), + expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), + expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), %% Turn off trace. - ?line 1 = trace_func({lists,seq,2}, false), - ?line 1 = trace_func({erlang,atom_to_list,1}, false), - ?line {match_spec,false} = trace_info({lists,seq,2}, match_spec), - ?line {match_spec,false} = - trace_info({erlang,atom_to_list,1}, match_spec), + 1 = trace_func({lists,seq,2}, false), + 1 = trace_func({erlang,atom_to_list,1}, false), + {match_spec,false} = trace_info({lists,seq,2}, match_spec), + {match_spec,false} = + trace_info({erlang,atom_to_list,1}, match_spec), - ?line expect(), - ?line {save,me} = X, + expect(), + {save,me} = X, ok. -on_load(doc) -> "Test the on_load argument for trace_pattern/3."; -on_load(suite) -> []; +%% Test the on_load argument for trace_pattern/3. on_load(Config) when is_list(Config) -> - ?line 0 = erlang:trace_pattern(on_load, []), - ?line {traced,global} = erlang:trace_info(on_load, traced), - ?line {match_spec,[]} = erlang:trace_info(on_load, match_spec), + 0 = erlang:trace_pattern(on_load, []), + {traced,global} = erlang:trace_info(on_load, traced), + {match_spec,[]} = erlang:trace_info(on_load, match_spec), - ?line 0 = erlang:trace_pattern(on_load, true, [local]), - ?line {traced,local} = erlang:trace_info(on_load, traced), - ?line {match_spec,[]} = erlang:trace_info(on_load, match_spec), + 0 = erlang:trace_pattern(on_load, true, [local]), + {traced,local} = erlang:trace_info(on_load, traced), + {match_spec,[]} = erlang:trace_info(on_load, match_spec), - ?line 0 = erlang:trace_pattern(on_load, false, [local]), - ?line {traced,false} = erlang:trace_info(on_load, traced), - ?line {match_spec,false} = erlang:trace_info(on_load, match_spec), + 0 = erlang:trace_pattern(on_load, false, [local]), + {traced,false} = erlang:trace_info(on_load, traced), + {match_spec,false} = erlang:trace_info(on_load, match_spec), - ?line Pam1 = [{[],[],[{message,false}]}], - ?line 0 = erlang:trace_pattern(on_load, Pam1), - ?line {traced,global} = erlang:trace_info(on_load, traced), - ?line {match_spec,Pam1} = erlang:trace_info(on_load, match_spec), + Pam1 = [{[],[],[{message,false}]}], + 0 = erlang:trace_pattern(on_load, Pam1), + {traced,global} = erlang:trace_info(on_load, traced), + {match_spec,Pam1} = erlang:trace_info(on_load, match_spec), - ?line 0 = erlang:trace_pattern(on_load, true, [local]), - ?line 0 = erlang:trace_pattern(on_load, false, [local]), + 0 = erlang:trace_pattern(on_load, true, [local]), + 0 = erlang:trace_pattern(on_load, false, [local]), ok. -deep_exception(doc) -> "Test the new exception trace."; -deep_exception(suite) -> []; +%% Test the new exception trace. deep_exception(Config) when is_list(Config) -> deep_exception(). deep_exception() -> - ?line start_tracer(), - ?line Self = self(), - ?line N = 200000, - ?line LongImproperList = seq(1, N-1, N), - + start_tracer(), + Self = self(), + N = 200000, + LongImproperList = seq(1, N-1, N), + Prog = [{'_',[],[{exception_trace}]}], -%% ?line 1 = trace_pid(Self, true, [call]), - ?line 1 = trace_func({?MODULE,deep,'_'}, Prog), - ?line 1 = trace_func({?MODULE,deep_1,'_'}, Prog), - ?line 1 = trace_func({?MODULE,deep_2,'_'}, Prog), - ?line 1 = trace_func({?MODULE,deep_3,'_'}, Prog), - ?line 1 = trace_func({?MODULE,deep_4,'_'}, Prog), - ?line 1 = trace_func({?MODULE,deep_5,'_'}, Prog), - ?line 1 = trace_func({?MODULE,id,'_'}, Prog), - ?line 1 = trace_func({erlang,'++','_'}, Prog), - ?line 1 = trace_func({erlang,exit,1}, Prog), - ?line 1 = trace_func({erlang,throw,1}, Prog), - ?line 2 = trace_func({erlang,error,'_'}, Prog), - ?line 1 = trace_func({lists,reverse,2}, Prog), - - ?line deep_exception(?LINE, exit, [paprika], 1, - [{trace,Self,call,{erlang,exit,[paprika]}}, - {trace,Self,exception_from,{erlang,exit,1}, - {exit,paprika}}], - exception_from, {exit,paprika}), - ?line deep_exception(?LINE, throw, [3.14], 2, - [{trace,Self,call,{erlang,throw,[3.14]}}, - {trace,Self,exception_from,{erlang,throw,1}, - {throw,3.14}}], - exception_from, {throw,3.14}), - ?line deep_exception(?LINE, error, [{paprika}], 3, - [{trace,Self,call,{erlang,error,[{paprika}]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,{paprika}}}], - exception_from, {error,{paprika}}), - ?line deep_exception(?LINE, error, ["{paprika}",[]], 3, - [{trace,Self,call,{erlang,error,["{paprika}",[]]}}, - {trace,Self,exception_from,{erlang,error,2}, - {error,"{paprika}"}}], - exception_from, {error,"{paprika}"}), - ?line deep_exception(?LINE, id, [broccoli], 4, [], - return_from, broccoli), - ?line deep_exception( - ?LINE, append, [1,2], 5, - [{trace,Self,call,{erlang,'++',[1,2]}}, - {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}], - exception_from, {error,badarg}), - ?line deep_exception(?LINE, '=', [1,2], 6, [], - exception_from, {error,{badmatch,2}}), + %% 1 = trace_pid(Self, true, [call]), + 1 = trace_func({?MODULE,deep,'_'}, Prog), + 1 = trace_func({?MODULE,deep_1,'_'}, Prog), + 1 = trace_func({?MODULE,deep_2,'_'}, Prog), + 1 = trace_func({?MODULE,deep_3,'_'}, Prog), + 1 = trace_func({?MODULE,deep_4,'_'}, Prog), + 1 = trace_func({?MODULE,deep_5,'_'}, Prog), + 1 = trace_func({?MODULE,id,'_'}, Prog), + 1 = trace_func({erlang,'++','_'}, Prog), + 1 = trace_func({erlang,exit,1}, Prog), + 1 = trace_func({erlang,throw,1}, Prog), + 2 = trace_func({erlang,error,'_'}, Prog), + 1 = trace_func({lists,reverse,2}, Prog), + + deep_exception(?LINE, exit, [paprika], 1, + [{trace,Self,call,{erlang,exit,[paprika]}}, + {trace,Self,exception_from,{erlang,exit,1}, + {exit,paprika}}], + exception_from, {exit,paprika}), + deep_exception(?LINE, throw, [3.14], 2, + [{trace,Self,call,{erlang,throw,[3.14]}}, + {trace,Self,exception_from,{erlang,throw,1}, + {throw,3.14}}], + exception_from, {throw,3.14}), + deep_exception(?LINE, error, [{paprika}], 3, + [{trace,Self,call,{erlang,error,[{paprika}]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,{paprika}}}], + exception_from, {error,{paprika}}), + deep_exception(?LINE, error, ["{paprika}",[]], 3, + [{trace,Self,call,{erlang,error,["{paprika}",[]]}}, + {trace,Self,exception_from,{erlang,error,2}, + {error,"{paprika}"}}], + exception_from, {error,"{paprika}"}), + deep_exception(?LINE, id, [broccoli], 4, [], + return_from, broccoli), + deep_exception( + ?LINE, append, [1,2], 5, + [{trace,Self,call,{erlang,'++',[1,2]}}, + {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}], + exception_from, {error,badarg}), + deep_exception(?LINE, '=', [1,2], 6, [], + exception_from, {error,{badmatch,2}}), %% - ?line io:format("== Subtest: ~w", [?LINE]), - ?line try lists:reverse(LongImproperList, []) of - R1 -> test_server:fail({returned,abbr(R1)}) - catch error:badarg -> ok - end, - ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) - when is_list(L1), is_list(L2), S == Self -> - next; - ({trace,S,exception_from, - {lists,reverse,2},{error,badarg}}) - when S == Self -> - expected; - ('_') -> - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}; - (_) -> - {unexpected, - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}} - end), - ?line deep_exception(?LINE, deep_5, [1,2], 7, - [{trace,Self,call,{erlang,error,[undef]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,undef}}], - exception_from, {error,undef}), - ?line deep_exception(?LINE, deep_5, [undef], 8, - [{trace,Self,call,{?MODULE,deep_5,[undef]}}, - {trace,Self,exception_from,{?MODULE,deep_5,1}, - {error,function_clause}}], - exception_from, {error,function_clause}), - + io:format("== Subtest: ~w", [?LINE]), + try lists:reverse(LongImproperList, []) of + R1 -> ct:fail({returned,abbr(R1)}) + catch error:badarg -> ok + end, + expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + when is_list(L1), is_list(L2), S == Self -> + next; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}) + when S == Self -> + expected; + ('_') -> + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}; + (_) -> + {unexpected, + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}} + end), + deep_exception(?LINE, deep_5, [1,2], 7, + [{trace,Self,call,{erlang,error,[undef]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,undef}}], + exception_from, {error,undef}), + deep_exception(?LINE, deep_5, [undef], 8, + [{trace,Self,call,{?MODULE,deep_5,[undef]}}, + {trace,Self,exception_from,{?MODULE,deep_5,1}, + {error,function_clause}}], + exception_from, {error,function_clause}), + %% Apply %% - ?line deep_exception(?LINE, apply, [erlang,error,[[mo|rot]]], 1, - [{trace,Self,call,{erlang,error,[[mo|rot]]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,[mo|rot]}}], - exception_from, {error,[mo|rot]}), - ?line deep_exception(?LINE, apply, [erlang,error,[[mo|"rot"],[]]], 1, - [{trace,Self,call,{erlang,error,[[mo|"rot"],[]]}}, - {trace,Self,exception_from,{erlang,error,2}, - {error,[mo|"rot"]}}], - exception_from, {error,[mo|"rot"]}), - ?line Morot = make_ref(), - ?line deep_exception(?LINE, apply, [erlang,throw,[Morot]], 3, - [{trace,Self,call,{erlang,throw,[Morot]}}, - {trace,Self,exception_from,{erlang,throw,1}, - {throw,Morot}}], - exception_from, {throw,Morot}), - ?line deep_exception(?LINE, apply, [erlang,exit,[["morot"|Morot]]], 2, - [{trace,Self,call,{erlang,exit,[["morot"|Morot]]}}, - {trace,Self,exception_from,{erlang,exit,1}, - {exit,["morot"|Morot]}}], - exception_from, {exit,["morot"|Morot]}), - ?line deep_exception( - ?LINE, apply, [?MODULE,id,[spenat]], 4, - [{trace,Self,call,{?MODULE,id,[spenat]}}, - {trace,Self,return_from,{?MODULE,id,1},spenat}], - return_from, spenat), - ?line deep_exception( - ?LINE, apply, [erlang,'++',[1,2]], 5, - [{trace,Self,call,{erlang,'++',[1,2]}}, - {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}], - exception_from, {error,badarg}), - ?line io:format("== Subtest: ~w", [?LINE]), - ?line try apply(lists, reverse, [LongImproperList, []]) of - R2 -> test_server:fail({returned,abbr(R2)}) - catch error:badarg -> ok - end, - ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) - when is_list(L1), is_list(L2), S == Self -> - next; - ({trace,S,exception_from, - {lists,reverse,2},{error,badarg}}) - when S == Self -> - expected; - ('_') -> - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}; - (_) -> - {unexpected, - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}} - end), - ?line deep_exception(?LINE, apply, [?MODULE,deep_5,[1,2]], 7, - [{trace,Self,call,{erlang,error,[undef]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,undef}}], - exception_from, {error,undef}), - ?line deep_exception(?LINE, apply, [?MODULE,deep_5,[undef]], 8, - [{trace,Self,call,{?MODULE,deep_5,[undef]}}, - {trace,Self,exception_from,{?MODULE,deep_5,1}, - {error,function_clause}}], - exception_from, {error,function_clause}), + deep_exception(?LINE, apply, [erlang,error,[[mo|rot]]], 1, + [{trace,Self,call,{erlang,error,[[mo|rot]]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,[mo|rot]}}], + exception_from, {error,[mo|rot]}), + deep_exception(?LINE, apply, [erlang,error,[[mo|"rot"],[]]], 1, + [{trace,Self,call,{erlang,error,[[mo|"rot"],[]]}}, + {trace,Self,exception_from,{erlang,error,2}, + {error,[mo|"rot"]}}], + exception_from, {error,[mo|"rot"]}), + Morot = make_ref(), + deep_exception(?LINE, apply, [erlang,throw,[Morot]], 3, + [{trace,Self,call,{erlang,throw,[Morot]}}, + {trace,Self,exception_from,{erlang,throw,1}, + {throw,Morot}}], + exception_from, {throw,Morot}), + deep_exception(?LINE, apply, [erlang,exit,[["morot"|Morot]]], 2, + [{trace,Self,call,{erlang,exit,[["morot"|Morot]]}}, + {trace,Self,exception_from,{erlang,exit,1}, + {exit,["morot"|Morot]}}], + exception_from, {exit,["morot"|Morot]}), + deep_exception( + ?LINE, apply, [?MODULE,id,[spenat]], 4, + [{trace,Self,call,{?MODULE,id,[spenat]}}, + {trace,Self,return_from,{?MODULE,id,1},spenat}], + return_from, spenat), + deep_exception( + ?LINE, apply, [erlang,'++',[1,2]], 5, + [{trace,Self,call,{erlang,'++',[1,2]}}, + {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}], + exception_from, {error,badarg}), + io:format("== Subtest: ~w", [?LINE]), + try apply(lists, reverse, [LongImproperList, []]) of + R2 -> ct:fail({returned,abbr(R2)}) + catch error:badarg -> ok + end, + expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + when is_list(L1), is_list(L2), S == Self -> + next; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}) + when S == Self -> + expected; + ('_') -> + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}; + (_) -> + {unexpected, + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}} + end), + deep_exception(?LINE, apply, [?MODULE,deep_5,[1,2]], 7, + [{trace,Self,call,{erlang,error,[undef]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,undef}}], + exception_from, {error,undef}), + deep_exception(?LINE, apply, [?MODULE,deep_5,[undef]], 8, + [{trace,Self,call,{?MODULE,deep_5,[undef]}}, + {trace,Self,exception_from,{?MODULE,deep_5,1}, + {error,function_clause}}], + exception_from, {error,function_clause}), %% Apply of fun %% - ?line deep_exception(?LINE, apply, - [fun () -> - erlang:error([{"palsternacka",3.14},17]) - end, []], 1, - [{trace,Self,call, - {erlang,error,[[{"palsternacka",3.14},17]]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,[{"palsternacka",3.14},17]}}], - exception_from, {error,[{"palsternacka",3.14},17]}), - ?line deep_exception(?LINE, apply, - [fun () -> - erlang:error(["palsternacka",17], []) - end, []], 1, - [{trace,Self,call, - {erlang,error,[["palsternacka",17],[]]}}, - {trace,Self,exception_from,{erlang,error,2}, - {error,["palsternacka",17]}}], - exception_from, {error,["palsternacka",17]}), - ?line deep_exception(?LINE, apply, - [fun () -> erlang:throw(Self) end, []], 2, - [{trace,Self,call,{erlang,throw,[Self]}}, - {trace,Self,exception_from,{erlang,throw,1}, - {throw,Self}}], - exception_from, {throw,Self}), - ?line deep_exception(?LINE, apply, - [fun () -> - erlang:exit({1,2,3,4,[5,palsternacka]}) - end, []], 3, - [{trace,Self,call, - {erlang,exit,[{1,2,3,4,[5,palsternacka]}]}}, - {trace,Self,exception_from,{erlang,exit,1}, - {exit,{1,2,3,4,[5,palsternacka]}}}], - exception_from, {exit,{1,2,3,4,[5,palsternacka]}}), - ?line deep_exception(?LINE, apply, - [fun () -> ?MODULE:id(bladsallad) end, []], 4, - [{trace,Self,call,{?MODULE,id,[bladsallad]}}, - {trace,Self,return_from,{?MODULE,id,1},bladsallad}], - return_from, bladsallad), - ?line deep_exception(?LINE, apply, - [fun (A, B) -> A ++ B end, [1,2]], 5, - [{trace,Self,call,{erlang,'++',[1,2]}}, - {trace,Self,exception_from, - {erlang,'++',2},{error,badarg}}], - exception_from, {error,badarg}), - ?line deep_exception(?LINE, apply, [fun (A, B) -> A = B end, [1,2]], 6, - [], - exception_from, {error,{badmatch,2}}), - ?line io:format("== Subtest: ~w", [?LINE]), - ?line try apply(fun() -> lists:reverse(LongImproperList, []) end, []) of - R3 -> test_server:fail({returned,abbr(R3)}) - catch error:badarg -> ok - end, - ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) - when is_list(L1), is_list(L2), S == Self -> - next; - ({trace,S,exception_from, - {lists,reverse,2},{error,badarg}}) - when S == Self -> - expected; - ('_') -> - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}; - (_) -> - {unexpected, - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}} - end), - ?line deep_exception(?LINE, apply, - [fun () -> ?MODULE:deep_5(1,2) end, []], 7, - [{trace,Self,call,{erlang,error,[undef]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,undef}}], - exception_from, {error,undef}), - ?line deep_exception(?LINE, apply, - [fun () -> ?MODULE:deep_5(undef) end, []], 8, - [{trace,Self,call,{?MODULE,deep_5,[undef]}}, - {trace,Self,exception_from,{?MODULE,deep_5,1}, - {error,function_clause}}], - exception_from, {error,function_clause}), - - ?line trace_func({?MODULE,'_','_'}, false), - ?line trace_func({erlang,'_','_'}, false), - ?line trace_func({lists,'_','_'}, false), - ?line expect(), - ?line ok. + deep_exception(?LINE, apply, + [fun () -> + erlang:error([{"palsternacka",3.14},17]) + end, []], 1, + [{trace,Self,call, + {erlang,error,[[{"palsternacka",3.14},17]]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,[{"palsternacka",3.14},17]}}], + exception_from, {error,[{"palsternacka",3.14},17]}), + deep_exception(?LINE, apply, + [fun () -> + erlang:error(["palsternacka",17], []) + end, []], 1, + [{trace,Self,call, + {erlang,error,[["palsternacka",17],[]]}}, + {trace,Self,exception_from,{erlang,error,2}, + {error,["palsternacka",17]}}], + exception_from, {error,["palsternacka",17]}), + deep_exception(?LINE, apply, + [fun () -> erlang:throw(Self) end, []], 2, + [{trace,Self,call,{erlang,throw,[Self]}}, + {trace,Self,exception_from,{erlang,throw,1}, + {throw,Self}}], + exception_from, {throw,Self}), + deep_exception(?LINE, apply, + [fun () -> + erlang:exit({1,2,3,4,[5,palsternacka]}) + end, []], 3, + [{trace,Self,call, + {erlang,exit,[{1,2,3,4,[5,palsternacka]}]}}, + {trace,Self,exception_from,{erlang,exit,1}, + {exit,{1,2,3,4,[5,palsternacka]}}}], + exception_from, {exit,{1,2,3,4,[5,palsternacka]}}), + deep_exception(?LINE, apply, + [fun () -> ?MODULE:id(bladsallad) end, []], 4, + [{trace,Self,call,{?MODULE,id,[bladsallad]}}, + {trace,Self,return_from,{?MODULE,id,1},bladsallad}], + return_from, bladsallad), + deep_exception(?LINE, apply, + [fun (A, B) -> A ++ B end, [1,2]], 5, + [{trace,Self,call,{erlang,'++',[1,2]}}, + {trace,Self,exception_from, + {erlang,'++',2},{error,badarg}}], + exception_from, {error,badarg}), + deep_exception(?LINE, apply, [fun (A, B) -> A = B end, [1,2]], 6, + [], + exception_from, {error,{badmatch,2}}), + io:format("== Subtest: ~w", [?LINE]), + try apply(fun() -> lists:reverse(LongImproperList, []) end, []) of + R3 -> ct:fail({returned,abbr(R3)}) + catch error:badarg -> ok + end, + expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + when is_list(L1), is_list(L2), S == Self -> + next; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}) + when S == Self -> + expected; + ('_') -> + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}; + (_) -> + {unexpected, + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}} + end), + deep_exception(?LINE, apply, + [fun () -> ?MODULE:deep_5(1,2) end, []], 7, + [{trace,Self,call,{erlang,error,[undef]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,undef}}], + exception_from, {error,undef}), + deep_exception(?LINE, apply, + [fun () -> ?MODULE:deep_5(undef) end, []], 8, + [{trace,Self,call,{?MODULE,deep_5,[undef]}}, + {trace,Self,exception_from,{?MODULE,deep_5,1}, + {error,function_clause}}], + exception_from, {error,function_clause}), + + trace_func({?MODULE,'_','_'}, false), + trace_func({erlang,'_','_'}, false), + trace_func({lists,'_','_'}, false), + expect(), + ok. deep_exception(Line, B, Q, N, Extra, Tag, R) -> - ?line Self = self(), - ?line io:format("== Subtest: ~w", [Line]), - ?line Result = ?MODULE:deep(N, B, Q), - ?line Result = deep_expect(Self, B, Q, N, Extra, Tag, R). + Self = self(), + io:format("== Subtest: ~w", [Line]), + Result = ?MODULE:deep(N, B, Q), + Result = deep_expect(Self, B, Q, N, Extra, Tag, R). deep_expect(Self, B, Q, N, Extra, Tag, R) -> - ?line expect({trace,Self,call,{?MODULE,deep,[N,B,Q]}}), - ?line Result = deep_expect_N(Self, B, Q, N, Extra, Tag, R), - ?line expect({trace,Self,return_from,{?MODULE,deep,3},Result}), - ?line Result. + expect({trace,Self,call,{?MODULE,deep,[N,B,Q]}}), + Result = deep_expect_N(Self, B, Q, N, Extra, Tag, R), + expect({trace,Self,return_from,{?MODULE,deep,3},Result}), + Result. deep_expect_N(Self, B, Q, N, Extra, Tag, R) -> deep_expect_N(Self, B, Q, N, Extra, Tag, R, N). deep_expect_N(Self, B, Q, N, Extra, Tag, R, J) when J > 0 -> - ?line expect({trace,Self,call,{?MODULE,deep_1,[J,B,Q]}}), - ?line deep_expect_N(Self, B, Q, N, Extra, Tag, R, J-1); + expect({trace,Self,call,{?MODULE,deep_1,[J,B,Q]}}), + deep_expect_N(Self, B, Q, N, Extra, Tag, R, J-1); deep_expect_N(Self, B, Q, N, Extra, Tag, R, 0) -> - ?line expect({trace,Self,call,{?MODULE,deep_2,[B,Q]}}), - ?line expect({trace,Self,call,{?MODULE,deep_3,[B,Q]}}), - ?line expect({trace,Self,return_from,{?MODULE,deep_3,2},{B,Q}}), - ?line expect({trace,Self,call,{?MODULE,deep_4,[{B,Q}]}}), - ?line expect({trace,Self,call,{?MODULE,id,[{B,Q}]}}), - ?line expect({trace,Self,return_from,{?MODULE,id,1},{B,Q}}), - ?line deep_expect_Extra(Self, N, Extra, Tag, R), - ?line expect({trace,Self,Tag,{?MODULE,deep_4,1},R}), - ?line expect({trace,Self,Tag,{?MODULE,deep_2,2},R}), - ?line deep_expect_N(Self, N, Tag, R). + expect({trace,Self,call,{?MODULE,deep_2,[B,Q]}}), + expect({trace,Self,call,{?MODULE,deep_3,[B,Q]}}), + expect({trace,Self,return_from,{?MODULE,deep_3,2},{B,Q}}), + expect({trace,Self,call,{?MODULE,deep_4,[{B,Q}]}}), + expect({trace,Self,call,{?MODULE,id,[{B,Q}]}}), + expect({trace,Self,return_from,{?MODULE,id,1},{B,Q}}), + deep_expect_Extra(Self, N, Extra, Tag, R), + expect({trace,Self,Tag,{?MODULE,deep_4,1},R}), + expect({trace,Self,Tag,{?MODULE,deep_2,2},R}), + deep_expect_N(Self, N, Tag, R). deep_expect_Extra(Self, N, [E|Es], Tag, R) -> - ?line expect(E), - ?line deep_expect_Extra(Self, N, Es, Tag, R); + expect(E), + deep_expect_Extra(Self, N, Es, Tag, R); deep_expect_Extra(_Self, _N, [], _Tag, _R) -> - ?line ok. + ok. deep_expect_N(Self, N, Tag, R) when N > 0 -> - ?line expect({trace,Self,Tag,{?MODULE,deep_1,3},R}), - ?line deep_expect_N(Self, N-1, Tag, R); + expect({trace,Self,Tag,{?MODULE,deep_1,3},R}), + deep_expect_N(Self, N-1, Tag, R); deep_expect_N(_Self, 0, return_from, R) -> - ?line {value,R}; + {value,R}; deep_expect_N(_Self, 0, exception_from, R) -> - ?line R. + R. -exception_nocatch(doc) -> "Test the new exception trace."; -exception_nocatch(suite) -> []; +%% Test the new exception trace. exception_nocatch(Config) when is_list(Config) -> exception_nocatch(). @@ -1081,78 +1066,76 @@ exception_nocatch() -> Deep4LocBadmatch = get_deep_4_loc({'=',[a,b]}), Prog = [{'_',[],[{exception_trace}]}], - ?line 1 = erlang:trace_pattern({?MODULE,deep_1,'_'}, Prog), - ?line 1 = erlang:trace_pattern({?MODULE,deep_2,'_'}, Prog), - ?line 1 = erlang:trace_pattern({?MODULE,deep_3,'_'}, Prog), - ?line 1 = erlang:trace_pattern({?MODULE,deep_4,'_'}, Prog), - ?line 1 = erlang:trace_pattern({?MODULE,deep_5,'_'}, Prog), - ?line 1 = erlang:trace_pattern({?MODULE,id,'_'}, Prog), - ?line 1 = erlang:trace_pattern({erlang,exit,1}, Prog), - ?line 1 = erlang:trace_pattern({erlang,throw,1}, Prog), - ?line 2 = erlang:trace_pattern({erlang,error,'_'}, Prog), - ?line Q1 = {make_ref(),Prog}, - ?line T1 = - exception_nocatch(?LINE, exit, [Q1], 3, - [{trace,t1,call,{erlang,exit,[Q1]}}, - {trace,t1,exception_from,{erlang,exit,1}, - {exit,Q1}}], - exception_from, {exit,Q1}), - ?line expect({trace,T1,exit,Q1}), - ?line Q2 = {cake,14.125}, - ?line T2 = - exception_nocatch(?LINE, throw, [Q2], 2, - [{trace,t2,call,{erlang,throw,[Q2]}}, - {trace,t2,exception_from,{erlang,throw,1}, - {error,{nocatch,Q2}}}], - exception_from, {error,{nocatch,Q2}}), - ?line expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]}, - {?MODULE,deep_4,1, - Deep4LocThrow}]}}), - ?line Q3 = {dump,[dump,{dump}]}, - ?line T3 = - exception_nocatch(?LINE, error, [Q3], 4, - [{trace,t3,call,{erlang,error,[Q3]}}, - {trace,t3,exception_from,{erlang,error,1}, - {error,Q3}}], - exception_from, {error,Q3}), - ?line expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]}, - {?MODULE,deep_4,1,Deep4LocError}]}}), - ?line T4 = - exception_nocatch(?LINE, '=', [17,4711], 5, [], - exception_from, {error,{badmatch,4711}}), - ?line expect({trace,T4,exit,{{badmatch,4711}, - [{?MODULE,deep_4,1,Deep4LocBadmatch}]}}), + 1 = erlang:trace_pattern({?MODULE,deep_1,'_'}, Prog), + 1 = erlang:trace_pattern({?MODULE,deep_2,'_'}, Prog), + 1 = erlang:trace_pattern({?MODULE,deep_3,'_'}, Prog), + 1 = erlang:trace_pattern({?MODULE,deep_4,'_'}, Prog), + 1 = erlang:trace_pattern({?MODULE,deep_5,'_'}, Prog), + 1 = erlang:trace_pattern({?MODULE,id,'_'}, Prog), + 1 = erlang:trace_pattern({erlang,exit,1}, Prog), + 1 = erlang:trace_pattern({erlang,throw,1}, Prog), + 2 = erlang:trace_pattern({erlang,error,'_'}, Prog), + Q1 = {make_ref(),Prog}, + T1 = + exception_nocatch(?LINE, exit, [Q1], 3, + [{trace,t1,call,{erlang,exit,[Q1]}}, + {trace,t1,exception_from,{erlang,exit,1}, + {exit,Q1}}], + exception_from, {exit,Q1}), + expect({trace,T1,exit,Q1}), + Q2 = {cake,14.125}, + T2 = + exception_nocatch(?LINE, throw, [Q2], 2, + [{trace,t2,call,{erlang,throw,[Q2]}}, + {trace,t2,exception_from,{erlang,throw,1}, + {error,{nocatch,Q2}}}], + exception_from, {error,{nocatch,Q2}}), + expect({trace,T2,exit,{{nocatch,Q2},[{?MODULE,deep_4,1, + Deep4LocThrow}]}}), + Q3 = {dump,[dump,{dump}]}, + T3 = + exception_nocatch(?LINE, error, [Q3], 4, + [{trace,t3,call,{erlang,error,[Q3]}}, + {trace,t3,exception_from,{erlang,error,1}, + {error,Q3}}], + exception_from, {error,Q3}), + expect({trace,T3,exit,{Q3,[{?MODULE,deep_4,1,Deep4LocError}]}}), + T4 = + exception_nocatch(?LINE, '=', [17,4711], 5, [], + exception_from, {error,{badmatch,4711}}), + expect({trace,T4,exit,{{badmatch,4711}, + [{?MODULE,deep_4,1,Deep4LocBadmatch}]}}), %% - ?line erlang:trace_pattern({?MODULE,'_','_'}, false), - ?line erlang:trace_pattern({erlang,'_','_'}, false), - ?line expect(), - ?line ok. + erlang:trace_pattern({?MODULE,'_','_'}, false), + erlang:trace_pattern({erlang,'_','_'}, false), + expect(), + ok. get_deep_4_loc(Arg) -> try - deep_4(Arg), - ?t:fail(should_not_return_to_here) + deep_4(Arg), + ct:fail(should_not_return_to_here) catch - _:_ -> - [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(), - Loc0 + _:_ -> + [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(), + Loc0 end. exception_nocatch(Line, B, Q, N, Extra, Tag, R) -> - ?line io:format("== Subtest: ~w", [Line]), - ?line Go = make_ref(), - ?line Tracee = - spawn(fun () -> - receive - Go -> - deep_1(N, B, Q) - end - end), - ?line 1 = erlang:trace(Tracee, true, [call,return_to,procs]), - ?line Tracee ! Go, - ?line deep_expect_N(Tracee, B, Q, N-1, - [setelement(2, T, Tracee) || T <- Extra], Tag, R), - ?line Tracee. + io:format("== Subtest: ~w", [Line]), + Go = make_ref(), + Tracee = + spawn(fun () -> + receive + Go -> + deep_1(N, B, Q) + end + end), + 1 = erlang:trace(Tracee, true, [call,return_to,procs]), + Tracee ! Go, + deep_expect_N(Tracee, B, Q, N-1, + [setelement(2, T, Tracee) || T <- Extra], Tag, R), + Tracee. %% Make sure that code that uses the optimized bit syntax matching %% can be traced without crashing the emulator. (Actually, it seems @@ -1160,22 +1143,22 @@ exception_nocatch(Line, B, Q, N, Extra, Tag, R) -> %% will keep the test case anyway.) bit_syntax(Config) when is_list(Config) -> - ?line start_tracer(), - ?line 1 = trace_func({?MODULE,bs_sum_a,'_'}, []), - ?line 1 = trace_func({?MODULE,bs_sum_b,'_'}, []), + start_tracer(), + 1 = trace_func({?MODULE,bs_sum_a,'_'}, []), + 1 = trace_func({?MODULE,bs_sum_b,'_'}, []), - ?line 6 = call_bs_sum_a(<<1,2,3>>), - ?line 10 = call_bs_sum_b(<<1,2,3,4>>), + 6 = call_bs_sum_a(<<1,2,3>>), + 10 = call_bs_sum_b(<<1,2,3,4>>), - ?line trace_func({?MODULE,'_','_'}, false), - ?line erlang:trace_delivered(all), + trace_func({?MODULE,'_','_'}, false), + erlang:trace_delivered(all), receive - {trace_delivered,_,_} -> ok + {trace_delivered,_,_} -> ok end, - + Self = self(), - ?line expect({trace,Self,call,{?MODULE,bs_sum_a,[<<2,3>>,1]}}), - ?line expect({trace,Self,call,{?MODULE,bs_sum_b,[1,<<2,3,4>>]}}), + expect({trace,Self,call,{?MODULE,bs_sum_a,[<<2,3>>,1]}}), + expect({trace,Self,call,{?MODULE,bs_sum_b,[1,<<2,3,4>>]}}), ok. @@ -1190,7 +1173,7 @@ bs_sum_a(<<>>, Acc) -> Acc. bs_sum_b(Acc, <<H,T/binary>>) -> bs_sum_b(H+Acc, T); bs_sum_b(Acc, <<>>) -> Acc. - + @@ -1198,98 +1181,98 @@ bs_sum_b(Acc, <<>>) -> Acc. expect() -> case flush() of - [] -> ok; - Msgs -> - test_server:fail({unexpected,abbr(Msgs)}) + [] -> ok; + Msgs -> + ct:fail({unexpected,abbr(Msgs)}) end. expect({trace_ts,Pid,Type,MFA,Term,ts}=Message) -> receive - M -> - case M of - {trace_ts,Pid,Type,MFA,Term,Ts}=MessageTs -> - ok = io:format("Expected and got ~p", [abbr(MessageTs)]), - Ts; - _ -> - io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), - test_server:fail({unexpected,abbr([M|flush()])}) - end + M -> + case M of + {trace_ts,Pid,Type,MFA,Term,Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [abbr(MessageTs)]), + Ts; + _ -> + io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), + ct:fail({unexpected,abbr([M|flush()])}) + end after 5000 -> - io:format("Expected ~p; got nothing", [abbr(Message)]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [abbr(Message)]), + ct:fail(no_trace_message) end; expect({trace_ts,Pid,Type,MFA,ts}=Message) -> receive - M -> - case M of - {trace_ts,Pid,Type,MFA,Ts} -> - ok = io:format("Expected and got ~p", [abbr(M)]), - Ts; - _ -> - io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), - test_server:fail({unexpected,abbr([M|flush()])}) - end + M -> + case M of + {trace_ts,Pid,Type,MFA,Ts} -> + ok = io:format("Expected and got ~p", [abbr(M)]), + Ts; + _ -> + io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), + ct:fail({unexpected,abbr([M|flush()])}) + end after 5000 -> - io:format("Expected ~p; got nothing", [abbr(Message)]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [abbr(Message)]), + ct:fail(no_trace_message) end; expect(Validator) when is_function(Validator) -> receive - M -> - case Validator(M) of - expected -> - ok = io:format("Expected and got ~p", [abbr(M)]); - next -> - ok = io:format("Expected and got ~p", [abbr(M)]), - expect(Validator); - {unexpected,Message} -> - io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), - test_server:fail({unexpected,abbr([M|flush()])}) - end + M -> + case Validator(M) of + expected -> + ok = io:format("Expected and got ~p", [abbr(M)]); + next -> + ok = io:format("Expected and got ~p", [abbr(M)]), + expect(Validator); + {unexpected,Message} -> + io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), + ct:fail({unexpected,abbr([M|flush()])}) + end after 5000 -> - io:format("Expected ~p; got nothing", [abbr(Validator('_'))]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [abbr(Validator('_'))]), + ct:fail(no_trace_message) end; expect(Message) -> receive - M -> - case M of - Message -> - ok = io:format("Expected and got ~p", [abbr(Message)]); - Other -> - io:format("Expected ~p; got ~p", - [abbr(Message),abbr(Other)]), - test_server:fail({unexpected,abbr([Other|flush()])}) - end + M -> + case M of + Message -> + ok = io:format("Expected and got ~p", [abbr(Message)]); + Other -> + io:format("Expected ~p; got ~p", + [abbr(Message),abbr(Other)]), + ct:fail({unexpected,abbr([Other|flush()])}) + end after 5000 -> - io:format("Expected ~p; got nothing", [abbr(Message)]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [abbr(Message)]), + ct:fail(no_trace_message) end. trace_info(What, Key) -> get(tracer) ! {apply,self(),{erlang,trace_info,[What,Key]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace_info(~p, ~p) -> ~p", - [What,Key,Res]), + [What,Key,Res]), Res. - + trace_func(MFA, MatchSpec) -> trace_func(MFA, MatchSpec, []). trace_func(MFA, MatchSpec, Flags) -> get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA, MatchSpec, Flags]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("trace_pattern(~p, ~p, ~p) -> ~p", [MFA,MatchSpec,Flags,Res]), Res. trace_pid(Pid, On, Flags) -> get(tracer) ! {apply,self(),{erlang,trace,[Pid,On,Flags]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("trace(~p, ~p, ~p) -> ~p", [Pid,On,Flags,Res]), Res. @@ -1309,19 +1292,19 @@ tracer(RelayTo) -> tracer_loop(RelayTo) -> receive - {apply,From,{M,F,A}} -> - From ! {apply_result,apply(M, F, A)}, - tracer_loop(RelayTo); - Msg -> - RelayTo ! Msg, - tracer_loop(RelayTo) + {apply,From,{M,F,A}} -> + From ! {apply_result,apply(M, F, A)}, + tracer_loop(RelayTo); + Msg -> + RelayTo ! Msg, + tracer_loop(RelayTo) end. id(I) -> I. deep(N, Class, Reason) -> try ?MODULE:deep_1(N, Class, Reason) of - Value -> {value,Value} + Value -> {value,Value} catch C:R -> {C,R} end. @@ -1338,30 +1321,30 @@ deep_3(Class, Reason) -> deep_4(CR) -> case ?MODULE:id(CR) of - {exit,[Reason]} -> - erlang:exit(Reason); - {throw,[Reason]} -> - erlang:throw(Reason); - {error,[Reason,Arglist]} -> - erlang:error(Reason, Arglist); - {error,[Reason]} -> - erlang:error(Reason); - {id,[Reason]} -> - Reason; - {reverse,[A,B]} -> - lists:reverse(A, B); - {append,[A,B]} -> - A ++ B; - {apply,[Fun,Args]} -> - erlang:apply(Fun, Args); - {apply,[M,F,Args]} -> - erlang:apply(M, F, Args); - {deep_5,[A,B]} -> - ?MODULE:deep_5(A, B); - {deep_5,[A]} -> - ?MODULE:deep_5(A); - {'=',[A,B]} -> - A = B + {exit,[Reason]} -> + erlang:exit(Reason); + {throw,[Reason]} -> + erlang:throw(Reason); + {error,[Reason,Arglist]} -> + erlang:error(Reason, Arglist); + {error,[Reason]} -> + erlang:error(Reason); + {id,[Reason]} -> + Reason; + {reverse,[A,B]} -> + lists:reverse(A, B); + {append,[A,B]} -> + A ++ B; + {apply,[Fun,Args]} -> + erlang:apply(Fun, Args); + {apply,[M,F,Args]} -> + erlang:apply(M, F, Args); + {deep_5,[A,B]} -> + ?MODULE:deep_5(A, B); + {deep_5,[A]} -> + ?MODULE:deep_5(A); + {'=',[A,B]} -> + A = B end. deep_5(A) when is_integer(A) -> @@ -1369,9 +1352,9 @@ deep_5(A) when is_integer(A) -> flush() -> receive X -> - [X|flush()] + [X|flush()] after 1000 -> - [] + [] end. %% Abbreviate large complex terms @@ -1394,10 +1377,10 @@ abbr_tuple(_, _, _, R) -> %% abbr_list(_, 0, R) -> case io_lib:printable_list(R) of - true -> - reverse(R, "..."); - false -> - reverse(R, '...') + true -> + reverse(R, "..."); + false -> + reverse(R, '...') end; abbr_list([H|T], N, R) -> M = N-1, diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index b0408cabe1..77321aa50f 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -1,46 +1,45 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(code_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - versions/1,new_binary_types/1, - t_check_process_code/1,t_check_old_code/1, - t_check_process_code_ets/1, - external_fun/1,get_chunk/1,module_md5/1,make_stub/1, - make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1, - false_dependency/1,coverage/1,fun_confusion/1]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1, + versions/1,new_binary_types/1, call_purged_fun_code_gone/1, + call_purged_fun_code_reload/1, call_purged_fun_code_there/1, + multi_proc_purge/1, t_check_old_code/1, + external_fun/1,get_chunk/1,module_md5/1, + constant_pools/1,constant_refc_binaries/1, + false_dependency/1,coverage/1,fun_confusion/1, + t_copy_literals/1, t_copy_literals_frags/1]). -define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [versions, new_binary_types, t_check_process_code, - t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, - module_md5, make_stub, make_stub_many_funs, + [versions, new_binary_types, call_purged_fun_code_gone, + call_purged_fun_code_reload, call_purged_fun_code_there, + multi_proc_purge, t_check_old_code, external_fun, get_chunk, + module_md5, constant_pools, constant_refc_binaries, false_dependency, - coverage, fun_confusion]. - -groups() -> - []. + coverage, fun_confusion, t_copy_literals, t_copy_literals_frags]. init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), @@ -50,12 +49,6 @@ end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false), ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %% Make sure that only two versions of a module can be loaded. versions(Config) when is_list(Config) -> V1 = compile_version(1, Config), @@ -72,14 +65,14 @@ versions(Config) when is_list(Config) -> 2 = versions:version(), %% Kill processes, unload code. - P1 ! P2 ! done, _ = monitor(process, P1), _ = monitor(process, P2), + P1 ! P2 ! done, receive - {'DOWN',_,process,P1,normal} -> ok + {'DOWN',_,process,P1,normal} -> ok end, receive - {'DOWN',_,process,P2,normal} -> ok + {'DOWN',_,process,P2,normal} -> ok end, true = erlang:purge_module(versions), true = erlang:delete_module(versions), @@ -87,409 +80,318 @@ versions(Config) when is_list(Config) -> ok. compile_version(Version, Config) -> - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), File = filename:join(Data, "versions"), {ok,versions,Bin} = compile:file(File, [{d,'VERSION',Version}, - binary,report]), + binary,report]), Bin. load_version(Code, Ver) -> case erlang:load_module(versions, Code) of - {module,versions} -> - Pid = spawn_link(versions, loop, []), - Ver = versions:version(), - Ver = check_version(Pid), - {ok,Pid,Ver}; - Error -> - Error + {module,versions} -> + Pid = spawn_link(versions, loop, []), + Ver = versions:version(), + Ver = check_version(Pid), + {ok,Pid,Ver}; + Error -> + Error end. check_version(Pid) -> Pid ! {self(),version}, receive - {Pid,version,Version} -> - Version + {Pid,version,Version} -> + Version end. new_binary_types(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Bin} = compile:file(File, [binary]), - ?line {module,my_code_test} = erlang:load_module(my_code_test, - make_sub_binary(Bin)), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), - - ?line {module,my_code_test} = erlang:load_module(my_code_test, - make_unaligned_sub_binary(Bin)), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Bin} = compile:file(File, [binary]), + {module,my_code_test} = erlang:load_module(my_code_test, + make_sub_binary(Bin)), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), + + {module,my_code_test} = erlang:load_module(my_code_test, + make_unaligned_sub_binary(Bin)), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), %% Try heap binaries and bad binaries. - ?line {error,badfile} = erlang:load_module(my_code_test, <<1,2>>), - ?line {error,badfile} = erlang:load_module(my_code_test, - make_sub_binary(<<1,2>>)), - ?line {error,badfile} = erlang:load_module(my_code_test, - make_unaligned_sub_binary(<<1,2>>)), - ?line {'EXIT',{badarg,_}} = (catch erlang:load_module(my_code_test, - bit_sized_binary(Bin))), + {error,badfile} = erlang:load_module(my_code_test, <<1,2>>), + {error,badfile} = erlang:load_module(my_code_test, + make_sub_binary(<<1,2>>)), + {error,badfile} = erlang:load_module(my_code_test, + make_unaligned_sub_binary(<<1,2>>)), + {'EXIT',{badarg,_}} = (catch erlang:load_module(my_code_test, + bit_sized_binary(Bin))), ok. -t_check_process_code(Config) when is_list(Config) -> - ?line Priv = ?config(priv_dir, Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line Code = filename:join(Priv, "my_code_test"), - - ?line {ok,my_code_test} = c:c(File, [{outdir,Priv}]), - - ?line MyFun = fun(X, Y) -> X + Y end, %Confuse things. - ?line F = my_code_test:make_fun(42), - ?line 2 = fun_refc(F), - ?line MyFun2 = fun(X, Y) -> X * Y end, %Confuse things. - ?line 44 = F(2), - - %% Delete the module and call the fun again. - ?line true = erlang:delete_module(my_code_test), - ?line 2 = fun_refc(F), - ?line 45 = F(3), - ?line {'EXIT',{undef,_}} = (catch my_code_test:make_fun(33)), - - %% The fun should still be there, preventing purge. - ?line true = erlang:check_process_code(self(), my_code_test), - gc(), - gc(), %Place funs on the old heap. - ?line true = erlang:check_process_code(self(), my_code_test), - - %% Using the funs here guarantees that they will not be prematurely garbed. - ?line 48 = F(6), - ?line 3 = MyFun(1, 2), - ?line 12 = MyFun2(3, 4), - - %% Kill all funs. - t_check_process_code1(Code, []). - -%% The real fun was killed, but we have some fakes which look similar. - -t_check_process_code1(Code, Fakes) -> - ?line MyFun = fun(X, Y) -> X + Y + 1 end, %Confuse things. - ?line false = erlang:check_process_code(self(), my_code_test), - ?line 4 = MyFun(1, 2), - t_check_process_code2(Code, Fakes). - -t_check_process_code2(Code, _) -> - ?line false = erlang:check_process_code(self(), my_code_test), - ?line true = erlang:purge_module(my_code_test), - - %% In the next test we will load the same module twice. - ?line {module,my_code_test} = code:load_abs(Code), - ?line F = my_code_test:make_fun(37), - ?line 2 = fun_refc(F), - ?line false = erlang:check_process_code(self(), my_code_test), - ?line {module,my_code_test} = code:load_abs(Code), - ?line 2 = fun_refc(F), - - %% Still false because the fun with the same identify is found - %% in the current code. - ?line false = erlang:check_process_code(self(), my_code_test), - - %% Some fake funs in the same module should not do any difference. - ?line false = erlang:check_process_code(self(), my_code_test), - - 38 = F(1), - t_check_process_code3(Code, F, []). - -t_check_process_code3(Code, F, Fakes) -> - Pid = spawn_link(fun() -> body(F, Fakes) end), - ?line true = erlang:purge_module(my_code_test), - ?line false = erlang:check_process_code(self(), my_code_test), - ?line false = erlang:check_process_code(Pid, my_code_test), - - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:check_process_code(self(), my_code_test), - ?line true = erlang:check_process_code(Pid, my_code_test), - 39 = F(2), - t_check_process_code4(Code, Pid). - -t_check_process_code4(_Code, Pid) -> - Pid ! drop_funs, - receive after 1 -> ok end, - ?line false = erlang:check_process_code(Pid, my_code_test), +call_purged_fun_code_gone(Config) when is_list(Config) -> + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + call_purged_fun_test(Priv, Data, code_gone), ok. -body(F, Fakes) -> - receive - jog -> - 40 = F(3), - erlang:garbage_collect(), - body(F, Fakes); - drop_funs -> - dropped_body() - end. +call_purged_fun_code_reload(Config) when is_list(Config) -> + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + Path = code:get_path(), + true = code:add_path(Priv), + try + call_purged_fun_test(Priv, Data, code_reload) + after + code:set_path(Path) + end, + ok. -dropped_body() -> - receive - X -> exit(X) - end. +call_purged_fun_code_there(Config) when is_list(Config) -> + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + call_purged_fun_test(Priv, Data, code_there), + ok. -gc() -> - erlang:garbage_collect(), - gc1(). -gc1() -> ok. - -t_check_process_code_ets(doc) -> - "Test check_process_code/2 in combination with a fun obtained from an ets table."; -t_check_process_code_ets(Config) when is_list(Config) -> - case test_server:is_native(?MODULE) of - true -> - {skip,"Native code"}; - false -> - do_check_process_code_ets(Config) - end. +call_purged_fun_test(Priv, Data, Type) -> + OptsList = case erlang:system_info(hipe_architecture) of + undefined -> [[]]; + _ -> [[], [native,{d,hipe}]] + end, + [call_purged_fun_test_do(Priv, Data, Type, CO, FO) + || CO <- OptsList, FO <- OptsList]. + + +call_purged_fun_test_do(Priv, Data, Type, CallerOpts, FunOpts) -> + io:format("Compile caller as ~p and funs as ~p\n", [CallerOpts, FunOpts]), + SrcFile = filename:join(Data, "call_purged_fun_tester.erl"), + ObjFile = filename:join(Priv, "call_purged_fun_tester.beam"), + {ok,Mod,Code} = compile:file(SrcFile, [binary, report | CallerOpts]), + {module,Mod} = code:load_binary(Mod, ObjFile, Code), + + call_purged_fun_tester:do(Priv, Data, Type, FunOpts). + + +multi_proc_purge(Config) when is_list(Config) -> + %% + %% Make sure purge requests aren't lost when + %% purger process is working. + %% + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + File1 = filename:join(Data, "my_code_test"), + File2 = filename:join(Data, "my_code_test2"), + + {ok,my_code_test} = c:c(File1, [{outdir,Priv}]), + {ok,my_code_test2} = c:c(File2, [{outdir,Priv}]), + erlang:delete_module(my_code_test), + erlang:delete_module(my_code_test2), -do_check_process_code_ets(Config) -> - ?line Priv = ?config(priv_dir, Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - - ?line erlang:purge_module(my_code_test), - ?line erlang:delete_module(my_code_test), - ?line {ok,my_code_test} = c:c(File, [{outdir,Priv}]), - - ?line T = ets:new(my_code_test, []), - ?line ets:insert(T, {7,my_code_test:make_fun(107)}), - ?line ets:insert(T, {8,my_code_test:make_fun(108)}), - ?line erlang:delete_module(my_code_test), - ?line false = erlang:check_process_code(self(), my_code_test), - Body = fun() -> - [{7,F1}] = ets:lookup(T, 7), - [{8,F2}] = ets:lookup(T, 8), - IdleLoop = fun() -> receive _X -> ok end end, - RecLoop = fun(Again) -> - receive - call -> 110 = F1(3), - 100 = F2(-8), - Again(Again); - {drop_funs,To} -> - To ! funs_dropped, - IdleLoop() - end - end, - true = erlang:check_process_code(self(), my_code_test), - RecLoop(RecLoop) - end, - ?line Pid = spawn_link(Body), - receive after 1 -> ok end, - ?line true = erlang:check_process_code(Pid, my_code_test), - Pid ! call, - Pid ! {drop_funs,self()}, + Self = self(), - receive - funs_dropped -> ok; - Other -> ?t:fail({unexpected,Other}) - after 10000 -> - ?line ?t:fail(no_funs_dropped_answer) - end, + Fun1 = fun () -> + erts_code_purger:purge(my_code_test), + Self ! {self(), done} + end, + Fun2 = fun () -> + erts_code_purger:soft_purge(my_code_test2), + Self ! {self(), done} + end, + Fun3 = fun () -> + erts_code_purger:purge('__nonexisting_module__'), + Self ! {self(), done} + end, + Fun4 = fun () -> + erts_code_purger:soft_purge('__another_nonexisting_module__'), + Self ! {self(), done} + end, - ?line false = erlang:check_process_code(Pid, my_code_test), + Pid1 = spawn_link(Fun1), + Pid2 = spawn_link(Fun2), + Pid3 = spawn_link(Fun3), + Pid4 = spawn_link(Fun4), + Pid5 = spawn_link(Fun1), + Pid6 = spawn_link(Fun2), + Pid7 = spawn_link(Fun3), + receive after 50 -> ok end, + Pid8 = spawn_link(Fun4), + Pid9 = spawn_link(Fun1), + Pid10 = spawn_link(Fun2), + Pid11 = spawn_link(Fun3), + Pid12 = spawn_link(Fun4), + Pid13 = spawn_link(Fun1), + receive after 50 -> ok end, + Pid14 = spawn_link(Fun2), + Pid15 = spawn_link(Fun3), + Pid16 = spawn_link(Fun4), + + lists:foreach(fun (P) -> receive {P, done} -> ok end end, + [Pid1, Pid2, Pid3, Pid4, Pid5, Pid6, Pid7, Pid8, + Pid9, Pid10, Pid11, Pid12, Pid13, Pid14, Pid15, Pid16]), ok. -fun_refc(F) -> - {refc,Count} = erlang:fun_info(F, refc), - Count. - - %% Test the erlang:check_old_code/1 BIF. t_check_old_code(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), - ?line erlang:purge_module(my_code_test), - ?line erlang:delete_module(my_code_test), - ?line catch erlang:purge_module(my_code_test), + catch erlang:purge_module(my_code_test), + catch erlang:delete_module(my_code_test), + catch erlang:purge_module(my_code_test), - ?line false = erlang:check_old_code(my_code_test), + false = erlang:check_old_code(my_code_test), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), - ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code), - - ?line false = erlang:check_old_code(my_code_test), - ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code), - ?line true = erlang:check_old_code(my_code_test), + {ok,my_code_test,Code} = compile:file(File, [binary]), + {module,my_code_test} = code:load_binary(my_code_test, File, Code), - ?line true = erlang:purge_module(my_code_test), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), + false = erlang:check_old_code(my_code_test), + {module,my_code_test} = code:load_binary(my_code_test, File, Code), + true = erlang:check_old_code(my_code_test), + + true = erlang:purge_module(my_code_test), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), + + {'EXIT',_} = (catch erlang:check_old_code([])), - ?line {'EXIT',_} = (catch erlang:check_old_code([])), - ok. external_fun(Config) when is_list(Config) -> - ?line false = erlang:function_exported(another_code_test, x, 1), + false = erlang:function_exported(another_code_test, x, 1), AnotherCodeTest = id(another_code_test), ExtFun = fun AnotherCodeTest:x/1, - ?line {'EXIT',{undef,_}} = (catch ExtFun(answer)), - ?line false = erlang:function_exported(another_code_test, x, 1), - ?line false = lists:member(another_code_test, erlang:loaded()), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "another_code_test"), - ?line {ok,another_code_test,Code} = compile:file(File, [binary,report]), - ?line {module,another_code_test} = erlang:load_module(another_code_test, Code), - ?line 42 = ExtFun(answer), + {'EXIT',{undef,_}} = (catch ExtFun(answer)), + false = erlang:function_exported(another_code_test, x, 1), + false = lists:member(another_code_test, erlang:loaded()), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "another_code_test"), + {ok,another_code_test,Code} = compile:file(File, [binary,report]), + {module,another_code_test} = erlang:load_module(another_code_test, Code), + 42 = ExtFun(answer), ok. get_chunk(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Code} = compile:file(File, [binary]), %% Should work. - ?line Chunk = get_chunk_ok("Atom", Code), - ?line Chunk = get_chunk_ok("Atom", make_sub_binary(Code)), - ?line Chunk = get_chunk_ok("Atom", make_unaligned_sub_binary(Code)), + Chunk = get_chunk_ok("AtU8", Code), + Chunk = get_chunk_ok("AtU8", make_sub_binary(Code)), + Chunk = get_chunk_ok("AtU8", make_unaligned_sub_binary(Code)), %% Should fail. - ?line {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "Atom")), - ?line {'EXIT',{badarg,_}} = (catch code:get_chunk(Code, "bad chunk id")), + {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "AtU8")), + {'EXIT',{badarg,_}} = (catch code:get_chunk(Code, "bad chunk id")), %% Invalid beam code or missing chunk should return 'undefined'. - ?line undefined = code:get_chunk(<<"not a beam module">>, "Atom"), - ?line undefined = code:get_chunk(Code, "XXXX"), + undefined = code:get_chunk(<<"not a beam module">>, "AtU8"), + undefined = code:get_chunk(Code, "XXXX"), ok. get_chunk_ok(Chunk, Code) -> case code:get_chunk(Code, Chunk) of - Bin when is_binary(Bin) -> Bin + Bin when is_binary(Bin) -> Bin end. module_md5(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Code} = compile:file(File, [binary]), %% Should work. - ?line Chunk = module_md5_ok(Code), - ?line Chunk = module_md5_ok(make_sub_binary(Code)), - ?line Chunk = module_md5_ok(make_unaligned_sub_binary(Code)), + Chunk = module_md5_ok(Code), + Chunk = module_md5_ok(make_sub_binary(Code)), + Chunk = module_md5_ok(make_unaligned_sub_binary(Code)), %% Should fail. - ?line {'EXIT',{badarg,_}} = (catch code:module_md5(bit_sized_binary(Code))), + {'EXIT',{badarg,_}} = (catch code:module_md5(bit_sized_binary(Code))), %% Invalid beam code should return 'undefined'. - ?line undefined = code:module_md5(<<"not a beam module">>), + undefined = code:module_md5(<<"not a beam module">>), ok. - + module_md5_ok(Code) -> case code:module_md5(Code) of - Bin when is_binary(Bin), size(Bin) =:= 16 -> Bin + Bin when is_binary(Bin), size(Bin) =:= 16 -> Bin end. -make_stub(Config) when is_list(Config) -> - catch erlang:purge_module(my_code_test), - - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), - - ?line my_code_test = code:make_stub_module(my_code_test, Code, {[],[]}), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), - - ?line my_code_test = code:make_stub_module(my_code_test, - make_unaligned_sub_binary(Code), - {[],[]}), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), - - ?line my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code), - {[],[]}), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), - - %% Should fail. - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[]})), - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(my_code_test, - bit_sized_binary(Code), - {[],[]})), - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(my_code_test_with_wrong_name, - Code, {[],[]})), - ok. - -make_stub_many_funs(Config) when is_list(Config) -> - catch erlang:purge_module(many_funs), - - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "many_funs"), - ?line {ok,many_funs,Code} = compile:file(File, [binary]), - - ?line many_funs = code:make_stub_module(many_funs, Code, {[],[]}), - ?line true = erlang:delete_module(many_funs), - ?line true = erlang:purge_module(many_funs), - ?line many_funs = code:make_stub_module(many_funs, - make_unaligned_sub_binary(Code), - {[],[]}), - ?line true = erlang:delete_module(many_funs), - ?line true = erlang:purge_module(many_funs), - - %% Should fail. - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(many_funs, <<"bad">>, {[],[]})), - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(many_funs, - bit_sized_binary(Code), - {[],[]})), - ok. - constant_pools(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "literals"), - ?line {ok,literals,Code} = compile:file(File, [report,binary]), - ?line {module,literals} = erlang:load_module(literals, - make_sub_binary(Code)), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "literals"), + {ok,literals,Code} = compile:file(File, [report,binary]), + {module,literals} = erlang:load_module(literals, + make_sub_binary(Code)), %% Initialize. - ?line A = literals:a(), - ?line B = literals:b(), - ?line C = literals:huge_bignum(), - ?line process_flag(trap_exit, true), + A = literals:a(), + B = literals:b(), + C = literals:huge_bignum(), + process_flag(trap_exit, true), Self = self(), %% Have a process WITHOUT old heap that references the literals %% in the 'literals' module. - ?line NoOldHeap = spawn_link(fun() -> no_old_heap(Self) end), + NoOldHeap = spawn_link(fun() -> no_old_heap(Self) end), receive go -> ok end, - ?line true = erlang:delete_module(literals), - ?line false = erlang:check_process_code(NoOldHeap, literals), - ?line erlang:check_process_code(self(), literals), - ?line true = erlang:purge_module(literals), - ?line NoOldHeap ! done, - ?line receive - {'EXIT',NoOldHeap,{A,B,C}} -> - ok; - Other -> - ?line ?t:fail({unexpected,Other}) - end, - ?line {module,literals} = erlang:load_module(literals, Code), + true = erlang:delete_module(literals), + false = erlang:check_process_code(NoOldHeap, literals), + erlang:check_process_code(self(), literals), + true = erlang:purge_module(literals), + NoOldHeap ! done, + receive + {'EXIT',NoOldHeap,{A,B,C}} -> + ok; + Other -> + ct:fail({unexpected,Other}) + end, + {module,literals} = erlang:load_module(literals, Code), %% Have a process WITH an old heap that references the literals %% in the 'literals' module. - ?line OldHeap = spawn_link(fun() -> old_heap(Self) end), + OldHeap = spawn_link(fun() -> old_heap(Self) end), receive go -> ok end, - ?line true = erlang:delete_module(literals), - ?line false = erlang:check_process_code(OldHeap, literals), - ?line erlang:check_process_code(self(), literals), - ?line erlang:purge_module(literals), - ?line OldHeap ! done, + true = erlang:delete_module(literals), + false = erlang:check_process_code(OldHeap, literals), + erlang:check_process_code(self(), literals), + erlang:purge_module(literals), + OldHeap ! done, receive {'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 -> ok - end. + end, + + {module,literals} = erlang:load_module(literals, Code), + %% Have a hibernated process that references the literals + %% in the 'literals' module. + {Hib, Mon} = spawn_monitor(fun() -> hibernated(Self) end), + receive go -> ok end, + [{heap_size,OldHeapSz}, + {total_heap_size,OldTotHeapSz}] = process_info(Hib, [heap_size, + total_heap_size]), + OldHeapSz = OldTotHeapSz, + io:format("OldHeapSz=~p OldTotHeapSz=~p~n", [OldHeapSz, OldTotHeapSz]), + true = erlang:delete_module(literals), + false = erlang:check_process_code(Hib, literals), + erlang:check_process_code(self(), literals), + erlang:purge_module(literals), + receive after 1000 -> ok end, + [{heap_size,HeapSz}, + {total_heap_size,TotHeapSz}] = process_info(Hib, [heap_size, + total_heap_size]), + io:format("HeapSz=~p TotHeapSz=~p~n", [HeapSz, TotHeapSz]), + Hib ! hej, + receive + {'DOWN', Mon, process, Hib, Reason} -> + {undef, [{no_module, + no_function, + [{A,B,C,[1,2,3|_]=Seq}], _}]} = Reason, + 16 = length(Seq) + end, + HeapSz = TotHeapSz, %% Ensure restored to hibernated state... + true = HeapSz > OldHeapSz, + ok. no_old_heap(Parent) -> A = literals:a(), @@ -497,8 +399,8 @@ no_old_heap(Parent) -> Res = {A,B,literals:huge_bignum()}, Parent ! go, receive - done -> - exit(Res) + done -> + exit(Res) end. old_heap(Parent) -> @@ -508,16 +410,23 @@ old_heap(Parent) -> create_old_heap(), Parent ! go, receive - done -> - exit(Res) + done -> + exit(Res) end. +hibernated(Parent) -> + A = literals:a(), + B = literals:b(), + Res = {A,B,literals:huge_bignum(),lists:seq(1, 16)}, + Parent ! go, + erlang:hibernate(no_module, no_function, [Res]). + create_old_heap() -> case process_info(self(), [heap_size,total_heap_size]) of - [{heap_size,Sz},{total_heap_size,Total}] when Sz < Total -> - ok; - _ -> - create_old_heap() + [{heap_size,Sz},{total_heap_size,Total}] when Sz < Total -> + ok; + _ -> + create_old_heap() end. constant_refc_binaries(Config) when is_list(Config) -> @@ -526,7 +435,7 @@ constant_refc_binaries(Config) when is_list(Config) -> io:format("Binary data (bytes) before test: ~p\n", [Bef]), %% Compile the the literals module. - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), File = filename:join(Data, "literals"), {ok,literals,Code} = compile:file(File, [report,binary]), @@ -551,29 +460,29 @@ constant_refc_binaries(Config) when is_list(Config) -> io:format("Binary data (bytes) after test: ~p", [Aft]), Diff = Aft - Bef, if - Diff < 0 -> - io:format("~p less bytes", [abs(Diff)]); - Diff > 0 -> - io:format("~p more bytes", [Diff]); - true -> - ok + Diff < 0 -> + io:format("~p less bytes", [abs(Diff)]); + Diff > 0 -> + io:format("~p more bytes", [Diff]); + true -> + ok end, %% Test for leaks. We must accept some natural variations in %% the size of allocated binaries. if - Diff > 64*1024 -> - ?t:fail(binary_leak); - true -> - ok + Diff > 64*1024 -> + ct:fail(binary_leak); + true -> + ok end. memory_binary() -> try - erlang:memory(binary) + erlang:memory(binary) catch - error:notsup -> - 0 + error:notsup -> + 0 end. provoke_mem_leak(0, _, _) -> ok; @@ -583,19 +492,19 @@ provoke_mem_leak(N, Code, Check) -> %% Create several processes with references to the literal binary. Self = self(), Pids = [spawn_link(fun() -> - create_binaries(Self, NumRefs, Check) - end) || NumRefs <- lists:seq(1, 10)], + create_binaries(Self, NumRefs, Check) + end) || NumRefs <- lists:seq(1, 10)], [receive {started,Pid} -> ok end || Pid <- Pids], %% Make the code old and remove references to the constant pool %% in all processes. true = erlang:delete_module(literals), Ms = [spawn_monitor(fun() -> - false = erlang:check_process_code(Pid, literals) - end) || Pid <- Pids], + false = erlang:check_process_code(Pid, literals) + end) || Pid <- Pids], [receive - {'DOWN',R,process,P,normal} -> - ok + {'DOWN',R,process,P,normal} -> + ok end || {P,R} <- Ms], %% Purge the code. @@ -603,14 +512,14 @@ provoke_mem_leak(N, Code, Check) -> %% Tell the processes that the code has been purged. [begin - monitor(process, Pid), - Pid ! purged + monitor(process, Pid), + Pid ! purged end || Pid <- Pids], %% Wait for all processes to terminate. [receive - {'DOWN',_,process,Pid,normal} -> - ok + {'DOWN',_,process,Pid,normal} -> + ok end || Pid <- Pids], %% We now expect that the binary has been deallocated. @@ -622,112 +531,112 @@ create_binaries(Parent, NumRefs, Check) -> {bits,Bits} = literals:bits(), Parent ! {started,self()}, receive - purged -> - %% The code has been purged. Now make sure that - %% the binaries haven't been corrupted. - Check = erlang:md5(Bin), - [Bin = B || B <- Bins], - <<42:13,Bin/binary>> = Bits, - - %% Remove all references to the binaries - %% Doing it explicitly like this ensures that - %% the binaries are gone when the parent process - %% receives the 'DOWN' message. - erlang:garbage_collect() + purged -> + %% The code has been purged. Now make sure that + %% the binaries haven't been corrupted. + Check = erlang:md5(Bin), + [Bin = B || B <- Bins], + <<42:13,Bin/binary>> = Bits, + + %% Remove all references to the binaries + %% Doing it explicitly like this ensures that + %% the binaries are gone when the parent process + %% receives the 'DOWN' message. + erlang:garbage_collect() end. wait_for_memory_deallocations() -> try - erts_debug:set_internal_state(wait, deallocations) + erts_debug:set_internal_state(wait, deallocations) catch - error:undef -> - erts_debug:set_internal_state(available_internal_state, true), - wait_for_memory_deallocations() + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_for_memory_deallocations() end. %% OTP-7559: c_p->cp could contain garbage and create a false dependency %% to a module in a process. (Thanks to Richard Carlsson.) false_dependency(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "cpbugx"), - ?line {ok,cpbugx,Code} = compile:file(File, [binary,report]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "cpbugx"), + {ok,cpbugx,Code} = compile:file(File, [binary,report]), do_false_dependency(fun cpbugx:before/0, Code), do_false_dependency(fun cpbugx:before2/0, Code), do_false_dependency(fun cpbugx:before3/0, Code), -%% %% Spawn process. Make sure it has called cpbugx:before/0 and returned. -%% Parent = self(), -%% ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent) end), -%% ?line receive initialized -> ok end, + %% %% Spawn process. Make sure it has called cpbugx:before/0 and returned. + %% Parent = self(), + %% Pid = spawn_link(fun() -> false_dependency_loop(Parent) end), + %% receive initialized -> ok end, -%% %% Reload the module. Make sure the process is still alive. -%% ?line {module,cpbugx} = erlang:load_module(cpbugx, Bin), -%% ?line io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), -%% ?line true = is_process_alive(Pid), + %% %% Reload the module. Make sure the process is still alive. + %% {module,cpbugx} = erlang:load_module(cpbugx, Bin), + %% io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), + %% true = is_process_alive(Pid), -%% %% There should not be any dependency to cpbugx. -%% ?line false = erlang:check_process_code(Pid, cpbugx), - + %% %% There should not be any dependency to cpbugx. + %% false = erlang:check_process_code(Pid, cpbugx), -%% %% Kill the process. -%% ?line unlink(Pid), exit(Pid, kill), + + %% %% Kill the process. + %% unlink(Pid), exit(Pid, kill), ok. do_false_dependency(Init, Code) -> - ?line {module,cpbugx} = erlang:load_module(cpbugx, Code), + {module,cpbugx} = erlang:load_module(cpbugx, Code), %% Spawn process. Make sure it has the appropriate init function %% and returned. CP should not contain garbage after the return. Parent = self(), - ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init, true) end), - ?line receive initialized -> ok end, + Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init, true) end), + receive initialized -> ok end, %% Reload the module. Make sure the process is still alive. - ?line {module,cpbugx} = erlang:load_module(cpbugx, Code), - ?line io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), - ?line true = is_process_alive(Pid), + {module,cpbugx} = erlang:load_module(cpbugx, Code), + io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), + true = is_process_alive(Pid), %% There should not be any dependency to cpbugx. - ?line false = erlang:check_process_code(Pid, cpbugx), + false = erlang:check_process_code(Pid, cpbugx), %% Kill the process and completely unload the code. - ?line unlink(Pid), exit(Pid, kill), - ?line true = erlang:purge_module(cpbugx), - ?line true = erlang:delete_module(cpbugx), - ?line code:is_module_native(cpbugx), % test is_module_native on deleted code - ?line true = erlang:purge_module(cpbugx), - ?line code:is_module_native(cpbugx), % test is_module_native on purged code + unlink(Pid), exit(Pid, kill), + true = erlang:purge_module(cpbugx), + true = erlang:delete_module(cpbugx), + code:is_module_native(cpbugx), % test is_module_native on deleted code + true = erlang:purge_module(cpbugx), + code:is_module_native(cpbugx), % test is_module_native on purged code ok. - + false_dependency_loop(Parent, Init, SendInitAck) -> Init(), case SendInitAck of - true -> Parent ! initialized; - false -> void - %% Just send one init-ack. I guess the point of this test - %% wasn't to fill parents msg-queue (?). Seen to cause - %% out-of-mem (on halfword-vm for some reason) by - %% 91 million msg in queue. /sverker + true -> Parent ! initialized; + false -> void + %% Just send one init-ack. I guess the point of this test + %% wasn't to fill parents msg-queue (?). Seen to cause + %% out-of-mem (on halfword-vm for some reason) by + %% 91 million msg in queue. /sverker end, receive - _ -> false_dependency_loop(Parent, Init, false) + _ -> false_dependency_loop(Parent, Init, false) end. coverage(Config) when is_list(Config) -> - ?line code:is_module_native(?MODULE), - ?line {'EXIT',{badarg,_}} = (catch erlang:purge_module({a,b,c})), - ?line {'EXIT',{badarg,_}} = (catch code:is_module_native({a,b,c})), - ?line {'EXIT',{badarg,_}} = (catch erlang:check_process_code(not_a_pid, ?MODULE)), - ?line {'EXIT',{badarg,_}} = (catch erlang:check_process_code(self(), [not_a_module])), - ?line {'EXIT',{badarg,_}} = (catch erlang:delete_module([a,b,c])), - ?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), + code:is_module_native(?MODULE), + {'EXIT',{badarg,_}} = (catch erlang:purge_module({a,b,c})), + {'EXIT',{badarg,_}} = (catch code:is_module_native({a,b,c})), + {'EXIT',{badarg,_}} = (catch erlang:check_process_code(not_a_pid, ?MODULE)), + {'EXIT',{badarg,_}} = (catch erlang:check_process_code(self(), [not_a_module])), + {'EXIT',{badarg,_}} = (catch erlang:delete_module([a,b,c])), + {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), ok. fun_confusion(Config) when is_list(Config) -> - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), Src = filename:join(Data, "fun_confusion"), Mod = fun_confusion, @@ -750,6 +659,208 @@ compile_load(Mod, Src, Ver) -> {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1), ok. + +t_copy_literals(Config) when is_list(Config) -> + %% Compile the the literals module. + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "literals"), + {ok,literals,Code} = compile:file(File, [report,binary]), + {module,literals} = erlang:load_module(literals, Code), + + N = 30, + Me = self(), + %% reload literals code every 567 ms + Rel = spawn_link(fun() -> reloader(literals,Code,567) end), + %% add new literal msgs to the loop every 789 ms + Sat = spawn_link(fun() -> saturate(Me,789) end), + %% run for 10s + _ = spawn_link(fun() -> receive after 10000 -> Me ! done end end), + ok = chase_msg(N, Me), + %% cleanup + Rel ! done, + Sat ! done, + ok = flush(), + ok. + +-define(mod, t_copy_literals_frags). +t_copy_literals_frags(Config) when is_list(Config) -> + Bin = gen_lit(?mod,[{a,{1,2,3,4,5,6,7}}, + {b,"hello world"}, + {c, <<"hello world">>}, + {d, {"hello world", {1.0, 2.0, <<"some">>, "string"}}}, + {e, <<"off heap", 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9,10,11,12,13,14,15, + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9,10,11,12,13,14,15, + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9,10,11,12,13,14,15, + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9,10,11,12,13,14,15>>}]), + + {module, ?mod} = erlang:load_module(?mod, Bin), + N = 6000, + Recv = spawn_opt(fun() -> receive + read -> + io:format("reading"), + literal_receiver() + end + end, [link,{min_heap_size, 10000}]), + Switcher = spawn_link(fun() -> literal_switcher() end), + Pids = [spawn_opt(fun() -> receive + {Pid, go, Recv, N} -> + io:format("sender batch (~w) start ~w~n",[N,self()]), + literal_sender(N,Recv), + Pid ! {self(), ok} + end + end, [link,{min_heap_size,800}]) || _ <- lists:seq(1,100)], + _ = [Pid ! {self(), go, Recv, N} || Pid <- Pids], + %% don't read immediately + timer:sleep(5), + Recv ! read, + Switcher ! {switch,?mod,Bin,[Recv|Pids],200}, + _ = [receive {Pid, ok} -> ok end || Pid <- Pids], + Switcher ! {self(), done}, + receive {Switcher, ok} -> ok end, + Recv ! {self(), done}, + receive {Recv, ok} -> ok end, + ok. + +literal_receiver() -> + receive + {Pid, done} -> + io:format("reader_done~n"), + Pid ! {self(), ok}; + {_Pid, msg, [A,B,C,D,E]} -> + A = ?mod:a(), + B = ?mod:b(), + C = ?mod:c(), + D = ?mod:d(), + E = ?mod:e(), + literal_receiver(); + {Pid, sender_confirm} -> + io:format("sender confirm ~w~n", [Pid]), + Pid ! {self(), ok}, + literal_receiver() + end. + +literal_sender(0, Recv) -> + Recv ! {self(), sender_confirm}, + receive {Recv, ok} -> ok end; +literal_sender(N, Recv) -> + Recv ! {self(), msg, [?mod:a(), + ?mod:b(), + ?mod:c(), + ?mod:d(), + ?mod:e()]}, + literal_sender(N - 1, Recv). + +literal_switcher() -> + receive + {switch,Mod,Bin,Pids,Tmo} -> + literal_switcher(Mod,Bin,Pids,Tmo) + end. +literal_switcher(Mod,Bin,Pids,Tmo) -> + receive + {Pid,done} -> + Pid ! {self(),ok} + after Tmo -> + io:format("load module ~w~n", [Mod]), + {module, Mod} = erlang:load_module(Mod,Bin), + ok = check_and_purge(Pids,Mod), + io:format("purge complete ~w~n", [Mod]), + literal_switcher(Mod,Bin,Pids,Tmo+Tmo) + end. + +check_and_purge([],Mod) -> + erlang:purge_module(Mod), + ok; +check_and_purge(Pids,Mod) -> + io:format("purge ~w~n", [Mod]), + Tag = make_ref(), + _ = [begin + erlang:check_process_code(Pid,Mod,[{async,{Tag,Pid}}]) + end || Pid <- Pids], + Retry = check_and_purge_receive(Pids,Tag,[]), + check_and_purge(Retry,Mod). + +check_and_purge_receive([Pid|Pids],Tag,Retry) -> + receive + {check_process_code, {Tag, Pid}, false} -> + check_and_purge_receive(Pids,Tag,Retry); + {check_process_code, {Tag, Pid}, true} -> + check_and_purge_receive(Pids,Tag,[Pid|Retry]) + end; +check_and_purge_receive([],_,Retry) -> + Retry. + + +gen_lit(Module,Terms) -> + FunStrings = [lists:flatten(io_lib:format("~w() -> ~w.~n", [F,Term]))||{F,Term}<-Terms], + FunForms = function_forms(FunStrings), + Forms = [{attribute,erl_anno:new(1),module,Module}, + {attribute,erl_anno:new(2),export,[FA || {FA,_} <- FunForms]}] ++ + [Function || {_, Function} <- FunForms], + {ok, Module, Bin} = compile:forms(Forms), + Bin. + +function_forms([]) -> []; +function_forms([S|Ss]) -> + {ok, Ts,_} = erl_scan:string(S), + {ok, Form} = erl_parse:parse_form(Ts), + Fun = element(3, Form), + Arity = element(4, Form), + [{{Fun,Arity}, Form}|function_forms(Ss)]. + +chase_msg(0, Pid) -> + chase_loop(Pid); +chase_msg(N, Master) -> + Pid = spawn_link(fun() -> chase_msg(N - 1,Master) end), + chase_loop(Pid). + +chase_loop(Pid) -> + receive + done -> + Pid ! done, + ok; + {_From,Msg} -> + Pid ! {self(), Msg}, + ok = traverse(Msg), + chase_loop(Pid) + end. + +saturate(Pid,Time) -> + Es = [msg1,msg2,msg3,msg4,msg5], + Msg = [literals:E()||E <- Es], + Pid ! {self(), Msg}, + receive + done -> ok + after Time -> + saturate(Pid,Time) + end. + +traverse([]) -> ok; +traverse([H|T]) -> + ok = traverse(H), + traverse(T); +traverse(T) when is_tuple(T) -> ok; +traverse(B) when is_binary(B) -> ok; +traverse(I) when is_integer(I) -> ok; +traverse(#{ 1 := V1, b := V2 }) -> + ok = traverse(V1), + ok = traverse(V2), + ok. + + +reloader(Mod,Code,Time) -> + receive + done -> ok + after Time -> + code:purge(Mod), + {module,Mod} = erlang:load_module(Mod, Code), + reloader(Mod,Code,Time) + end. + + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> @@ -772,4 +883,8 @@ bit_sized_binary(Bin0) -> BitSize = 8*size(Bin) + 1, Bin. +flush() -> + receive _ -> flush() after 0 -> ok end. + id(I) -> I. + diff --git a/erts/emulator/test/code_SUITE_data/another_code_test.erl b/erts/emulator/test/code_SUITE_data/another_code_test.erl index 1c9b5bdb5b..5708ec682c 100644 --- a/erts/emulator/test/code_SUITE_data/another_code_test.erl +++ b/erts/emulator/test/code_SUITE_data/another_code_test.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl b/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl new file mode 100644 index 0000000000..699f0c1161 --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl @@ -0,0 +1,186 @@ +-module(call_purged_fun_tester). + +-export([do/4]). + +%% Resurrect line macro when hipe compiled +-ifdef(hipe). +-define(line, put(the_line,?LINE),). +do(Priv, Data, Type, Opts) -> + try do_it(Priv, Data, Type, Opts) + catch + C:E -> + ST = erlang:get_stacktrace(), + io:format("Caught exception from line ~p:\n~p\n", + [get(the_line), ST]), + io:format("Message queue: ~p\n", [process_info(self(), messages)]), + erlang:raise(C, E, ST) + end. +-else. +-define(line,). +do(P,D,T,O) -> + do_it(P,D,T,O). +-endif. + + +do_it(Priv, Data, Type, Opts) -> + File = filename:join(Data, "my_code_test2"), + Code = filename:join(Priv, "my_code_test2"), + + catch erlang:purge_module(my_code_test2), + catch erlang:delete_module(my_code_test2), + catch erlang:purge_module(my_code_test2), + + ?line {ok,my_code_test2} = c:c(File, [{outdir,Priv} | Opts]), + + ?line IsNative = lists:member(native,Opts), + ?line IsNative = code:is_module_native(my_code_test2), + + ?line T = ets:new(my_code_test2_fun_table, []), + ets:insert(T, {my_fun,my_code_test2:make_fun(4711)}), + ets:insert(T, {my_fun2,my_code_test2:make_fun2()}), + + Papa = self(), + {P0,M0} = spawn_monitor(fun () -> + [{my_fun2,F2}] = ets:lookup(T, my_fun2), + F2(fun () -> + Papa ! {self(),"going to sleep"}, + receive {Papa,"wake up"} -> ok end + end, + fun () -> ok end), + exit(completed) + end), + + ?line PurgeType = case Type of + code_gone -> + ok = file:delete(Code++".beam"), + true; + code_reload -> + true; + code_there -> + false + end, + + ?line true = erlang:delete_module(my_code_test2), + + ?line ok = receive {P0, "going to sleep"} -> ok + after 1000 -> timeout + end, + + ?line Purge = start_purge(my_code_test2, PurgeType), + + ?line {P1, M1} = spawn_monitor(fun () -> + ?line [{my_fun,F}] = ets:lookup(T, my_fun), + ?line 4712 = F(1), + exit(completed) + end), + + ?line ok = wait_until(fun () -> + {status, suspended} + == process_info(P1, status) + end), + + ?line ok = continue_purge(Purge), + + ?line {P2, M2} = spawn_monitor(fun () -> + ?line [{my_fun,F}] = ets:lookup(T, my_fun), + ?line 4713 = F(2), + exit(completed) + end), + ?line {P3, M3} = spawn_monitor(fun () -> + ?line [{my_fun,F}] = ets:lookup(T, my_fun), + ?line 4714 = F(3), + exit(completed) + end), + + ?line ok = wait_until(fun () -> + {status, suspended} + == process_info(P2, status) + end), + ?line ok = wait_until(fun () -> + {status, suspended} + == process_info(P3, status) + end), + + ?line {current_function, + {erts_code_purger, + pending_purge_lambda, + 3}} = process_info(P1, current_function), + ?line {current_function, + {erts_code_purger, + pending_purge_lambda, + 3}} = process_info(P2, current_function), + ?line {current_function, + {erts_code_purger, + pending_purge_lambda, + 3}} = process_info(P3, current_function), + + case Type of + code_there -> + ?line false = complete_purge(Purge), + P0 ! {self(), "wake up"}, + ?line completed = wait_for_down(P0,M0); + _ -> + ?line {true, true} = complete_purge(Purge), + ?line killed = wait_for_down(P0,M0) + end, + + case Type of + code_gone -> + ?line {undef, _} = wait_for_down(P1,M1), + ?line {undef, _} = wait_for_down(P2,M2), + ?line {undef, _} = wait_for_down(P3,M3); + _ -> + ?line completed = wait_for_down(P1,M1), + ?line completed = wait_for_down(P2,M2), + ?line completed = wait_for_down(P3,M3), + catch erlang:purge_module(my_code_test2), + catch erlang:delete_module(my_code_test2), + catch erlang:purge_module(my_code_test2) + end, + ok. + +wait_for_down(P,M) -> + receive + {'DOWN', M, process, P, Reason} -> + Reason + after 1000 -> + timeout + end. + +wait_until(Fun) -> + wait_until(Fun, 20). + +wait_until(Fun, N) -> + case {Fun(),N} of + {true, _} -> + ok; + {false, 0} -> + timeout; + {false, _} -> + receive after 100 -> ok end, + wait_until(Fun, N-1) + end. + +start_purge(Mod, Type) when is_atom(Mod) + andalso ((Type == true) + orelse (Type == false)) -> + Ref = make_ref(), + erts_code_purger ! {test_purge, Mod, self(), Type, Ref}, + receive + {started, Ref} -> + Ref + end. + +continue_purge(Ref) when is_reference(Ref) -> + erts_code_purger ! {continue, Ref}, + receive + {continued, Ref} -> + ok + end. + +complete_purge(Ref) when is_reference(Ref) -> + erts_code_purger ! {complete, Ref}, + receive + {test_purge, Res, Ref} -> + Res + end. diff --git a/erts/emulator/test/code_SUITE_data/cpbugx.erl b/erts/emulator/test/code_SUITE_data/cpbugx.erl index fb617c1973..ae2075c867 100644 --- a/erts/emulator/test/code_SUITE_data/cpbugx.erl +++ b/erts/emulator/test/code_SUITE_data/cpbugx.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/code_SUITE_data/fun_confusion.erl b/erts/emulator/test/code_SUITE_data/fun_confusion.erl index 16000861df..35279f241d 100644 --- a/erts/emulator/test/code_SUITE_data/fun_confusion.erl +++ b/erts/emulator/test/code_SUITE_data/fun_confusion.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl index 658427095e..7c3b0ebe73 100644 --- a/erts/emulator/test/code_SUITE_data/literals.erl +++ b/erts/emulator/test/code_SUITE_data/literals.erl @@ -1,24 +1,26 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(literals). -export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]). +-export([msg1/0,msg2/0,msg3/0,msg4/0,msg5/0]). a() -> {a,42.0,[7,38877938333399637266518333334747]}. @@ -100,3 +102,9 @@ unused_binaries() -> bits() -> {bits,<<42:13,?MB_1>>}. + +msg1() -> "halloj". +msg2() -> {"hello","world"}. +msg3() -> <<"halloj">>. +msg4() -> #{ 1=> "hello", b => "world"}. +msg5() -> {1,2,3,4,5,6}. diff --git a/erts/emulator/test/code_SUITE_data/many_funs.erl b/erts/emulator/test/code_SUITE_data/many_funs.erl index 0f9c3a85a4..ada570feee 100644 --- a/erts/emulator/test/code_SUITE_data/many_funs.erl +++ b/erts/emulator/test/code_SUITE_data/many_funs.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/code_SUITE_data/my_code_test.erl b/erts/emulator/test/code_SUITE_data/my_code_test.erl index 5039b7f937..9d12aa9897 100644 --- a/erts/emulator/test/code_SUITE_data/my_code_test.erl +++ b/erts/emulator/test/code_SUITE_data/my_code_test.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,5 +24,3 @@ make_fun(A) -> fun(X) -> A + X end. - - diff --git a/erts/emulator/test/code_SUITE_data/my_code_test2.erl b/erts/emulator/test/code_SUITE_data/my_code_test2.erl new file mode 100644 index 0000000000..57973535d4 --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/my_code_test2.erl @@ -0,0 +1,32 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(my_code_test2). + +-export([make_fun/1, make_fun2/0]). + +make_fun(A) -> + fun(X) -> A + X end. + +make_fun2() -> + fun (F1,F2) -> + F1(), + F2() + end. diff --git a/erts/emulator/test/code_SUITE_data/versions.erl b/erts/emulator/test/code_SUITE_data/versions.erl index 7a6fd8847d..56407e877a 100644 --- a/erts/emulator/test/code_SUITE_data/versions.erl +++ b/erts/emulator/test/code_SUITE_data/versions.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/code_parallel_load_SUITE.erl b/erts/emulator/test/code_parallel_load_SUITE.erl index 428f1242ab..827add71e5 100644 --- a/erts/emulator/test/code_parallel_load_SUITE.erl +++ b/erts/emulator/test/code_parallel_load_SUITE.erl @@ -1,66 +1,52 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(code_parallel_load_SUITE). --export([ - all/0, - suite/0, - init_per_suite/1, - end_per_suite/1, - init_per_testcase/2, - end_per_testcase/2 - ]). - --export([ - multiple_load_check_purge_repeat/1, - many_load_distributed_only_once/1 - ]). +-export([all/0, + suite/0, + init_per_testcase/2, + end_per_testcase/2]). + +-export([multiple_load_check_purge_repeat/1, + many_load_distributed_only_once/1]). -define(model, code_parallel_load_SUITE_model). -define(interval, 50). -define(number_of_processes, 160). -define(passes, 4). +-include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server.hrl"). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> - [ - multiple_load_check_purge_repeat, - many_load_distributed_only_once - ]. - - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. + [ multiple_load_check_purge_repeat, + many_load_distributed_only_once ]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. + Config. end_per_testcase(_Func, Config) -> - SConf = ?config(save_config, Config), + SConf = proplists:get_value(save_config, Config), Pids = proplists:get_value(purge_pids, SConf), case check_old_code(?model) of @@ -71,9 +57,7 @@ end_per_testcase(_Func, Config) -> true -> check_and_purge_processes_code(Pids, ?model); _ -> ok end, - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - + ok. multiple_load_check_purge_repeat(_Conf) -> Ts = [v1,v2,v3,v4,v5,v6], @@ -190,13 +174,15 @@ handle_cpc_responses(N, Tag, Module) -> generate(Module, Attributes, FunStrings) -> FunForms = function_forms(FunStrings), Forms = [ - {attribute,1,module,Module}, - {attribute,2,export,[FA || {FA,_} <- FunForms]} - ] ++ [{attribute, 3, A, V}|| {A, V} <- Attributes] ++ + {attribute,a(1),module,Module}, + {attribute,a(2),export,[FA || {FA,_} <- FunForms]} + ] ++ [{attribute, a(3), A, V}|| {A, V} <- Attributes] ++ [ Function || {_, Function} <- FunForms], {ok, Module, Bin} = compile:forms(Forms), Bin. +a(L) -> + erl_anno:new(L). function_forms([]) -> []; function_forms([S|Ss]) -> diff --git a/erts/emulator/test/crypto_SUITE.erl b/erts/emulator/test/crypto_SUITE.erl index a82bd4fe38..afb1be7332 100644 --- a/erts/emulator/test/crypto_SUITE.erl +++ b/erts/emulator/test/crypto_SUITE.erl @@ -1,83 +1,63 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(crypto_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - t_md5/1,t_md5_update/1,error/1,unaligned_context/1,random_lists/1, - misc_errors/1]). +-export([all/0, suite/0, + t_md5/1,t_md5_update/1,error/1,unaligned_context/1,random_lists/1, + misc_errors/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. all() -> [t_md5, t_md5_update, error, unaligned_context, random_lists, misc_errors]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - - -misc_errors(doc) -> - ["Test crc32, adler32 and md5 error cases not covered by other tests"]; -misc_errors(suite) -> - []; +%% Test crc32, adler32 and md5 error cases not covered by other tests" misc_errors(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(2)), - ?line 1 = erlang:adler32([]), - ?line L = lists:duplicate(600,3), - ?line 1135871753 = erlang:adler32(L), - ?line L2 = lists:duplicate(22000,3), - ?line 1100939744 = erlang:adler32(L2), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(L++[a])), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(L++[a])), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|<<25:7>>])), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|4])), - ?line Big = 111111111111111111111111111111, - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(Big,<<"hej">>)), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(25,[1,2,3|4])), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(Big,3,3)), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,Big,3)), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,3,Big)), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(Big,<<"hej">>)), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(25,[1,2,3|4])), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(Big,3,3)), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,Big,3)), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,3,Big)), - ?line {'EXIT', {badarg,_}} = (catch erlang:md5_update(<<"hej">>,<<"hej">>)), - ?line {'EXIT', {badarg,_}} = (catch erlang:md5_final(<<"hej">>)), - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({minutes, 2}), + 1 = erlang:adler32([]), + L = lists:duplicate(600,3), + 1135871753 = erlang:adler32(L), + L2 = lists:duplicate(22000,3), + 1100939744 = erlang:adler32(L2), + {'EXIT', {badarg,_}} = (catch erlang:adler32(L++[a])), + {'EXIT', {badarg,_}} = (catch erlang:crc32(L++[a])), + {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|<<25:7>>])), + {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|4])), + Big = 111111111111111111111111111111, + {'EXIT', {badarg,_}} = (catch erlang:crc32(Big,<<"hej">>)), + {'EXIT', {badarg,_}} = (catch erlang:crc32(25,[1,2,3|4])), + {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(Big,3,3)), + {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,Big,3)), + {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,3,Big)), + {'EXIT', {badarg,_}} = (catch erlang:adler32(Big,<<"hej">>)), + {'EXIT', {badarg,_}} = (catch erlang:adler32(25,[1,2,3|4])), + {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(Big,3,3)), + {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,Big,3)), + {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,3,Big)), + {'EXIT', {badarg,_}} = (catch erlang:md5_update(<<"hej">>,<<"hej">>)), + {'EXIT', {badarg,_}} = (catch erlang:md5_final(<<"hej">>)), ok. @@ -92,7 +72,7 @@ nicesplit(N,L) -> nicesplit(0,Tail,Acc) -> {lists:reverse(Acc),Tail}; nicesplit(_,[],Acc) -> - {lists:reverse(Acc),[]}; + {lists:reverse(Acc),[]}; nicesplit(N,[H|Tail],Acc) -> nicesplit(N-1,Tail,[H|Acc]). @@ -101,17 +81,17 @@ run_in_para([],_) -> run_in_para(FunList,Schedulers) -> {ThisTime,NextTime} = nicesplit(Schedulers,FunList), case length(ThisTime) of - 1 -> - [{L,Fun}] = ThisTime, - try - Fun() + 1 -> + [{L,Fun}] = ThisTime, + try + Fun() catch - _:Reason -> - exit({error_at_line,L,Reason}) - end; + _:Reason -> + exit({error_at_line,L,Reason}) + end; _ -> - These = [ {L,erlang:spawn_monitor(F)} || {L,F} <- ThisTime ], - collect_workers(These) + These = [ {L,erlang:spawn_monitor(F)} || {L,F} <- ThisTime ], + collect_workers(These) end, run_in_para(NextTime,Schedulers). @@ -119,159 +99,147 @@ collect_workers([]) -> ok; collect_workers([{L,{Pid,Ref}}|T]) -> receive - {'DOWN',Ref,process,Pid,normal} -> - collect_workers(T); - {'DOWN',Ref,process,Pid,Other} -> - exit({error_at_line,L,Other}) + {'DOWN',Ref,process,Pid,normal} -> + collect_workers(T); + {'DOWN',Ref,process,Pid,Other} -> + exit({error_at_line,L,Other}) end. -random_lists(doc) -> - ["Test crc32, adler32 and md5 on a number of pseudo-randomly generated " - "lists."]; -random_lists(suite) -> - []; +%% Test crc32, adler32 and md5 on a number of pseudo-randomly generated lists. random_lists(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(5)), - ?line Num = erlang:system_info(schedulers_online), - ?line B = list_to_binary( - lists:duplicate( - (erlang:system_info(context_reductions)*10) - 50,$!)), - ?line CRC32_1 = fun(L) -> erlang:crc32(L) end, - ?line CRC32_2 = fun(L) -> ?REF:crc32(L) end, - ?line ADLER32_1 = fun(L) -> erlang:adler32(L) end, - ?line ADLER32_2 = fun(L) -> ?REF:adler32(L) end, - ?line MD5_1 = fun(L) -> erlang:md5(L) end, - ?line MD5_2 = fun(L) -> ?REF:md5_final( - ?REF:md5_update(?REF:md5_init(),L)) end, - ?line MD5_3 = fun(L) -> erlang:md5_final( - erlang:md5_update(erlang:md5_init(),L)) end, - ?line CRC32_1_L = fun(L) -> erlang:crc32([B|L]) end, - ?line CRC32_2_L = fun(L) -> ?REF:crc32([B|L]) end, - ?line ADLER32_1_L = fun(L) -> erlang:adler32([B|L]) end, - ?line ADLER32_2_L = fun(L) -> ?REF:adler32([B|L]) end, - ?line MD5_1_L = fun(L) -> erlang:md5([B|L]) end, - ?line MD5_2_L = fun(L) -> ?REF:md5_final( - ?REF:md5_update(?REF:md5_init(),[B|L])) end, - ?line MD5_3_L = fun(L) -> erlang:md5_final( - erlang:md5_update( - erlang:md5_init(),[B|L])) end, - ?line Wlist0 = - [{?LINE, fun() -> random_iolist:run(150, CRC32_1, CRC32_2) end}, - {?LINE, fun() -> random_iolist:run(150, ADLER32_1, ADLER32_2) end}, - {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_2) end}, - {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_3) end}, - {?LINE, fun() -> random_iolist:run(150, CRC32_1_L, CRC32_2_L) end}, - {?LINE, - fun() -> random_iolist:run(150, ADLER32_1_L, ADLER32_2_L) end}, - {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_2_L) end}, - {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_3_L) end}], - ?line run_in_para(Wlist0,Num), - ?line CRC32_1_2 = fun(L1,L2) -> erlang:crc32([L1,L2]) end, - ?line CRC32_2_2 = fun(L1,L2) -> erlang:crc32(erlang:crc32(L1),L2) end, - ?line CRC32_3_2 = fun(L1,L2) -> erlang:crc32_combine( - erlang:crc32(L1), - erlang:crc32(L2), - erlang:iolist_size(L2)) - end, - ?line ADLER32_1_2 = fun(L1,L2) -> erlang:adler32([L1,L2]) end, - ?line ADLER32_2_2 = fun(L1,L2) -> erlang:adler32( - erlang:adler32(L1),L2) end, - ?line ADLER32_3_2 = fun(L1,L2) -> erlang:adler32_combine( - erlang:adler32(L1), - erlang:adler32(L2), - erlang:iolist_size(L2)) - end, - ?line MD5_1_2 = fun(L1,L2) -> erlang:md5([L1,L2]) end, - ?line MD5_2_2 = fun(L1,L2) -> - erlang:md5_final( - erlang:md5_update( - erlang:md5_update( - erlang:md5_init(), - L1), - L2)) - end, - ?line CRC32_1_L_2 = fun(L1,L2) -> erlang:crc32([[B|L1],[B|L2]]) end, - ?line CRC32_2_L_2 = fun(L1,L2) -> erlang:crc32( - erlang:crc32([B|L1]),[B|L2]) end, - ?line CRC32_3_L_2 = fun(L1,L2) -> erlang:crc32_combine( - erlang:crc32([B|L1]), - erlang:crc32([B|L2]), - erlang:iolist_size([B|L2])) - end, - ?line ADLER32_1_L_2 = fun(L1,L2) -> erlang:adler32([[B|L1],[B|L2]]) end, - ?line ADLER32_2_L_2 = fun(L1,L2) -> erlang:adler32( - erlang:adler32([B|L1]), - [B|L2]) - end, - ?line ADLER32_3_L_2 = fun(L1,L2) -> erlang:adler32_combine( - erlang:adler32([B|L1]), - erlang:adler32([B|L2]), - erlang:iolist_size([B|L2])) - end, - ?line MD5_1_L_2 = fun(L1,L2) -> erlang:md5([[B|L1],[B|L2]]) end, - ?line MD5_2_L_2 = fun(L1,L2) -> - erlang:md5_final( - erlang:md5_update( - erlang:md5_update( - erlang:md5_init(), - [B|L1]), - [B|L2])) - end, - ?line Wlist1 = - [{?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_2_2) end}, - {?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_3_2) end}, - {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_2_2) end}, - {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_3_2) end}, - {?LINE, fun() -> random_iolist:run2(150,MD5_1_2,MD5_2_2) end}, - {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_2_L_2) end}, - {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_3_L_2) end}, - {?LINE, - fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_2_L_2) end}, - {?LINE, - fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_3_L_2) end}, - {?LINE, fun() -> random_iolist:run2(150,MD5_1_L_2,MD5_2_L_2) end}], - ?line run_in_para(Wlist1,Num), - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({minutes, 5}), + Num = erlang:system_info(schedulers_online), + B = list_to_binary( + lists:duplicate( + (erlang:system_info(context_reductions)*10) - 50,$!)), + CRC32_1 = fun(L) -> erlang:crc32(L) end, + CRC32_2 = fun(L) -> ?REF:crc32(L) end, + ADLER32_1 = fun(L) -> erlang:adler32(L) end, + ADLER32_2 = fun(L) -> ?REF:adler32(L) end, + MD5_1 = fun(L) -> erlang:md5(L) end, + MD5_2 = fun(L) -> ?REF:md5_final( + ?REF:md5_update(?REF:md5_init(),L)) end, + MD5_3 = fun(L) -> erlang:md5_final( + erlang:md5_update(erlang:md5_init(),L)) end, + CRC32_1_L = fun(L) -> erlang:crc32([B|L]) end, + CRC32_2_L = fun(L) -> ?REF:crc32([B|L]) end, + ADLER32_1_L = fun(L) -> erlang:adler32([B|L]) end, + ADLER32_2_L = fun(L) -> ?REF:adler32([B|L]) end, + MD5_1_L = fun(L) -> erlang:md5([B|L]) end, + MD5_2_L = fun(L) -> ?REF:md5_final( + ?REF:md5_update(?REF:md5_init(),[B|L])) end, + MD5_3_L = fun(L) -> erlang:md5_final( + erlang:md5_update( + erlang:md5_init(),[B|L])) end, + Wlist0 = + [{?LINE, fun() -> random_iolist:run(150, CRC32_1, CRC32_2) end}, + {?LINE, fun() -> random_iolist:run(150, ADLER32_1, ADLER32_2) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_2) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_3) end}, + {?LINE, fun() -> random_iolist:run(150, CRC32_1_L, CRC32_2_L) end}, + {?LINE, + fun() -> random_iolist:run(150, ADLER32_1_L, ADLER32_2_L) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_2_L) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_3_L) end}], + run_in_para(Wlist0,Num), + CRC32_1_2 = fun(L1,L2) -> erlang:crc32([L1,L2]) end, + CRC32_2_2 = fun(L1,L2) -> erlang:crc32(erlang:crc32(L1),L2) end, + CRC32_3_2 = fun(L1,L2) -> erlang:crc32_combine( + erlang:crc32(L1), + erlang:crc32(L2), + erlang:iolist_size(L2)) + end, + ADLER32_1_2 = fun(L1,L2) -> erlang:adler32([L1,L2]) end, + ADLER32_2_2 = fun(L1,L2) -> erlang:adler32( + erlang:adler32(L1),L2) end, + ADLER32_3_2 = fun(L1,L2) -> erlang:adler32_combine( + erlang:adler32(L1), + erlang:adler32(L2), + erlang:iolist_size(L2)) + end, + MD5_1_2 = fun(L1,L2) -> erlang:md5([L1,L2]) end, + MD5_2_2 = fun(L1,L2) -> + erlang:md5_final( + erlang:md5_update( + erlang:md5_update( + erlang:md5_init(), + L1), + L2)) + end, + CRC32_1_L_2 = fun(L1,L2) -> erlang:crc32([[B|L1],[B|L2]]) end, + CRC32_2_L_2 = fun(L1,L2) -> erlang:crc32( + erlang:crc32([B|L1]),[B|L2]) end, + CRC32_3_L_2 = fun(L1,L2) -> erlang:crc32_combine( + erlang:crc32([B|L1]), + erlang:crc32([B|L2]), + erlang:iolist_size([B|L2])) + end, + ADLER32_1_L_2 = fun(L1,L2) -> erlang:adler32([[B|L1],[B|L2]]) end, + ADLER32_2_L_2 = fun(L1,L2) -> erlang:adler32( + erlang:adler32([B|L1]), + [B|L2]) + end, + ADLER32_3_L_2 = fun(L1,L2) -> erlang:adler32_combine( + erlang:adler32([B|L1]), + erlang:adler32([B|L2]), + erlang:iolist_size([B|L2])) + end, + MD5_1_L_2 = fun(L1,L2) -> erlang:md5([[B|L1],[B|L2]]) end, + MD5_2_L_2 = fun(L1,L2) -> + erlang:md5_final( + erlang:md5_update( + erlang:md5_update( + erlang:md5_init(), + [B|L1]), + [B|L2])) + end, + Wlist1 = + [{?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_2_2) end}, + {?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_3_2) end}, + {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_2_2) end}, + {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_3_2) end}, + {?LINE, fun() -> random_iolist:run2(150,MD5_1_2,MD5_2_2) end}, + {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_2_L_2) end}, + {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_3_L_2) end}, + {?LINE, + fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_2_L_2) end}, + {?LINE, + fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_3_L_2) end}, + {?LINE, fun() -> random_iolist:run2(150,MD5_1_L_2,MD5_2_L_2) end}], + run_in_para(Wlist1,Num), ok. -%% -%% -t_md5(doc) -> - ["Generate MD5 message digests and check the result. Examples are " - "from RFC-1321."]; +%% Generate MD5 message digests and check the result. Examples are from RFC-1321. t_md5(Config) when is_list(Config) -> - ?line t_md5_test("", "d41d8cd98f00b204e9800998ecf8427e"), - ?line t_md5_test("a", "0cc175b9c0f1b6a831c399e269772661"), - ?line t_md5_test("abc", "900150983cd24fb0d6963f7d28e17f72"), - ?line t_md5_test(["message ","digest"], "f96b697d7cb7938d525a2f31aaf161d0"), - ?line t_md5_test(["message ",unaligned_sub_bin(<<"digest">>)], - "f96b697d7cb7938d525a2f31aaf161d0"), - ?line t_md5_test("abcdefghijklmnopqrstuvwxyz", - "c3fcd3d76192e4007dfb496cca67e13b"), - ?line t_md5_test("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - "0123456789", - "d174ab98d277d9f5a5611c2c9f419d9f"), - ?line t_md5_test("12345678901234567890123456789012345678901234567890" - "123456789012345678901234567890", - "57edf4a22be3c955ac49da2e2107b67a"), + t_md5_test("", "d41d8cd98f00b204e9800998ecf8427e"), + t_md5_test("a", "0cc175b9c0f1b6a831c399e269772661"), + t_md5_test("abc", "900150983cd24fb0d6963f7d28e17f72"), + t_md5_test(["message ","digest"], "f96b697d7cb7938d525a2f31aaf161d0"), + t_md5_test(["message ",unaligned_sub_bin(<<"digest">>)], + "f96b697d7cb7938d525a2f31aaf161d0"), + t_md5_test("abcdefghijklmnopqrstuvwxyz", + "c3fcd3d76192e4007dfb496cca67e13b"), + t_md5_test("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" + "0123456789", + "d174ab98d277d9f5a5611c2c9f419d9f"), + t_md5_test("12345678901234567890123456789012345678901234567890" + "123456789012345678901234567890", + "57edf4a22be3c955ac49da2e2107b67a"), ok. -%% -%% -t_md5_update(doc) -> - ["Generate MD5 message using md5_init, md5_update, and md5_final, and" - "check the result. Examples are from RFC-1321."]; +%% Generate MD5 message using md5_init, md5_update, and md5_final, and +%% check the result. Examples are from RFC-1321. t_md5_update(Config) when is_list(Config) -> - ?line t_md5_update_1(fun(Str) -> Str end), - ?line t_md5_update_1(fun(Str) -> list_to_binary(Str) end), - ?line t_md5_update_1(fun(Str) -> unaligned_sub_bin(list_to_binary(Str)) end), + t_md5_update_1(fun(Str) -> Str end), + t_md5_update_1(fun(Str) -> list_to_binary(Str) end), + t_md5_update_1(fun(Str) -> unaligned_sub_bin(list_to_binary(Str)) end), ok. t_md5_update_1(Tr) when is_function(Tr, 1) -> Ctx = erlang:md5_init(), Ctx1 = erlang:md5_update(Ctx, Tr("ABCDEFGHIJKLMNOPQRSTUVWXYZ")), Ctx2 = erlang:md5_update(Ctx1, Tr("abcdefghijklmnopqrstuvwxyz" - "0123456789")), + "0123456789")), m(erlang:md5_final(Ctx2), hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), ok. @@ -279,28 +247,28 @@ t_md5_update_1(Tr) when is_function(Tr, 1) -> %% %% error(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = (catch erlang:md5(bit_sized_binary(<<"abc">>))), - ?line Ctx0 = erlang:md5_init(), - ?line {'EXIT',{badarg,_}} = - (catch erlang:md5_update(Ctx0, bit_sized_binary(<<"abcfjldjd">>))), - ?line {'EXIT',{badarg,_}} = - (catch erlang:md5_update(Ctx0, ["something",bit_sized_binary(<<"abcfjldjd">>)])), - ?line {'EXIT',{badarg,_}} = - (catch erlang:md5_update(bit_sized_binary(Ctx0), "something")), - ?line {'EXIT',{badarg,_}} = (catch erlang:md5_final(bit_sized_binary(Ctx0))), - ?line m(erlang:md5_final(Ctx0), hexstr2bin("d41d8cd98f00b204e9800998ecf8427e")), + {'EXIT',{badarg,_}} = (catch erlang:md5(bit_sized_binary(<<"abc">>))), + Ctx0 = erlang:md5_init(), + {'EXIT',{badarg,_}} = + (catch erlang:md5_update(Ctx0, bit_sized_binary(<<"abcfjldjd">>))), + {'EXIT',{badarg,_}} = + (catch erlang:md5_update(Ctx0, ["something",bit_sized_binary(<<"abcfjldjd">>)])), + {'EXIT',{badarg,_}} = + (catch erlang:md5_update(bit_sized_binary(Ctx0), "something")), + {'EXIT',{badarg,_}} = (catch erlang:md5_final(bit_sized_binary(Ctx0))), + m(erlang:md5_final(Ctx0), hexstr2bin("d41d8cd98f00b204e9800998ecf8427e")), ok. %% %% unaligned_context(Config) when is_list(Config) -> - ?line Ctx0 = erlang:md5_init(), - ?line Ctx1 = erlang:md5_update(unaligned_sub_bin(Ctx0), "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), - ?line Ctx = erlang:md5_update(unaligned_sub_bin(Ctx1), - "abcdefghijklmnopqrstuvwxyz0123456789"), - ?line m(erlang:md5_final(unaligned_sub_bin(Ctx)), - hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), + Ctx0 = erlang:md5_init(), + Ctx1 = erlang:md5_update(unaligned_sub_bin(Ctx0), "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), + Ctx = erlang:md5_update(unaligned_sub_bin(Ctx1), + "abcdefghijklmnopqrstuvwxyz0123456789"), + m(erlang:md5_final(unaligned_sub_bin(Ctx)), + hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), ok. %% @@ -346,5 +314,3 @@ bit_sized_binary(Bin0) -> Bin. id(I) -> I. - - diff --git a/erts/emulator/test/crypto_reference.erl b/erts/emulator/test/crypto_reference.erl index b91535a50e..950b0c1560 100644 --- a/erts/emulator/test/crypto_reference.erl +++ b/erts/emulator/test/crypto_reference.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl index ffb68ed4ee..031b05790d 100644 --- a/erts/emulator/test/ddll_SUITE.erl +++ b/erts/emulator/test/ddll_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -30,30 +31,31 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, ddll_test/1, errors/1, - reference_count/1, - kill_port/1, dont_kill_port/1]). +-export([all/0, suite/0, + ddll_test/1, errors/1, reference_count/1, + kill_port/1, dont_kill_port/1]). -export([unload_on_process_exit/1, delayed_unload_with_ports/1, - unload_due_to_process_exit/1, - no_unload_due_to_process_exit/1, no_unload_due_to_process_exit_2/1, - unload_reload_thingie/1, unload_reload_thingie_2/1, - unload_reload_thingie_3/1, reload_pending/1, reload_pending_kill/1, - load_fail_init/1, - reload_pending_fail_init/1, - more_error_codes/1, forced_port_killing/1, - no_trap_exit_and_kill_ports/1, - monitor_demonitor/1, monitor_demonitor_load/1, new_interface/1, - lock_driver/1]). + unload_due_to_process_exit/1, + no_unload_due_to_process_exit/1, no_unload_due_to_process_exit_2/1, + unload_reload_thingie/1, unload_reload_thingie_2/1, + unload_reload_thingie_3/1, reload_pending/1, reload_pending_kill/1, + load_fail_init/1, + reload_pending_fail_init/1, + more_error_codes/1, forced_port_killing/1, + no_trap_exit_and_kill_ports/1, + monitor_demonitor/1, monitor_demonitor_load/1, new_interface/1, + lock_driver/1]). % Private exports -export([echo_loader/2, nice_echo_loader/2 ,properties/1, load_and_unload/1]). -import(ordsets, [subtract/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [ddll_test, errors, reference_count, kill_port, @@ -69,1057 +71,931 @@ all() -> no_trap_exit_and_kill_ports, monitor_demonitor, monitor_demonitor_load, new_interface, lock_driver]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -unload_on_process_exit(suite) -> - []; -unload_on_process_exit(doc) -> - ["Check that the driver is unloaded on process exit"]; +%% Check that the driver is unloaded on process exit unload_on_process_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), + Path = proplists:get_value(data_dir, Config), + false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), Parent = self(), - ?line Pid = spawn(fun() -> - receive go -> ok end, - erl_ddll:try_load(Path, echo_drv, []), - Parent ! gone, - receive go -> ok end, - erl_ddll:loaded_drivers(), - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), - ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), + Pid = spawn(fun() -> + receive go -> ok end, + erl_ddll:try_load(Path, echo_drv, []), + Parent ! gone, + receive go -> ok end, + erl_ddll:loaded_drivers(), + exit(banan) + end), + Ref = erlang:monitor(process,Pid), + false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), Pid ! go, - ?line receive - gone -> ok + receive + gone -> ok end, - ?line true = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), + true = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), Pid ! go, - ?line receive - {'DOWN', Ref, process, Pid, banan} -> - ok + receive + {'DOWN', Ref, process, Pid, banan} -> + ok end, receive after 500 -> ok end, - ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), - ?line test_server:timetrap_cancel(Dog), + false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), ok. -delayed_unload_with_ports(suite) -> - []; -delayed_unload_with_ports(doc) -> - ["Check that the driver is unloaded when the last port is closed"]; +%% Check that the driver is unloaded when the last port is closed delayed_unload_with_ports(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:try_load(Path, echo_drv, []), - ?line erl_ddll:try_load(Path, echo_drv, []), - ?line Port = open_port({spawn, echo_drv}, [eof]), - ?line 1 = erl_ddll:info(echo_drv, port_count), - ?line Port2 = open_port({spawn, echo_drv}, [eof]), - ?line 2 = erl_ddll:info(echo_drv, port_count), - ?line {ok,pending_process} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]), - ?line {ok,pending_driver,Ref} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]), - ?line ok = receive _ -> false after 0 -> ok end, - ?line Port ! {self(), close}, - ?line ok = receive {Port,closed} -> ok after 1000 -> false end, - ?line 1 = erl_ddll:info(echo_drv, port_count), - ?line Port2 ! {self(), close}, - ?line ok = receive {Port2,closed} -> ok after 1000 -> false end, - ?line ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 1000 -> false end, - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + erl_ddll:try_load(Path, echo_drv, []), + erl_ddll:try_load(Path, echo_drv, []), + Port = open_port({spawn, echo_drv}, [eof]), + 1 = erl_ddll:info(echo_drv, port_count), + Port2 = open_port({spawn, echo_drv}, [eof]), + 2 = erl_ddll:info(echo_drv, port_count), + {ok,pending_process} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]), + {ok,pending_driver,Ref} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]), + ok = receive _ -> false after 0 -> ok end, + Port ! {self(), close}, + ok = receive {Port,closed} -> ok after 1000 -> false end, + 1 = erl_ddll:info(echo_drv, port_count), + Port2 ! {self(), close}, + ok = receive {Port2,closed} -> ok after 1000 -> false end, + ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 1000 -> false end, ok. -unload_due_to_process_exit(suite) -> - []; -unload_due_to_process_exit(doc) -> - ["Check that the driver with ports is unloaded on process exit"]; +%% Check that the driver with ports is unloaded on process exit unload_due_to_process_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, ok. -no_unload_due_to_process_exit(suite) -> - []; -no_unload_due_to_process_exit(doc) -> - ["Check that a driver with driver loaded in another process is not unloaded on process exit"]; +%% Check that a driver with driver loaded in another process is not unloaded on process exit no_unload_due_to_process_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line ok = unload_expect_fast(echo_drv,[]), - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive X -> {error, X} after 300 -> ok end, + ok = unload_expect_fast(echo_drv,[]), + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, ok. -no_unload_due_to_process_exit_2(suite) -> - []; -no_unload_due_to_process_exit_2(doc) -> - ["Check that a driver with open ports in another process is not unloaded on process exit"]; +%% Check that a driver with open ports in another process is not unloaded on process exit no_unload_due_to_process_exit_2(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line Port = open_port({spawn, echo_drv}, [eof]), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + Port = open_port({spawn, echo_drv}, [eof]), Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line erlang:port_close(Port), - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive X -> {error, X} after 300 -> ok end, + erlang:port_close(Port), + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, ok. -unload_reload_thingie(suite) -> - []; -unload_reload_thingie(doc) -> - ["Check delayed unload and reload"]; +%% Check delayed unload and reload unload_reload_thingie(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - spawn(F3), - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + spawn(F3), + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), + Pid ! go, + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok,pending_driver,Ref3} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]), + Ref4 = erl_ddll:monitor(driver,{echo_drv,loaded}), + ok = receive {'DOWN',Ref4, driver,echo_drv,load_cancelled} -> ok after 1000 -> false end, + {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + ok = receive {'UP',Ref3, driver,echo_drv,unload_cancelled} -> ok after 1000 -> false end, Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok,pending_driver,Ref3} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]), - ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,loaded}), - ?line ok = receive {'DOWN',Ref4, driver,echo_drv,load_cancelled} -> ok after 1000 -> false end, - ?line {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line ok = receive {'UP',Ref3, driver,echo_drv,unload_cancelled} -> ok after 1000 -> false end, - ?line Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line [{Parent,1}] = erl_ddll:info(echo_drv, processes), - ?line 0 = erl_ddll:info(echo_drv, port_count), - ?line ok = unload_expect_fast(echo_drv,[{monitor,pending}]), - ?line ok = receive - {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok - after 300 -> error - end, - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + [{Parent,1}] = erl_ddll:info(echo_drv, processes), + 0 = erl_ddll:info(echo_drv, port_count), + ok = unload_expect_fast(echo_drv,[{monitor,pending}]), + ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ok = receive X -> {error, X} after 300 -> ok end, ok. -unload_reload_thingie_2(suite) -> - []; -unload_reload_thingie_2(doc) -> - ["Check delayed unload and reload"]; +%% Check delayed unload and reload unload_reload_thingie_2(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - spawn(F3), - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + spawn(F3), + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok,pending_driver,Ref3} = erl_ddll:try_load(Path,echo_drv,[{monitor,pending_driver},{reload,pending_driver}]), - ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive {'DOWN',Ref4, driver,echo_drv,unloaded} -> ok after 1000 -> false end, - ?line ok = receive {'UP',Ref3, driver,echo_drv,loaded} -> ok after 1000 -> false end, - ?line [{Parent,1}] = erl_ddll:info(echo_drv, processes), - ?line 0 = erl_ddll:info(echo_drv, port_count), - ?line ok = receive - {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok - after 300 -> error - end, - ?line ok = unload_expect_fast(echo_drv,[{monitor,pending}]), - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok,pending_driver,Ref3} = erl_ddll:try_load(Path, echo_drv, + [{monitor,pending_driver},{reload,pending_driver}]), + Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), + Pid ! go, + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive {'DOWN',Ref4, driver,echo_drv,unloaded} -> ok after 1000 -> false end, + ok = receive {'UP',Ref3, driver,echo_drv,loaded} -> ok after 1000 -> false end, + [{Parent,1}] = erl_ddll:info(echo_drv, processes), + 0 = erl_ddll:info(echo_drv, port_count), + ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ok = unload_expect_fast(echo_drv,[{monitor,pending}]), + ok = receive X -> {error, X} after 300 -> ok end, ok. -unload_reload_thingie_3(suite) -> - []; -unload_reload_thingie_3(doc) -> - ["Check delayed unload and reload failure"]; +%% Check delayed unload and reload failure unload_reload_thingie_3(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - spawn(F3), - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + spawn(F3), + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok,pending_driver,Ref3} = erl_ddll:try_load(filename:join([Path,"skrumpf"]),echo_drv,[{monitor,pending_driver},{reload,pending_driver}]), - ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive - {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok - after 300 -> error - end, - ?line ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> false end, - ?line ok = receive - {'DOWN',Ref3, driver,echo_drv,{load_failure,_}} -> ok - after 1000 -> false - end, - ?line {'EXIT',_} = (catch erl_ddll:info(echo_drv, port_count)), - ?line {error, not_loaded} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]), - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok,pending_driver,Ref3} = erl_ddll:try_load(filename:join([Path,"skrumpf"]), echo_drv, + [{monitor,pending_driver},{reload,pending_driver}]), + Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), + Pid ! go, + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> false end, + ok = receive + {'DOWN',Ref3, driver,echo_drv,{load_failure,_}} -> ok + after 1000 -> false + end, + {'EXIT',_} = (catch erl_ddll:info(echo_drv, port_count)), + {error, not_loaded} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]), + ok = receive X -> {error, X} after 300 -> ok end, ok. -reload_pending(suite) -> []; -reload_pending(doc) -> ["Reload a driver that is pending on a user"]; +%% Reload a driver that is pending on a user reload_pending(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - Parent ! opened, - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + Parent ! opened, + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line Port = open_port({spawn, echo_drv}, [eof]), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + Port = open_port({spawn, echo_drv}, [eof]), Pid ! go, - ?line receive opened -> ok end, - ?line {error, pending_process} = - erl_ddll:try_load(Path, echo_drv, - [{reload,pending_driver}, - {monitor,pending_driver}]), - ?line {ok, pending_process, Ref3} = - erl_ddll:try_load(Path, echo_drv, - [{reload,pending}, - {monitor,pending}]), - ?line ok = receive X -> {error, X} after 300 -> ok end, + receive opened -> ok end, + {error, pending_process} = + erl_ddll:try_load(Path, echo_drv, + [{reload,pending_driver}, + {monitor,pending_driver}]), + {ok, pending_process, Ref3} = + erl_ddll:try_load(Path, echo_drv, + [{reload,pending}, + {monitor,pending}]), + ok = receive X -> {error, X} after 300 -> ok end, Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive Y -> {error, Y} after 300 -> ok end, - ?line erlang:port_close(Port), - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end, + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive Y -> {error, Y} after 300 -> ok end, + erlang:port_close(Port), + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end, [{Parent,1}] = erl_ddll:info(echo_drv,processes), - ?line ok = receive Z -> {error, Z} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + ok = receive Z -> {error, Z} after 300 -> ok end, ok. -load_fail_init(suite) -> []; -load_fail_init(doc) -> ["Tests failure in the init in driver struct."]; +%% Tests failure in the init in driver struct. load_fail_init(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line PathFailing = ?config(priv_dir, Config), - ?line [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path), - ?line lists:foreach(fun(Name) -> - Src = filename:join([Path,Name]), - Ext = filename:extension(Name), - Dst =filename:join([PathFailing,"echo_drv"++Ext]), - file:delete(Dst), - {ok,_} = file:copy(Src,Dst) - end, - AllFailInits), - ?line [_|_] = filelib:wildcard("echo_drv.*",PathFailing), - ?line {error, driver_init_failed} = erl_ddll:try_load(PathFailing, - echo_drv, - [{monitor,pending}]), - ?line ok = receive XX -> - {unexpected,XX} - after 300 -> - ok - end, - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + PathFailing = proplists:get_value(priv_dir, Config), + [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path), + lists:foreach(fun(Name) -> + Src = filename:join([Path,Name]), + Ext = filename:extension(Name), + Dst =filename:join([PathFailing,"echo_drv"++Ext]), + file:delete(Dst), + {ok,_} = file:copy(Src,Dst) + end, + AllFailInits), + [_|_] = filelib:wildcard("echo_drv.*",PathFailing), + {error, driver_init_failed} = erl_ddll:try_load(PathFailing, + echo_drv, + [{monitor,pending}]), + ok = receive XX -> + {unexpected,XX} + after 300 -> + ok + end, ok. -reload_pending_fail_init(suite) -> []; -reload_pending_fail_init(doc) -> ["Reload a driver that is pending but init fails"]; +%% Reload a driver that is pending but init fails reload_pending_fail_init(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line PathFailing = ?config(priv_dir, Config), - ?line [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path), - ?line lists:foreach(fun(Name) -> - Src = filename:join([Path,Name]), - Ext = filename:extension(Name), - Dst =filename:join([PathFailing,"echo_drv"++Ext]), - file:delete(Dst), - {ok,_} = file:copy(Src,Dst) - end, - AllFailInits), - ?line [_|_] = filelib:wildcard("echo_drv.*",PathFailing), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - Parent ! opened, - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + PathFailing = proplists:get_value(priv_dir, Config), + [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path), + lists:foreach(fun(Name) -> + Src = filename:join([Path,Name]), + Ext = filename:extension(Name), + Dst =filename:join([PathFailing,"echo_drv"++Ext]), + file:delete(Dst), + {ok,_} = file:copy(Src,Dst) + end, + AllFailInits), + [_|_] = filelib:wildcard("echo_drv.*",PathFailing), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + Parent ! opened, + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line Port = open_port({spawn, echo_drv}, [eof]), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + Port = open_port({spawn, echo_drv}, [eof]), Pid ! go, - ?line receive opened -> ok end, - ?line {ok, pending_process, Ref3} = - erl_ddll:try_load(PathFailing, echo_drv, - [{reload,pending}, - {monitor,pending}]), - ?line ok = receive X -> {error, X} after 300 -> ok end, + receive opened -> ok end, + {ok, pending_process, Ref3} = + erl_ddll:try_load(PathFailing, echo_drv, + [{reload,pending}, + {monitor,pending}]), + ok = receive X -> {error, X} after 300 -> ok end, Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive Y -> {error, Y} after 300 -> ok end, - ?line erlang:port_close(Port), - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line ok = receive {'DOWN', Ref3, driver, echo_drv, {load_failure,driver_init_failed}} -> ok after 300 -> error end, - ?line {'EXIT',{badarg,_}} = (catch erl_ddll:info(echo_drv,processes)), - - ?line ok = receive Z -> {error, Z} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive Y -> {error, Y} after 300 -> ok end, + erlang:port_close(Port), + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ok = receive {'DOWN', Ref3, driver, echo_drv, {load_failure,driver_init_failed}} -> ok after 300 -> error end, + {'EXIT',{badarg,_}} = (catch erl_ddll:info(echo_drv,processes)), + + ok = receive Z -> {error, Z} after 300 -> ok end, ok. -reload_pending_kill(suite) -> []; -reload_pending_kill(doc) -> ["Reload a driver with kill_ports option " - "that is pending on a user"]; +%% Reload a driver with kill_ports option that is pending on a user reload_pending_kill(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line OldFlag = process_flag(trap_exit,true), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - process_flag(trap_exit,true), - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]), - spawn(F3), - receive go -> ok end, - Port = open_port({spawn, echo_drv}, [eof]), - Port2 = open_port({spawn, echo_drv}, [eof]), - Parent ! opened, - receive go -> ok end, - receive - {'EXIT', Port2, driver_unloaded} -> - Parent ! first_exit - end, - receive - {'EXIT', Port, driver_unloaded} -> - Parent ! second_exit - end, - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + OldFlag = process_flag(trap_exit,true), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + process_flag(trap_exit,true), + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]), + spawn(F3), + receive go -> ok end, + Port = open_port({spawn, echo_drv}, [eof]), + Port2 = open_port({spawn, echo_drv}, [eof]), + Parent ! opened, + receive go -> ok end, + receive + {'EXIT', Port2, driver_unloaded} -> + Parent ! first_exit + end, + receive + {'EXIT', Port, driver_unloaded} -> + Parent ! second_exit + end, + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]), - ?line {error,inconsistent} = erl_ddll:try_load(Path, echo_drv, []), - ?line Port = open_port({spawn, echo_drv}, [eof]), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]), + {error,inconsistent} = erl_ddll:try_load(Path, echo_drv, []), + Port = open_port({spawn, echo_drv}, [eof]), Pid ! go, - ?line receive opened -> ok end, - ?line {error, pending_process} = - erl_ddll:try_load(Path, echo_drv, - [{driver_options,[kill_ports]}, - {reload,pending_driver}, - {monitor,pending_driver}]), - ?line {ok, pending_process, Ref3} = - erl_ddll:try_load(Path, echo_drv, - [{driver_options,[kill_ports]}, - {reload,pending}, - {monitor,pending}]), - ?line ok = receive - {'EXIT', Port, driver_unloaded} -> - ok - after 300 -> error - end, + receive opened -> ok end, + {error, pending_process} = + erl_ddll:try_load(Path, echo_drv, + [{driver_options,[kill_ports]}, + {reload,pending_driver}, + {monitor,pending_driver}]), + {ok, pending_process, Ref3} = + erl_ddll:try_load(Path, echo_drv, + [{driver_options,[kill_ports]}, + {reload,pending}, + {monitor,pending}]), + ok = receive + {'EXIT', Port, driver_unloaded} -> + ok + after 300 -> error + end, Pid ! go, - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end, - ?line [_,_] = erl_ddll:info(echo_drv,processes), - ?line ok = receive first_exit -> ok after 300 -> error end, - ?line ok = receive second_exit -> ok after 300 -> error end, - ?line 0 = erl_ddll:info(echo_drv,port_count), - ?line ok = receive X -> {error, X} after 300 -> ok end, + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end, + [_,_] = erl_ddll:info(echo_drv,processes), + ok = receive first_exit -> ok after 300 -> error end, + ok = receive second_exit -> ok after 300 -> error end, + 0 = erl_ddll:info(echo_drv,port_count), + ok = receive X -> {error, X} after 300 -> ok end, Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive Y -> {error, Y} after 300 -> ok end, - ?line Port2 = open_port({spawn, echo_drv}, [eof]), - ?line true = is_port(Port2), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive Y -> {error, Y} after 300 -> ok end, + Port2 = open_port({spawn, echo_drv}, [eof]), + true = is_port(Port2), + [{Parent,1}] = erl_ddll:info(echo_drv,processes), + 1 = erl_ddll:info(echo_drv,port_count), + erlang:port_close(Port2), + ok = receive {'EXIT', Port2, normal} -> ok after 300 -> error end, + 0 = erl_ddll:info(echo_drv,port_count), [{Parent,1}] = erl_ddll:info(echo_drv,processes), - ?line 1 = erl_ddll:info(echo_drv,port_count), - ?line erlang:port_close(Port2), - ?line ok = receive {'EXIT', Port2, normal} -> ok after 300 -> error end, - ?line 0 = erl_ddll:info(echo_drv,port_count), - ?line [{Parent,1}] = erl_ddll:info(echo_drv,processes), - ?line Port3 = open_port({spawn, echo_drv}, [eof]), - ?line {ok, pending_driver, Ref4} = - erl_ddll:try_unload(echo_drv,[{monitor,pending_driver}]), - ?line ok = receive - {'EXIT', Port3, driver_unloaded} -> - ok - after 300 -> error - end, - ?line ok = receive {'DOWN', Ref4, driver, echo_drv, unloaded} -> ok after 300 -> error end, + Port3 = open_port({spawn, echo_drv}, [eof]), + {ok, pending_driver, Ref4} = + erl_ddll:try_unload(echo_drv,[{monitor,pending_driver}]), + ok = receive + {'EXIT', Port3, driver_unloaded} -> + ok + after 300 -> error + end, + ok = receive {'DOWN', Ref4, driver, echo_drv, unloaded} -> ok after 300 -> error end, io:format("Port = ~w, Port2 = ~w, Port3 = ~w~n",[Port,Port2,Port3]), - ?line ok = receive Z -> {error, Z} after 300 -> ok end, - ?line process_flag(trap_exit,OldFlag), - ?line test_server:timetrap_cancel(Dog), + ok = receive Z -> {error, Z} after 300 -> ok end, + process_flag(trap_exit,OldFlag), ok. -more_error_codes(suite) -> - []; -more_error_codes(doc) -> - ["Some more error code checking"]; +%% Some more error code checking more_error_codes(Config) when is_list(Config) -> - ?line {error,Err} = erl_ddll:try_load("./echo_dr",echo_dr,[]), - ?line true = is_list(erl_ddll:format_error(Err)), - ?line true = is_list(erl_ddll:format_error(not_loaded)), + {error,Err} = erl_ddll:try_load("./echo_dr",echo_dr,[]), + true = is_list(erl_ddll:format_error(Err)), + true = is_list(erl_ddll:format_error(not_loaded)), ok. -forced_port_killing(suite) -> - []; -forced_port_killing(doc) -> - ["Check kill_ports option to try_unload "]; +%% Check kill_ports option to try_unload forced_port_killing(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line OldFlag=process_flag(trap_exit,true), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line spawn(F3), - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line Port = open_port({spawn, echo_drv}, [eof]), - ?line Port2 = open_port({spawn, echo_drv}, [eof]), - ?line {ok, pending_driver, Ref1} = - erl_ddll:try_unload(echo_drv,[{monitor,pending_driver},kill_ports]), - ?line ok = receive - {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok - after 300 -> error - end, - ?line ok = receive {'EXIT',Port,driver_unloaded} -> ok after 300 -> false end, - ?line ok = receive {'EXIT',Port2,driver_unloaded} -> ok after 300 -> false end, - ?line ok = receive {'DOWN',Ref1, driver, echo_drv, unloaded} -> ok after 300 -> false end, - ?line process_flag(trap_exit,OldFlag), - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + OldFlag=process_flag(trap_exit,true), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + Port = open_port({spawn, echo_drv}, [eof]), + Port2 = open_port({spawn, echo_drv}, [eof]), + {ok, pending_driver, Ref1} = + erl_ddll:try_unload(echo_drv,[{monitor,pending_driver},kill_ports]), + ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ok = receive {'EXIT',Port,driver_unloaded} -> ok after 300 -> false end, + ok = receive {'EXIT',Port2,driver_unloaded} -> ok after 300 -> false end, + ok = receive {'DOWN',Ref1, driver, echo_drv, unloaded} -> ok after 300 -> false end, + process_flag(trap_exit,OldFlag), + ok = receive X -> {error, X} after 300 -> ok end, ok. -no_trap_exit_and_kill_ports(suite) -> - []; -no_trap_exit_and_kill_ports(doc) -> - ["Check delayed unload and reload with no trap_exit"]; +%% Check delayed unload and reload with no trap_exit no_trap_exit_and_kill_ports(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line OldFlag=process_flag(trap_exit,true), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - process_flag(trap_exit,false), - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, - [{driver_options,[kill_ports]}]), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + OldFlag=process_flag(trap_exit,true), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + process_flag(trap_exit,false), + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, + [{driver_options,[kill_ports]}]), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {error, inconsistent} = erl_ddll:try_load(Path, echo_drv, []), - ?line MyPort = open_port({spawn, echo_drv}, [eof]), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {error, inconsistent} = erl_ddll:try_load(Path, echo_drv, []), + MyPort = open_port({spawn, echo_drv}, [eof]), Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line ok = receive {'EXIT',MyPort,driver_unloaded} -> ok after 300 -> error end, - ?line process_flag(trap_exit,OldFlag), - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ok = receive {'EXIT',MyPort,driver_unloaded} -> ok after 300 -> error end, + process_flag(trap_exit,OldFlag), ok. -monitor_demonitor(suite) -> - []; -monitor_demonitor(doc) -> - ["Check monitor and demonitor of drivers"]; +%% Check monitor and demonitor of drivers monitor_demonitor(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:try_load(Path, echo_drv, []), - ?line Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line Self = self(), - ?line [{Self,1}] = erl_ddll:info(echo_drv,awaiting_unload), - ?line true = erl_ddll:demonitor(Ref), - ?line [] = erl_ddll:info(echo_drv,awaiting_unload), - ?line erl_ddll:try_unload(echo_drv,[]), - ?line ok = receive _ -> error after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + erl_ddll:try_load(Path, echo_drv, []), + Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}), + Self = self(), + [{Self,1}] = erl_ddll:info(echo_drv,awaiting_unload), + true = erl_ddll:demonitor(Ref), + [] = erl_ddll:info(echo_drv,awaiting_unload), + erl_ddll:try_unload(echo_drv,[]), + ok = receive _ -> error after 300 -> ok end, ok. -monitor_demonitor_load(suite) -> - []; -monitor_demonitor_load(doc) -> - ["Check monitor/demonitor of driver loading"]; +%% Check monitor/demonitor of driver loading monitor_demonitor_load(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line {ok,loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line Port = open_port({spawn, echo_drv}, [eof]), - ?line Ref = erl_ddll:monitor(driver,{echo_drv,loaded}), - ?line ok = receive {'UP',Ref,driver,echo_drv,loaded} -> ok after 500 -> error end, - ?line {ok, pending_driver} = erl_ddll:try_unload(echo_drv,[]), - ?line Ref2 = erl_ddll:monitor(driver,{echo_drv,loaded}), - ?line ok = receive {'DOWN',Ref2,driver,echo_drv,load_cancelled} -> ok after 0 -> error end, - ?line {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line {ok, pending_driver} = - erl_ddll:try_load(Path, echo_drv, [{reload,pending_driver}]), - ?line Ref3 = erl_ddll:monitor(driver,{echo_drv,loaded}), - ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line ok = receive _ -> error after 300 -> ok end, - ?line Self = self(), - ?line [{Self,1}] = erl_ddll:info(echo_drv,awaiting_load), - ?line true = erl_ddll:demonitor(Ref3), - ?line [] = erl_ddll:info(echo_drv,awaiting_load), - ?line erlang:port_close(Port), - ?line ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> error end, - ?line ok = receive _ -> error after 300 -> ok end, - ?line ok = unload_expect_fast(echo_drv,[]), - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + {ok,loaded} = erl_ddll:try_load(Path, echo_drv, []), + Port = open_port({spawn, echo_drv}, [eof]), + Ref = erl_ddll:monitor(driver,{echo_drv,loaded}), + ok = receive {'UP',Ref,driver,echo_drv,loaded} -> ok after 500 -> error end, + {ok, pending_driver} = erl_ddll:try_unload(echo_drv,[]), + Ref2 = erl_ddll:monitor(driver,{echo_drv,loaded}), + ok = receive {'DOWN',Ref2,driver,echo_drv,load_cancelled} -> ok after 0 -> error end, + {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + {ok, pending_driver} = + erl_ddll:try_load(Path, echo_drv, [{reload,pending_driver}]), + Ref3 = erl_ddll:monitor(driver,{echo_drv,loaded}), + Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ok = receive _ -> error after 300 -> ok end, + Self = self(), + [{Self,1}] = erl_ddll:info(echo_drv,awaiting_load), + true = erl_ddll:demonitor(Ref3), + [] = erl_ddll:info(echo_drv,awaiting_load), + erlang:port_close(Port), + ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> error end, + ok = receive _ -> error after 300 -> ok end, + ok = unload_expect_fast(echo_drv,[]), ok. -new_interface(suite) -> - []; -new_interface(doc) -> - ["Test the new load/unload/reload interface"]; +%% Test the new load/unload/reload interface new_interface(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), % Typical scenario - ?line ok = erl_ddll:load(Path, echo_drv), - ?line Port = open_port({spawn, echo_drv}, [eof]), - ?line ok = erl_ddll:unload(echo_drv), - ?line Port ! {self(), {command, "text"}}, - ?line ok = receive - {Port, {data, "text"}} -> ok; - _ -> error - after - 1000 -> error - end, - ?line Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line erlang:port_close(Port), - ?line ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 300 -> error end, + ok = erl_ddll:load(Path, echo_drv), + Port = open_port({spawn, echo_drv}, [eof]), + ok = erl_ddll:unload(echo_drv), + Port ! {self(), {command, "text"}}, + ok = receive + {Port, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ok = receive X -> {error, X} after 300 -> ok end, + erlang:port_close(Port), + ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 300 -> error end, % More than one user - ?line ok = erl_ddll:load(Path, echo_drv), - ?line Ref2 = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line ok = erl_ddll:load(Path, echo_drv), - ?line ok = erl_ddll:load(Path, echo_drv), - ?line Port2 = open_port({spawn, echo_drv}, [eof]), - ?line ok = erl_ddll:unload(echo_drv), - ?line Port2 ! {self(), {command, "text"}}, - ?line ok = receive - {Port2, {data, "text"}} -> ok; - _ -> error - after - 1000 -> error - end, - ?line ok = erl_ddll:unload(echo_drv), - ?line Port2 ! {self(), {command, "text"}}, - ?line ok = receive - {Port2, {data, "text"}} -> ok; - _ -> error - after - 1000 -> error - end, - ?line ok = erl_ddll:unload(echo_drv), - ?line Port2 ! {self(), {command, "text"}}, - ?line ok = receive - {Port2, {data, "text"}} -> ok; - _ -> error - after - 1000 -> error - end, - ?line ok = receive X2 -> {error, X2} after 300 -> ok end, - ?line ok = erl_ddll:load(Path, echo_drv), - ?line ok = receive {'UP', Ref2, driver, echo_drv, unload_cancelled} -> ok after 300 -> error end, - ?line Ref3 = erl_ddll:monitor(driver,{echo_drv,unloaded_only}), - ?line erlang:port_close(Port2), - ?line ok = receive X3 -> {error, X3} after 300 -> ok end, - ?line ok = erl_ddll:unload(echo_drv), - ?line ok = receive {'DOWN', Ref3, driver, echo_drv, unloaded} -> ok after 300 -> error end, - ?line test_server:timetrap_cancel(Dog), + ok = erl_ddll:load(Path, echo_drv), + Ref2 = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ok = erl_ddll:load(Path, echo_drv), + ok = erl_ddll:load(Path, echo_drv), + Port2 = open_port({spawn, echo_drv}, [eof]), + ok = erl_ddll:unload(echo_drv), + Port2 ! {self(), {command, "text"}}, + ok = receive + {Port2, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + ok = erl_ddll:unload(echo_drv), + Port2 ! {self(), {command, "text"}}, + ok = receive + {Port2, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + ok = erl_ddll:unload(echo_drv), + Port2 ! {self(), {command, "text"}}, + ok = receive + {Port2, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + ok = receive X2 -> {error, X2} after 300 -> ok end, + ok = erl_ddll:load(Path, echo_drv), + ok = receive {'UP', Ref2, driver, echo_drv, unload_cancelled} -> ok after 300 -> error end, + Ref3 = erl_ddll:monitor(driver,{echo_drv,unloaded_only}), + erlang:port_close(Port2), + ok = receive X3 -> {error, X3} after 300 -> ok end, + ok = erl_ddll:unload(echo_drv), + ok = receive {'DOWN', Ref3, driver, echo_drv, unloaded} -> ok after 300 -> error end, ok. - - + + ddll_test(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), - %?line {error,{already_started,ErlDdllPid}} = erl_ddll:start(), - %?line ErlDdllPid = whereis(ddll_server), + %{error,{already_started,ErlDdllPid}} = erl_ddll:start(), + %ErlDdllPid = whereis(ddll_server), %% Load the echo driver and verify that it was loaded. {ok,L1,L2}=load_echo_driver(Path), %% Verify that the driver works. - ?line Port = open_port({spawn, echo_drv}, [eof]), - ?line {hej, "hopp",4711,123445567436543653} = - erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}), - ?line {hej, "hopp",4711,123445567436543653} = - erlang:port_call(Port,47,{hej, "hopp",4711,123445567436543653}), - ?line Port ! {self(), {command, "text"}}, - ?line 1 = receive - {Port, {data, "text"}} -> 1; - _Other -> 2 - after - 1000 -> 2 - end, - ?line Port ! {self(), close}, - ?line receive {Port, closed} -> ok end, - -%% %% Unload the driver and verify that it was unloaded. - ok = unload_echo_driver(L1,L2), - -%% %?line {error, {already_started, _}} = erl_ddll:start(), - - ?line test_server:timetrap_cancel(Dog), + Port = open_port({spawn, echo_drv}, [eof]), + {hej, "hopp",4711,123445567436543653} = + erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}), + {hej, "hopp",4711,123445567436543653} = + erlang:port_call(Port,47,{hej, "hopp",4711,123445567436543653}), + Port ! {self(), {command, "text"}}, + 1 = receive + {Port, {data, "text"}} -> 1; + _Other -> 2 + after + 1000 -> 2 + end, + Port ! {self(), close}, + receive {Port, closed} -> ok end, + + %% %% Unload the driver and verify that it was unloaded. + ok = unload_echo_driver(L1,L2), + + %% %{error, {already_started, _}} = erl_ddll:start(), ok. %% Tests errors having to do with bad drivers. errors(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), - ?line {ok, L1} = erl_ddll:loaded_drivers(), + {ok, L1} = erl_ddll:loaded_drivers(), - ?line {error, {open_error, _}} = erl_ddll:load_driver(Path, bad_name), - ?line {error, driver_init_failed} = erl_ddll:load_driver(Path, initfail_drv), - ?line {error, bad_driver_name} = erl_ddll:load_driver(Path, wrongname_drv), + {error, {open_error, _}} = erl_ddll:load_driver(Path, bad_name), + {error, driver_init_failed} = erl_ddll:load_driver(Path, initfail_drv), + {error, bad_driver_name} = erl_ddll:load_driver(Path, wrongname_drv), %% We assume that there is a statically linked driver named "ddll": - ?line {error, linked_in_driver} = erl_ddll:unload_driver(efile), - ?line {error, not_loaded} = erl_ddll:unload_driver("__pucko_driver__"), - + {error, linked_in_driver} = erl_ddll:unload_driver(efile), + {error, not_loaded} = erl_ddll:unload_driver("__pucko_driver__"), + case os:type() of - {unix, _} -> - ?line {error, no_driver_init} = - erl_ddll:load_driver(Path, noinit_drv); - _ -> - ok + {unix, _} -> + {error, no_driver_init} = + erl_ddll:load_driver(Path, noinit_drv); + _ -> + ok end, - ?line {ok, L1} = erl_ddll:loaded_drivers(), - - ?line test_server:timetrap_cancel(Dog), + {ok, L1} = erl_ddll:loaded_drivers(), ok. -reference_count(doc) -> - ["Check that drivers are unloaded when their reference count ", - "reaches zero, and that they cannot be unloaded while ", - "they are still referenced."]; +%% Check that drivers are unloaded when their reference count +%% reaches zero, and that they cannot be unloaded while +%% they are still referenced. reference_count(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), %% Spawn a process that loads the driver (and holds a reference %% to it). Pid1=spawn_link(?MODULE, echo_loader, [Path, self()]), receive - {Pid1, echo_loaded} -> ok - after 2000 -> test_server:fail("echo_loader failed to start.") + {Pid1, echo_loaded} -> ok + after 2000 -> ct:fail("echo_loader failed to start.") end, Pid1 ! {self(), die}, - ?line test_server:sleep(200), % Give time to unload. - % Verify that the driver was automaticly unloaded when the + test_server:sleep(200), % Give time to unload. + % Verify that the driver was automatically unloaded when the % process died. - ?line {error, not_loaded}=erl_ddll:unload_driver(echo_drv), - - ?line test_server:timetrap_cancel(Dog), + {error, not_loaded}=erl_ddll:unload_driver(echo_drv), ok. % Loads the echo driver, send msg to started, sits and waits to % get a signal to die, then unloads the driver and terminates. echo_loader(Path, Starter) -> - ?line {ok, L1, L2}=load_echo_driver(Path), - ?line Starter ! {self(), echo_loaded}, + {ok, L1, L2}=load_echo_driver(Path), + Starter ! {self(), echo_loaded}, receive - {Starter, die} -> - ?line unload_echo_driver(L1,L2) + {Starter, die} -> + unload_echo_driver(L1,L2) end. % Loads the echo driver, send msg to started, sits and waits to % get a signal to die, then unloads the driver and terminates. nice_echo_loader(Path, Starter) -> - ?line {ok, L1, L2}=load_nice_echo_driver(Path), - ?line Starter ! {self(), echo_loaded}, + {ok, L1, L2}=load_nice_echo_driver(Path), + Starter ! {self(), echo_loaded}, receive - {Starter, die} -> - ?line unload_echo_driver(L1,L2) + {Starter, die} -> + unload_echo_driver(L1,L2) end. -kill_port(doc) -> - ["Test that a port that uses a driver is killed when the ", - "process that loaded the driver dies."]; +%% Test that a port that uses a driver is killed when the +%% process that loaded the driver dies. kill_port(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), %% Spawn a process that loads the driver (and holds a reference %% to it). - ?line Pid1=spawn(?MODULE, echo_loader, [Path, self()]), - ?line receive - {Pid1, echo_loaded} -> - ok - after 3000 -> - ?line exit(Pid1, kill), - ?line test_server:fail("echo_loader failed to start.") - end, + Pid1=spawn(?MODULE, echo_loader, [Path, self()]), + receive + {Pid1, echo_loaded} -> + ok + after 3000 -> + exit(Pid1, kill), + ct:fail("echo_loader failed to start.") + end, % Spawn off a port that uses the driver. - ?line Port = open_port({spawn, echo_drv}, [eof]), + Port = open_port({spawn, echo_drv}, [eof]), % Kill the process / unload the driver. - ?line process_flag(trap_exit, true), - ?line exit(Pid1, kill), - ?line test_server:sleep(200), % Give some time to unload. - ?line {error, not_loaded} = erl_ddll:unload_driver(echo_drv), + process_flag(trap_exit, true), + exit(Pid1, kill), + test_server:sleep(200), % Give some time to unload. + {error, not_loaded} = erl_ddll:unload_driver(echo_drv), % See if the port is killed. receive - {'EXIT', Port, Reason} -> - io:format("Port exited with reason ~w", [Reason]) + {'EXIT', Port, Reason} -> + io:format("Port exited with reason ~w", [Reason]) after 5000 -> - ?line test_server:fail("Echo port did not terminate.") + ct:fail("Echo port did not terminate.") end, - - %% Cleanup and exit. - ?line test_server:timetrap_cancel(Dog), ok. -dont_kill_port(doc) -> - ["Test that a port that uses a driver is not killed when the ", - "process that loaded the driver dies and it's nicely opened."]; +%% Test that a port that uses a driver is not killed when the +%% process that loaded the driver dies and it's nicely opened. dont_kill_port(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), %% Spawn a process that loads the driver (and holds a reference %% to it). - ?line Pid1=spawn(?MODULE, nice_echo_loader, [Path, self()]), - ?line receive - {Pid1, echo_loaded} -> - ok - after 3000 -> - ?line exit(Pid1, kill), - ?line test_server:fail("echo_loader failed to start.") - end, + Pid1=spawn(?MODULE, nice_echo_loader, [Path, self()]), + receive + {Pid1, echo_loaded} -> + ok + after 3000 -> + exit(Pid1, kill), + ct:fail("echo_loader failed to start.") + end, % Spawn off a port that uses the driver. - ?line Port = open_port({spawn, echo_drv}, [eof]), + Port = open_port({spawn, echo_drv}, [eof]), % Kill the process / unload the driver. - ?line process_flag(trap_exit, true), - ?line exit(Pid1, kill), - ?line test_server:sleep(200), % Give some time to unload. - ?line {hej, "hopp",4711,123445567436543653} = - erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}), - ?line [] = erl_ddll:info(echo_drv,processes), + process_flag(trap_exit, true), + exit(Pid1, kill), + test_server:sleep(200), % Give some time to unload. + {hej, "hopp",4711,123445567436543653} = + erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}), + [] = erl_ddll:info(echo_drv,processes), %% unload should work with no owner - ?line ok = erl_ddll:unload_driver(echo_drv), %Kill ports while at it + ok = erl_ddll:unload_driver(echo_drv), %Kill ports while at it % See if the port is killed. receive - {'EXIT', Port, Reason} -> - io:format("Port exited with reason ~w", [Reason]) + {'EXIT', Port, Reason} -> + io:format("Port exited with reason ~w", [Reason]) after 5000 -> - ?line test_server:fail("Echo port did not terminate.") + ct:fail("Echo port did not terminate.") end, - - %% Cleanup and exit. - ?line test_server:timetrap_cancel(Dog), ok. -properties(doc) -> ["Test that a process that loaded a driver ", - "is the only process that can unload it."]; +%% Test that a process that loaded a driver +%% is the only process that can unload it. properties(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), % Let another process load the echo driver. Pid=spawn_link(?MODULE, echo_loader, [Path, self()]), receive - {Pid, echo_loaded} -> ok - after 2000 -> test_server:fail("echo_loader failed to start.") + {Pid, echo_loaded} -> ok + after 2000 -> ct:fail("echo_loader failed to start.") end, % Try to unload the driver from this process (the wrong one). - ?line {error, _} = erl_ddll:unload_driver(echo_drv), - ?line {ok, Drivers} = erl_ddll:loaded_drivers(), - ?line case lists:member("echo_drv", Drivers) of - true -> - ok; - false -> - test_server:fail("Unload from wrong process " - "succeeded.") - end, + {error, _} = erl_ddll:unload_driver(echo_drv), + {ok, Drivers} = erl_ddll:loaded_drivers(), + case lists:member("echo_drv", Drivers) of + true -> + ok; + false -> + ct:fail("Unload from wrong process succeeded.") + end, % Unload the driver and terminate dummy process. - ?line Pid ! {self(), die}, - ?line test_server:sleep(200), % Give time to unload. - ?line test_server:timetrap_cancel(Dog), + Pid ! {self(), die}, + test_server:sleep(200), % Give time to unload. ok. -load_and_unload(doc) -> ["Load two drivers and unload them in load order."]; +%% Load two drivers and unload them in load order. load_and_unload(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line Path = ?config(data_dir, Config), - ?line {ok, Loaded_drivers1} = erl_ddll:loaded_drivers(), - ?line ok = erl_ddll:load_driver(Path, echo_drv), - ?line ok = erl_ddll:load_driver(Path, dummy_drv), - ?line ok = erl_ddll:unload_driver(echo_drv), - ?line ok = erl_ddll:unload_driver(dummy_drv), - ?line {ok, Loaded_drivers2} = erl_ddll:loaded_drivers(), - ?line Set1 = ordsets:from_list(Loaded_drivers1), - ?line Set2 = ordsets:from_list(Loaded_drivers2), - ?line io:format("~p == ~p\n", [Loaded_drivers1, Loaded_drivers2]), - ?line [] = ordsets:to_list(ordsets:subtract(Set2, Set1)), - - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + {ok, Loaded_drivers1} = erl_ddll:loaded_drivers(), + ok = erl_ddll:load_driver(Path, echo_drv), + ok = erl_ddll:load_driver(Path, dummy_drv), + ok = erl_ddll:unload_driver(echo_drv), + ok = erl_ddll:unload_driver(dummy_drv), + {ok, Loaded_drivers2} = erl_ddll:loaded_drivers(), + Set1 = ordsets:from_list(Loaded_drivers1), + Set2 = ordsets:from_list(Loaded_drivers2), + io:format("~p == ~p\n", [Loaded_drivers1, Loaded_drivers2]), + [] = ordsets:to_list(ordsets:subtract(Set2, Set1)), ok. -lock_driver(suite) -> - []; -lock_driver(doc) -> - ["Check multiple calls to driver_lock_driver"]; +%% Check multiple calls to driver_lock_driver lock_driver(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line {ok, _} = erl_ddll:try_load(Path, lock_drv, []), - ?line Port1 = open_port({spawn, lock_drv}, [eof]), - ?line Port2 = open_port({spawn, lock_drv}, [eof]), - ?line true = erl_ddll:info(lock_drv,permanent), - ?line erlang:port_close(Port1), - ?line erlang:port_close(Port2), - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + {ok, _} = erl_ddll:try_load(Path, lock_drv, []), + Port1 = open_port({spawn, lock_drv}, [eof]), + Port2 = open_port({spawn, lock_drv}, [eof]), + true = erl_ddll:info(lock_drv,permanent), + erlang:port_close(Port1), + erlang:port_close(Port2), ok. - + % Load and unload the echo_drv driver. % Make sure that the driver doesn't exist before we load it, % and that it exists before we unload it. load_echo_driver(Path) -> - ?line {ok, L1} = erl_ddll:loaded_drivers(), - ?line ok = erl_ddll:load_driver(Path, echo_drv), - ?line {ok, L2} = erl_ddll:loaded_drivers(), - ?line ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2), - ordsets:from_list(L1))), + {ok, L1} = erl_ddll:loaded_drivers(), + ok = erl_ddll:load_driver(Path, echo_drv), + {ok, L2} = erl_ddll:loaded_drivers(), + ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2), + ordsets:from_list(L1))), {ok,L1,L2}. load_nice_echo_driver(Path) -> - ?line {ok, L1} = erl_ddll:loaded_drivers(), - ?line ok = erl_ddll:load(Path, echo_drv), - ?line {ok, L2} = erl_ddll:loaded_drivers(), - ?line ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2), - ordsets:from_list(L1))), + {ok, L1} = erl_ddll:loaded_drivers(), + ok = erl_ddll:load(Path, echo_drv), + {ok, L2} = erl_ddll:loaded_drivers(), + ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2), + ordsets:from_list(L1))), {ok,L1,L2}. unload_echo_driver(L1,L2) -> - ?line {ok, L2} = erl_ddll:loaded_drivers(), - ?line ok = erl_ddll:unload_driver(echo_drv), - ?line {ok, L3} = erl_ddll:loaded_drivers(), - ?line [] = ordsets:to_list(subtract(ordsets:from_list(L3), - ordsets:from_list(L1))), + {ok, L2} = erl_ddll:loaded_drivers(), + ok = erl_ddll:unload_driver(echo_drv), + {ok, L3} = erl_ddll:loaded_drivers(), + [] = ordsets:to_list(subtract(ordsets:from_list(L3), + ordsets:from_list(L1))), ok. unload_expect_fast(Driver,XFlags) -> {ok, pending_driver, Ref} = - erl_ddll:try_unload(Driver, - [{monitor,pending_driver}]++XFlags), + erl_ddll:try_unload(Driver, + [{monitor,pending_driver}]++XFlags), receive - {'DOWN', Ref, driver, Driver, unloaded} -> - case lists:member(atom_to_list(Driver),element(2,erl_ddll:loaded_drivers())) of - true -> - {error, {still_there, Driver}}; - false -> - ok - end + {'DOWN', Ref, driver, Driver, unloaded} -> + case lists:member(atom_to_list(Driver),element(2,erl_ddll:loaded_drivers())) of + true -> + {error, {still_there, Driver}}; + false -> + ok + end after 1000 -> - {error,{unable_to_unload, Driver}} + {error,{unable_to_unload, Driver}} end. diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index 2baf91cf29..0ccdbd7ee8 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,15 +22,16 @@ -module(decode_packet_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1, +-export([all/0, suite/0,groups/0, + init_per_testcase/2,end_per_testcase/2, + basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1, otp_9389/1, otp_9389_line/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [basic, packet_size, neg, http, line, ssl, otp_8536, @@ -38,67 +40,49 @@ all() -> groups() -> []. -init_per_suite(Config) -> +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + rand:seed(exsplus), + io:format("*** SEED: ~p ***\n", [rand:export_seed()]), Config. -end_per_suite(_Config) -> +end_per_testcase(_Func, _Config) -> ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Seed = {S1,S2,S3} = now(), - random:seed(S1,S2,S3), - io:format("*** SEED: ~p ***\n", [Seed]), - Dog=?t:timetrap(?t:minutes(1)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -basic(doc) -> []; -basic(suite) -> []; basic(Config) when is_list(Config) -> - ?line Packet = <<101,22,203,54,175>>, - ?line Rest = <<123,34,0,250>>, - ?line Bin = <<Packet/binary,Rest/binary>>, - ?line {ok, Bin, <<>>} = decode_pkt(raw,Bin), + Packet = <<101,22,203,54,175>>, + Rest = <<123,34,0,250>>, + Bin = <<Packet/binary,Rest/binary>>, + {ok, Bin, <<>>} = decode_pkt(raw,Bin), - ?line {more, 5+1} = decode_pkt(1,<<5,1,2,3,4>>), - ?line {more, 5+2} = decode_pkt(2,<<0,5,1,2,3,4>>), - ?line {more, 5+4} = decode_pkt(4,<<0,0,0,5,1,2,3,4>>), + {more, 5+1} = decode_pkt(1,<<5,1,2,3,4>>), + {more, 5+2} = decode_pkt(2,<<0,5,1,2,3,4>>), + {more, 5+4} = decode_pkt(4,<<0,0,0,5,1,2,3,4>>), - ?line {more, undefined} = decode_pkt(1,<<>>), - ?line {more, undefined} = decode_pkt(2,<<0>>), - ?line {more, undefined} = decode_pkt(4,<<0,0,0>>), + {more, undefined} = decode_pkt(1,<<>>), + {more, undefined} = decode_pkt(2,<<0>>), + {more, undefined} = decode_pkt(4,<<0,0,0>>), Types = [1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls], %% Run tests for different header types and bit offsets. lists:foreach(fun({Type,Bits})->basic_pack(Type,Packet,Rest,Bits), - more_length(Type,Packet,Bits) end, - [{T,B} || T<-Types, B<-lists:seq(0,32)]), + more_length(Type,Packet,Bits) end, + [{T,B} || T<-Types, B<-lists:seq(0,32)]), ok. basic_pack(Type,Body,Rest,BitOffs) -> - ?line {Bin,Unpacked,_} = pack(Type,Body,Rest,BitOffs), - ?line {ok, Unpacked, Rest} = decode_pkt(Type,Bin), + {Bin,Unpacked,_} = pack(Type,Body,Rest,BitOffs), + {ok, Unpacked, Rest} = decode_pkt(Type,Bin), case Rest of - <<>> -> ok; - _ -> - ?line <<_:1,NRest/bits>> = Rest, - basic_pack(Type,Body,NRest,BitOffs) + <<>> -> ok; + _ -> + <<_:1,NRest/bits>> = Rest, + basic_pack(Type,Body,NRest,BitOffs) end. more_length(Type,Body,BitOffs) -> - ?line {Bin,_,_} = pack(Type,Body,<<>>,BitOffs), + {Bin,_,_} = pack(Type,Body,<<>>,BitOffs), HdrSize = byte_size(Bin) - byte_size(Body), more_length_do(Type,HdrSize,Bin,byte_size(Bin)). @@ -107,17 +91,17 @@ more_length_do(_,_,_,0) -> more_length_do(Type,HdrSize,Bin,Size) -> TrySize = (Size*3) div 4, NSize = if TrySize < HdrSize -> Size - 1; - true -> TrySize - end, + true -> TrySize + end, {B1,_} = split_binary(Bin,NSize), - ?line {more, Length} = decode_pkt(Type,B1), + {more, Length} = decode_pkt(Type,B1), case Length of - L when L=:=byte_size(Bin) -> ok; - undefined when NSize<HdrSize -> ok + L when L=:=byte_size(Bin) -> ok; + undefined when NSize<HdrSize -> ok end, more_length_do(Type,HdrSize,Bin,NSize). - + pack(Type,Packet,Rest) -> {Bin,Unpacked} = pack(Type,Packet), @@ -133,7 +117,7 @@ pack(Type,Body,Rest,BitOffs) -> {Packet,Unpacked} = pack(Type,Body), %% Make Bin a sub-bin with an arbitrary bitoffset within Orig - Prefix = random:uniform(1 bsl BitOffs) - 1, + Prefix = rand:uniform(1 bsl BitOffs) - 1, Orig = <<Prefix:BitOffs,Packet/binary,Rest/bits>>, <<_:BitOffs,Bin/bits>> = Orig, {Bin,Unpacked,Orig}. @@ -148,212 +132,206 @@ pack(4,Bin) -> Psz = byte_size(Bin), {<<Psz:32,Bin/binary>>, Bin}; pack(asn1,Bin) -> - Ident = case random:uniform(3) of - 1 -> <<17>>; - 2 -> <<16#1f,16#81,17>>; - 3 -> <<16#1f,16#81,16#80,16#80,17>> - end, + Ident = case rand:uniform(3) of + 1 -> <<17>>; + 2 -> <<16#1f,16#81,17>>; + 3 -> <<16#1f,16#81,16#80,16#80,17>> + end, Psz = byte_size(Bin), - Length = case random:uniform(4) of - 1 when Psz < 128 -> - <<Psz:8>>; - R when R=<2 andalso Psz < 16#10000 -> - <<16#82,Psz:16>>; - R when R=<3 andalso Psz < 16#1000000 -> - <<16#83,Psz:24>>; - _ when Psz < 16#100000000 -> - <<16#84,Psz:32>> - end, + Length = case rand:uniform(4) of + 1 when Psz < 128 -> + <<Psz:8>>; + R when R=<2 andalso Psz < 16#10000 -> + <<16#82,Psz:16>>; + R when R=<3 andalso Psz < 16#1000000 -> + <<16#83,Psz:24>>; + _ when Psz < 16#100000000 -> + <<16#84,Psz:32>> + end, Res = <<Ident/binary,Length/binary,Bin/binary>>, {Res,Res}; pack(sunrm,Bin) -> Psz = byte_size(Bin), Res = if Psz < 16#80000000 -> - <<Psz:32,Bin/binary>> - end, + <<Psz:32,Bin/binary>> + end, {Res,Res}; pack(cdr,Bin) -> GIOP = <<"GIOP">>, - Major = random:uniform(256) - 1, - Minor = random:uniform(256) - 1, - MType = random:uniform(256) - 1, + Major = rand:uniform(256) - 1, + Minor = rand:uniform(256) - 1, + MType = rand:uniform(256) - 1, Psz = byte_size(Bin), - Res = case random:uniform(2) of - 1 -> <<GIOP/binary,Major:8,Minor:8,0:8,MType:8,Psz:32/big,Bin/binary>>; - 2 -> <<GIOP/binary,Major:8,Minor:8,1:8,MType:8,Psz:32/little,Bin/binary>> - end, + Res = case rand:uniform(2) of + 1 -> <<GIOP/binary,Major:8,Minor:8,0:8,MType:8,Psz:32/big,Bin/binary>>; + 2 -> <<GIOP/binary,Major:8,Minor:8,1:8,MType:8,Psz:32/little,Bin/binary>> + end, {Res,Res}; pack(fcgi,Bin) -> Ver = 1, - Type = random:uniform(256) - 1, - Id = random:uniform(65536) - 1, - PaddSz = random:uniform(16) - 1, + Type = rand:uniform(256) - 1, + Id = rand:uniform(65536) - 1, + PaddSz = rand:uniform(16) - 1, Psz = byte_size(Bin), - Reserv = random:uniform(256) - 1, + Reserv = rand:uniform(256) - 1, Padd = case PaddSz of - 0 -> <<>>; - _ -> list_to_binary([random:uniform(256)-1 - || _<- lists:seq(1,PaddSz)]) - end, + 0 -> <<>>; + _ -> list_to_binary([rand:uniform(256)-1 + || _<- lists:seq(1,PaddSz)]) + end, Res = <<Ver:8,Type:8,Id:16,Psz:16/big,PaddSz:8,Reserv:8,Bin/binary>>, {<<Res/binary,Padd/binary>>, Res}; pack(tpkt,Bin) -> Ver = 3, - Reserv = random:uniform(256) - 1, + Reserv = rand:uniform(256) - 1, Size = byte_size(Bin) + 4, Res = <<Ver:8,Reserv:8,Size:16,Bin/binary>>, {Res, Res}; pack(ssl_tls,Bin) -> - Content = case (random:uniform(256) - 1) of - C when C<128 -> C; - _ -> v2hello - end, - Major = random:uniform(256) - 1, - Minor = random:uniform(256) - 1, + Content = case (rand:uniform(256) - 1) of + C when C<128 -> C; + _ -> v2hello + end, + Major = rand:uniform(256) - 1, + Minor = rand:uniform(256) - 1, pack_ssl(Content,Major,Minor,Bin). pack_ssl(Content, Major, Minor, Body) -> case Content of - v2hello -> - Size = byte_size(Body), - Res = <<1:1,(Size+3):15, 1:8, Major:8, Minor:8, Body/binary>>, - C = 22, - Data = <<1:8, (Size+2):24, Major:8, Minor:8, Body/binary>>; - C when is_integer(C) -> - Size = byte_size(Body), - Res = <<Content:8, Major:8, Minor:8, Size:16, Body/binary>>, - Data = Body + v2hello -> + Size = byte_size(Body), + Res = <<1:1,(Size+3):15, 1:8, Major:8, Minor:8, Body/binary>>, + C = 22, + Data = <<1:8, (Size+2):24, Major:8, Minor:8, Body/binary>>; + C when is_integer(C) -> + Size = byte_size(Body), + Res = <<Content:8, Major:8, Minor:8, Size:16, Body/binary>>, + Data = Body end, {Res, {ssl_tls,[],C,{Major,Minor}, Data}}. -packet_size(doc) -> []; -packet_size(suite) -> []; packet_size(Config) when is_list(Config) -> - ?line Packet = <<101,22,203,54,175>>, - ?line Rest = <<123,34,0,250>>, + Packet = <<101,22,203,54,175>>, + Rest = <<123,34,0,250>>, F = fun({Type,Max})-> - ?line {Bin,Unpacked} = pack(Type,Packet,Rest), - ?line case decode_pkt(Type,Bin,[{packet_size,Max}]) of - {ok,Unpacked,Rest} when Max=:=0; Max>=byte_size(Packet) -> - ok; - {error,_} when Max<byte_size(Packet), Max=/=0 -> - ok; - {error,_} when Type=:=fcgi, Max=/=0 -> - %% packet includes random amount of padding - ok - end - end, - ?line lists:foreach(F, [{T,D} || T<-[1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls], - D<-lists:seq(0, byte_size(Packet)*2)]), + {Bin,Unpacked} = pack(Type,Packet,Rest), + case decode_pkt(Type,Bin,[{packet_size,Max}]) of + {ok,Unpacked,Rest} when Max=:=0; Max>=byte_size(Packet) -> + ok; + {error,_} when Max<byte_size(Packet), Max=/=0 -> + ok; + {error,_} when Type=:=fcgi, Max=/=0 -> + %% packet includes random amount of padding + ok + end + end, + lists:foreach(F, [{T,D} || T<-[1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls], + D<-lists:seq(0, byte_size(Packet)*2)]), %% Test OTP-8102, "negative" 4-byte sizes. lists:foreach(fun(Size) -> - ?line {error,_} = decode_pkt(4,<<Size:32,Packet/binary>>) - end, - lists:seq(-10,-1)), + {error,_} = decode_pkt(4,<<Size:32,Packet/binary>>) + end, + lists:seq(-10,-1)), %% Test OTP-9389, long HTTP header lines. Opts = [{packet_size, 128}], Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", - string:chars($Y, 64), "\r\n\r\n"]), + lists:duplicate(64, $Y), "\r\n\r\n"]), <<Pkt1:50/binary, Pkt2/binary>> = Pkt, - ?line {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = - erlang:decode_packet(http, Pkt1, Opts), - ?line {ok, {http_header,_,'Host',_,"localhost"}, Rest2} = - erlang:decode_packet(httph, Rest1, Opts), - ?line {more, undefined} = erlang:decode_packet(httph, Rest2, Opts), - ?line {ok, {http_header,_,"Link",_,_}, _} = - erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), + {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = + erlang:decode_packet(http, Pkt1, Opts), + {ok, {http_header,_,'Host',_,"localhost"}, Rest2} = + erlang:decode_packet(httph, Rest1, Opts), + {more, undefined} = erlang:decode_packet(httph, Rest2, Opts), + {ok, {http_header,_,"Link",_,_}, _} = + erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), Pkt3 = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", - string:chars($Y, 129), "\r\n\r\n"]), - ?line {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest3} = - erlang:decode_packet(http, Pkt3, Opts), - ?line {ok, {http_header,_,'Host',_,"localhost"}, Rest4} = - erlang:decode_packet(httph, Rest3, Opts), - ?line {error, invalid} = erlang:decode_packet(httph, Rest4, Opts), + lists:duplicate(129, $Y), "\r\n\r\n"]), + {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest3} = + erlang:decode_packet(http, Pkt3, Opts), + {ok, {http_header,_,'Host',_,"localhost"}, Rest4} = + erlang:decode_packet(httph, Rest3, Opts), + {error, invalid} = erlang:decode_packet(httph, Rest4, Opts), ok. -neg(doc) -> []; -neg(suite) -> []; neg(Config) when is_list(Config) -> - ?line Bin = <<"dummy">>, + Bin = <<"dummy">>, Fun = fun()->dummy end, - + BadargF = fun(T,B,Opts)-> {'EXIT',{badarg,_}} = (catch decode_pkt(T,B,Opts)) end, %% Invalid Type args lists:foreach(fun(T)-> BadargF(T,Bin,[]) end, - [3,-1,5,2.0,{2},unknown,[],"line",Bin,Fun,self()]), + [3,-1,5,2.0,{2},unknown,[],"line",Bin,Fun,self()]), %% Invalid Bin args lists:foreach(fun(B)-> BadargF(0,B,[]) end, - [3,2.0,unknown,[],"Bin",[Bin],{Bin},Fun,self()]), + [3,2.0,unknown,[],"Bin",[Bin],{Bin},Fun,self()]), %% Invalid options InvOpts = [2,false,self(),Bin,"Options",Fun, - packet_size,{packet_size},{packet_size,0,false}, - {packet_size,-1},{packet_size,100.0},{packet_size,false}, - {line_length,-1},{line_length,100.0},{line_length,false}], + packet_size,{packet_size},{packet_size,0,false}, + {packet_size,-1},{packet_size,100.0},{packet_size,false}, + {line_length,-1},{line_length,100.0},{line_length,false}], lists:foreach(fun(Opt)-> BadargF(0,Bin,Opt), - BadargF(0,Bin,[Opt]), - BadargF(0,Bin,[Opt,{packet_size,1000}]), - BadargF(0,Bin,[{packet_size,1000},Opt]) end, - InvOpts), + BadargF(0,Bin,[Opt]), + BadargF(0,Bin,[Opt,{packet_size,1000}]), + BadargF(0,Bin,[{packet_size,1000},Opt]) end, + InvOpts), ok. -http(doc) -> []; -http(suite) -> []; http(Config) when is_list(Config) -> - ?line <<"foo">> = http_do(http_request("foo")), - ?line <<" bar">> = http_do(http_request(" bar")), - ?line <<"Hello!">> = http_do(http_response("Hello!")), + <<"foo">> = http_do(http_request("foo")), + <<" bar">> = http_do(http_request(" bar")), + <<"Hello!">> = http_do(http_response("Hello!")), %% Test all known header atoms Val = "dummy value", ValB = list_to_binary(Val), Rest = <<"Rest">>, HdrF = fun(Str,N) -> - ?line StrA = list_to_atom(Str), - ?line StrB = list_to_binary(Str), - ?line Bin = <<StrB/binary,": ",ValB/binary,"\r\n",Rest/binary>>, - ?line {ok, {http_header,N,StrA,undefined,Val}, Rest} = decode_pkt(httph,Bin), - ?line {ok, {http_header,N,StrA,undefined,ValB}, Rest} = decode_pkt(httph_bin,Bin), - ?line N + 1 - end, - ?line lists:foldl(HdrF, 1, http_hdr_strings()), + StrA = list_to_atom(Str), + StrB = list_to_binary(Str), + Bin = <<StrB/binary,": ",ValB/binary,"\r\n",Rest/binary>>, + {ok, {http_header,N,StrA,undefined,Val}, Rest} = decode_pkt(httph,Bin), + {ok, {http_header,N,StrA,undefined,ValB}, Rest} = decode_pkt(httph_bin,Bin), + N + 1 + end, + lists:foldl(HdrF, 1, http_hdr_strings()), %% Test all known method atoms MethF = fun(Meth) -> - ?line MethA = list_to_atom(Meth), - ?line MethB = list_to_binary(Meth), - ?line Bin = <<MethB/binary," /invalid/url HTTP/1.0\r\n",Rest/binary>>, - ?line {ok, {http_request,MethA,{abs_path,"/invalid/url"},{1,0}}, - Rest} = decode_pkt(http,Bin), - ?line {ok, {http_request,MethA,{abs_path,<<"/invalid/url">>},{1,0}}, - Rest} = decode_pkt(http_bin,Bin) - end, - ?line lists:foreach(MethF, http_meth_strings()), + MethA = list_to_atom(Meth), + MethB = list_to_binary(Meth), + Bin = <<MethB/binary," /invalid/url HTTP/1.0\r\n",Rest/binary>>, + {ok, {http_request,MethA,{abs_path,"/invalid/url"},{1,0}}, + Rest} = decode_pkt(http,Bin), + {ok, {http_request,MethA,{abs_path,<<"/invalid/url">>},{1,0}}, + Rest} = decode_pkt(http_bin,Bin) + end, + lists:foreach(MethF, http_meth_strings()), %% Test all uri variants UriF = fun({Str,ResL,ResB}) -> - Bin = <<"GET ",(list_to_binary(Str))/binary," HTTP/1.1\r\n",Rest/binary>>, - {ok, {http_request, 'GET', ResL, {1,1}}, Rest} = decode_pkt(http,Bin), - {ok, {http_request, 'GET', ResB, {1,1}}, Rest} = decode_pkt(http_bin,Bin) - end, + Bin = <<"GET ",(list_to_binary(Str))/binary," HTTP/1.1\r\n",Rest/binary>>, + {ok, {http_request, 'GET', ResL, {1,1}}, Rest} = decode_pkt(http,Bin), + {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_response,{1,1},200,[]},<<>>} = decode_pkt(http, <<"HTTP/1.1 200\r\n">>, []), + {ok,{http_response,{1,1},200,<<>>},<<>>} = decode_pkt(http_bin, <<"HTTP/1.1 200\r\n">>, []), ok. - + http_with_bin(http) -> http_bin; http_with_bin(httph) -> @@ -364,88 +342,88 @@ http_do(Tup) -> http_do({Bin, []}, _) -> Bin; http_do({Bin,[{_Line,PL,PB}|Tail]}, Type) -> - ?line {ok, PL, Rest} = decode_pkt(Type,Bin), - ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),Bin), + {ok, PL, Rest} = decode_pkt(Type,Bin), + {ok, PB, Rest} = decode_pkt(http_with_bin(Type),Bin), %% Same tests again but as SubBin - PreLen = random:uniform(64), - Prefix = random:uniform(1 bsl PreLen) - 1, - SufLen = random:uniform(64), - Suffix = random:uniform(1 bsl SufLen) - 1, + PreLen = rand:uniform(64), + Prefix = rand:uniform(1 bsl PreLen) - 1, + SufLen = rand:uniform(64), + Suffix = rand:uniform(1 bsl SufLen) - 1, Orig = <<Prefix:PreLen, Bin/bits, Suffix:SufLen>>, BinLen = bit_size(Bin), <<_:PreLen, SubBin:BinLen/bits, _/bits>> = Orig, % Make SubBin - ?line SubBin = Bin, % just to make sure + SubBin = Bin, % just to make sure - ?line {ok, PL, Rest} = decode_pkt(Type,SubBin), - ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),SubBin), + {ok, PL, Rest} = decode_pkt(Type,SubBin), + {ok, PB, Rest} = decode_pkt(http_with_bin(Type),SubBin), http_do({Rest, Tail}, httph). http_request(Msg) -> QnA = [{"POST /invalid/url HTTP/1.1\r\n", - {http_request, 'POST', {abs_path, "/invalid/url" }, {1,1}}, - {http_request, 'POST', {abs_path,<<"/invalid/url">>}, {1,1}}}, - {"Connection: close\r\n", - {http_header,2,'Connection',undefined, "close"}, - {http_header,2,'Connection',undefined,<<"close">>}}, - {"Host\t : localhost:8000\r\n", % white space before : - {http_header,14,'Host',undefined, "localhost:8000"}, - {http_header,14,'Host',undefined,<<"localhost:8000">>}}, - {"User-Agent: perl post\r\n", - {http_header,24,'User-Agent',undefined, "perl post"}, - {http_header,24,'User-Agent',undefined,<<"perl post">>}}, - {"Content-Length: 4\r\n", - {http_header,38,'Content-Length',undefined, "4"}, - {http_header,38,'Content-Length',undefined,<<"4">>}}, - {"Content-Type: text/xml; charset=utf-8\r\n", - {http_header,42,'Content-Type',undefined, "text/xml; charset=utf-8"}, - {http_header,42,'Content-Type',undefined,<<"text/xml; charset=utf-8">>}}, - {"Other-Field: with some text\r\n", - {http_header,0, "Other-Field" ,undefined, "with some text"}, - {http_header,0,<<"Other-Field">>,undefined,<<"with some text">>}}, - {"Make-sure-a-LONG-HEaDer-fIeLd-is-fORMATTED-NicelY: with some text\r\n", - {http_header,0, "Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely" ,undefined, "with some text"}, - {http_header,0,<<"Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely">>,undefined,<<"with some text">>}}, - {"Multi-Line: Once upon a time in a land far far away,\r\n" - " there lived a princess imprisoned in the highest tower\r\n" - " of the most haunted castle.\r\n", - {http_header,0, "Multi-Line" ,undefined, "Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle."}, - {http_header,0,<<"Multi-Line">>,undefined,<<"Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle.">>}}, - {"\r\n", - http_eoh, - http_eoh}], + {http_request, 'POST', {abs_path, "/invalid/url" }, {1,1}}, + {http_request, 'POST', {abs_path,<<"/invalid/url">>}, {1,1}}}, + {"Connection: close\r\n", + {http_header,2,'Connection',undefined, "close"}, + {http_header,2,'Connection',undefined,<<"close">>}}, + {"Host\t : localhost:8000\r\n", % white space before : + {http_header,14,'Host',undefined, "localhost:8000"}, + {http_header,14,'Host',undefined,<<"localhost:8000">>}}, + {"User-Agent: perl post\r\n", + {http_header,24,'User-Agent',undefined, "perl post"}, + {http_header,24,'User-Agent',undefined,<<"perl post">>}}, + {"Content-Length: 4\r\n", + {http_header,38,'Content-Length',undefined, "4"}, + {http_header,38,'Content-Length',undefined,<<"4">>}}, + {"Content-Type: text/xml; charset=utf-8\r\n", + {http_header,42,'Content-Type',undefined, "text/xml; charset=utf-8"}, + {http_header,42,'Content-Type',undefined,<<"text/xml; charset=utf-8">>}}, + {"Other-Field: with some text\r\n", + {http_header,0, "Other-Field" ,undefined, "with some text"}, + {http_header,0,<<"Other-Field">>,undefined,<<"with some text">>}}, + {"Make-sure-a-LONG-HEaDer-fIeLd-is-fORMATTED-NicelY: with some text\r\n", + {http_header,0, "Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely" ,undefined, "with some text"}, + {http_header,0,<<"Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely">>,undefined,<<"with some text">>}}, + {"Multi-Line: Once upon a time in a land far far away,\r\n" + " there lived a princess imprisoned in the highest tower\r\n" + " of the most haunted castle.\r\n", + {http_header,0, "Multi-Line" ,undefined, "Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle."}, + {http_header,0,<<"Multi-Line">>,undefined,<<"Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle.">>}}, + {"\r\n", + http_eoh, + http_eoh}], Bin = lists:foldl(fun({Line,_,_},Acc) -> LineBin = list_to_binary(Line), - <<Acc/binary,LineBin/binary>> end, - <<"">>, QnA), + <<Acc/binary,LineBin/binary>> end, + <<"">>, QnA), MsgBin = list_to_binary(Msg), {<<Bin/binary,MsgBin/binary>>, QnA}. http_response(Msg) -> QnA = [{"HTTP/1.0 404 Object Not Found\r\n", - {http_response, {1,0}, 404, "Object Not Found"}, - {http_response, {1,0}, 404, <<"Object Not Found">>}}, - {"Server: inets/4.7.16\r\n", - {http_header, 30, 'Server', undefined, "inets/4.7.16"}, - {http_header, 30, 'Server', undefined, <<"inets/4.7.16">>}}, - {"Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n", - {http_header, 3, 'Date', undefined, "Fri, 04 Jul 2008 17:16:22 GMT"}, - {http_header, 3, 'Date', undefined, <<"Fri, 04 Jul 2008 17:16:22 GMT">>}}, - {"Content-Type: text/html\r\n", - {http_header, 42, 'Content-Type', undefined, "text/html"}, - {http_header, 42, 'Content-Type', undefined, <<"text/html">>}}, - {"Content-Length: 207\r\n", - {http_header, 38, 'Content-Length', undefined, "207"}, - {http_header, 38, 'Content-Length', undefined, <<"207">>}}, - {"\r\n", - http_eoh, - http_eoh}], + {http_response, {1,0}, 404, "Object Not Found"}, + {http_response, {1,0}, 404, <<"Object Not Found">>}}, + {"Server: inets/4.7.16\r\n", + {http_header, 30, 'Server', undefined, "inets/4.7.16"}, + {http_header, 30, 'Server', undefined, <<"inets/4.7.16">>}}, + {"Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n", + {http_header, 3, 'Date', undefined, "Fri, 04 Jul 2008 17:16:22 GMT"}, + {http_header, 3, 'Date', undefined, <<"Fri, 04 Jul 2008 17:16:22 GMT">>}}, + {"Content-Type: text/html\r\n", + {http_header, 42, 'Content-Type', undefined, "text/html"}, + {http_header, 42, 'Content-Type', undefined, <<"text/html">>}}, + {"Content-Length: 207\r\n", + {http_header, 38, 'Content-Length', undefined, "207"}, + {http_header, 38, 'Content-Length', undefined, <<"207">>}}, + {"\r\n", + http_eoh, + http_eoh}], Bin = lists:foldl(fun({Line,_,_},Acc) -> LineBin = list_to_binary(Line), - <<Acc/binary,LineBin/binary>> end, - <<"">>, QnA), + <<Acc/binary,LineBin/binary>> end, + <<"">>, QnA), MsgBin = list_to_binary(Msg), {<<Bin/binary,MsgBin/binary>>, QnA}. @@ -486,60 +464,56 @@ http_uri_variants() -> {"something_else", "something_else", <<"something_else">>}]. -line(doc) -> []; -line(suite) -> []; line(Config) when is_list(Config) -> Text = <<"POST /invalid/url HTTP/1.1\r\n" - "Connection: close\r\n" - "Host\t : localhost:8000\r\n" - "User-Agent: perl post\r\n" - "Content-Length: 4\r\n" - "Content-Type: text/xml; charset=utf-8\r\n" - "Other-Field: with some text\r\n" - "Multi-Line: Once upon a time in a land far far away,\r\n" - " there lived a princess imprisoned in the highest tower\r\n" - " of the most haunted castle.\r\n" - "\r\nThe residue">>, + "Connection: close\r\n" + "Host\t : localhost:8000\r\n" + "User-Agent: perl post\r\n" + "Content-Length: 4\r\n" + "Content-Type: text/xml; charset=utf-8\r\n" + "Other-Field: with some text\r\n" + "Multi-Line: Once upon a time in a land far far away,\r\n" + " there lived a princess imprisoned in the highest tower\r\n" + " of the most haunted castle.\r\n" + "\r\nThe residue">>, lists:foreach(fun(MaxLen) -> line_do(Text,MaxLen) end, - [0,7,19,29,37]), + [0,7,19,29,37]), ok. line_do(Bin,MaxLen) -> Res = decode_pkt(line,Bin,[{line_length,MaxLen}]), MyRes = decode_line(Bin,MaxLen), - ?line MyRes = Res, + MyRes = Res, case Res of - {ok,_,Rest} -> - line_do(Rest,MaxLen); - {more,undefined} -> - ok + {ok,_,Rest} -> + line_do(Rest,MaxLen); + {more,undefined} -> + ok end. - + % Emulates decode_packet(line,Bin,[{line_length,MaxLen}]) decode_line(Bin,MaxLen) -> - ?line case find_in_binary($\n,Bin) of - notfound when MaxLen>0 andalso byte_size(Bin) >= MaxLen -> - {LineB,Rest} = split_binary(Bin,MaxLen), - {ok,LineB,Rest}; - notfound -> - {more,undefined}; - Pos when MaxLen>0 andalso Pos > MaxLen -> - {LineB,Rest} = split_binary(Bin,MaxLen), - {ok,LineB,Rest}; - Pos -> - {LineB,Rest} = split_binary(Bin,Pos), - {ok,LineB,Rest} + case find_in_binary($\n,Bin) of + notfound when MaxLen>0 andalso byte_size(Bin) >= MaxLen -> + {LineB,Rest} = split_binary(Bin,MaxLen), + {ok,LineB,Rest}; + notfound -> + {more,undefined}; + Pos when MaxLen>0 andalso Pos > MaxLen -> + {LineB,Rest} = split_binary(Bin,MaxLen), + {ok,LineB,Rest}; + Pos -> + {LineB,Rest} = split_binary(Bin,Pos), + {ok,LineB,Rest} end. find_in_binary(Byte, Bin) -> - case string:chr(binary_to_list(Bin),Byte) of - 0 -> notfound; - P -> P + case string:find(Bin, [Byte]) of + nomatch -> notfound; + Suffix -> byte_size(Bin) - byte_size(Suffix) + 1 end. -ssl(doc) -> []; -ssl(suite) -> []; ssl(Config) when is_list(Config) -> Major = 34, Minor = 17, @@ -547,15 +521,15 @@ ssl(Config) when is_list(Config) -> Rest = <<23,123,203,12,234>>, F = fun(Content) -> - {Packet,Unpacked} = pack_ssl(Content, Major, Minor, Body), - Bin = <<Packet/binary,Rest/binary>>, - ?line {ok, Unpacked, Rest} = decode_pkt(ssl_tls, Bin) - end, + {Packet,Unpacked} = pack_ssl(Content, Major, Minor, Body), + Bin = <<Packet/binary,Rest/binary>>, + {ok, Unpacked, Rest} = decode_pkt(ssl_tls, Bin) + end, F(25), F(v2hello), ok. -otp_8536(doc) -> ["Corrupt sub-binary-strings from httph_bin"]; +%% 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. @@ -568,7 +542,7 @@ otp_8536_do(N) -> 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, []), + {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">>, []), @@ -584,35 +558,33 @@ decode_pkt(Type,Bin,Opts) -> %%io:format(" -> ~p\n",[Res]), Res. -otp_9389(doc) -> ["Verify line_length works correctly for HTTP headers"]; -otp_9389(suite) -> []; +%% Verify line_length works correctly for HTTP headers otp_9389(Config) when is_list(Config) -> Opts = [{packet_size, 16384}, {line_length, 3000}], Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", - string:chars($X, 8192), + lists:duplicate(8192, $X), "\r\nContent-Length: 0\r\n\r\n"]), <<Pkt1:5000/binary, Pkt2/binary>> = Pkt, {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = - erlang:decode_packet(http, Pkt1, Opts), + erlang:decode_packet(http, Pkt1, Opts), {ok, {http_header,_,'Host',_,"localhost"}, Rest2} = - erlang:decode_packet(httph, Rest1, Opts), + erlang:decode_packet(httph, Rest1, Opts), {more, undefined} = erlang:decode_packet(httph, Rest2, Opts), {ok, {http_header,_,"Link",_,Link}, Rest3} = - erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), + erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), true = (length(Link) > 8000), {ok, {http_header,_,'Content-Length',_,"0"}, <<"\r\n">>} = - erlang:decode_packet(httph, Rest3, Opts), + erlang:decode_packet(httph, Rest3, Opts), ok. -otp_9389_line(doc) -> ["Verify packet_size works correctly for line mode"]; -otp_9389_line(suite) -> []; +%% Verify packet_size works correctly for line mode otp_9389_line(Config) when is_list(Config) -> Opts = [{packet_size, 20}], Line1 = <<"0123456789012345678\n">>, Line2 = <<"0123456789\n">>, Line3 = <<"01234567890123456789\n">>, Pkt = list_to_binary([Line1, Line2, Line3]), - ?line {ok, Line1, Rest1} = erlang:decode_packet(line, Pkt, Opts), - ?line {ok, Line2, Rest2} = erlang:decode_packet(line, Rest1, Opts), - ?line {error, invalid} = erlang:decode_packet(line, Rest2, Opts), + {ok, Line1, Rest1} = erlang:decode_packet(line, Pkt, Opts), + {ok, Line2, Rest2} = erlang:decode_packet(line, Rest1, Opts), + {error, invalid} = erlang:decode_packet(line, Rest2, Opts), ok. diff --git a/erts/emulator/test/dgawd_handler.erl b/erts/emulator/test/dgawd_handler.erl index 27085b7b7e..52cdd26427 100644 --- a/erts/emulator/test/dgawd_handler.erl +++ b/erts/emulator/test/dgawd_handler.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/dirty_bif_SUITE.erl b/erts/emulator/test/dirty_bif_SUITE.erl new file mode 100644 index 0000000000..981ec4d48d --- /dev/null +++ b/erts/emulator/test/dirty_bif_SUITE.erl @@ -0,0 +1,580 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(dirty_bif_SUITE). + +%%-define(line_trace,true). +-define(CHECK(Exp,Got), check(Exp,Got,?LINE)). +%%-define(CHECK(Exp,Got), Exp = Got). + +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2, + dirty_bif/1, dirty_bif_exception/1, + dirty_bif_multischedule/1, + dirty_bif_multischedule_exception/1, + dirty_scheduler_exit/1, + dirty_call_while_terminated/1, + dirty_heap_access/1, + dirty_process_info/1, + dirty_process_register/1, + dirty_process_trace/1, + code_purge/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +%% +%% All these tests utilize the debug BIFs: +%% - erts_debug:dirty_cpu/2 - Statically determined +%% to (begin to) execute on a dirty CPU scheduler. +%% - erts_debug:dirty_io/2 - Statically determined +%% to (begin to) execute on a dirty IO scheduler. +%% - erts_debug:dirty/3 +%% Their implementations are located in +%% $ERL_TOP/erts/emulator/beam/beam_debug.c +%% + +all() -> + [dirty_bif, + dirty_bif_multischedule, + dirty_bif_exception, + dirty_bif_multischedule_exception, + dirty_scheduler_exit, + dirty_call_while_terminated, + dirty_heap_access, + dirty_process_info, + dirty_process_register, + dirty_process_trace, + code_purge]. + +init_per_suite(Config) -> + case erlang:system_info(dirty_cpu_schedulers) of + N when N > 0 -> + Config; + _ -> + {skipped, "No dirty scheduler support"} + end. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(Case, Config) -> + [{testcase, Case} | Config]. + +end_per_testcase(_Case, _Config) -> + ok. + +dirty_bif(Config) when is_list(Config) -> + dirty_cpu = erts_debug:dirty_cpu(scheduler,type), + dirty_io = erts_debug:dirty_io(scheduler,type), + normal = erts_debug:dirty(normal,scheduler,type), + dirty_cpu = erts_debug:dirty(dirty_cpu,scheduler,type), + dirty_io = erts_debug:dirty(dirty_io,scheduler,type), + ok. + +dirty_bif_multischedule(Config) when is_list(Config) -> + ok = erts_debug:dirty_cpu(reschedule,1000), + ok = erts_debug:dirty_io(reschedule,1000), + ok = erts_debug:dirty(normal,reschedule,1000), + ok. + + +dirty_bif_exception(Config) when is_list(Config) -> + lists:foreach(fun (Error) -> + ErrorType = case Error of + _ when is_atom(Error) -> Error; + _ -> badarg + end, + try + erts_debug:dirty_cpu(error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_cpu,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty_cpu,[error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_cpu,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty_io(error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_io,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty_io,[error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_io,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(normal, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[normal, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty,[normal, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[normal, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(dirty_cpu, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty,[dirty_cpu, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(dirty_io, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_io, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty,[dirty_io, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_io, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end + end, + [badarg, undef, badarith, system_limit, noproc, + make_ref(), {another, "heap", term_to_binary("term")}]), + ok. + + +dirty_bif_multischedule_exception(Config) when is_list(Config) -> + try + erts_debug:dirty_cpu(reschedule,1001) + catch + error:badarg -> + [{erts_debug,dirty_cpu,[reschedule, 1001],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty_io(reschedule,1001) + catch + error:badarg -> + [{erts_debug,dirty_io,[reschedule, 1001],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(normal,reschedule,1001) + catch + error:badarg -> + [{erts_debug,dirty,[normal,reschedule,1001],_}|_] + = erlang:get_stacktrace(), + ok + end. + +dirty_scheduler_exit(Config) when is_list(Config) -> + {ok, Node} = start_node(Config, "+SDio 1"), + [ok] = mcall(Node, + [fun() -> + Start = erlang:monotonic_time(millisecond), + ok = test_dirty_scheduler_exit(), + End = erlang:monotonic_time(millisecond), + io:format("Time=~p ms~n", [End-Start]), + ok + end]), + stop_node(Node), + ok. + +test_dirty_scheduler_exit() -> + process_flag(trap_exit,true), + test_dse(10,[]). +test_dse(0,Pids) -> + timer:sleep(100), + kill_dse(Pids,[]); +test_dse(N,Pids) -> + Pid = spawn_link(fun () -> erts_debug:dirty_io(wait, 5000) end), + test_dse(N-1,[Pid|Pids]). + +kill_dse([],Killed) -> + wait_dse(Killed); +kill_dse([Pid|Pids],AlreadyKilled) -> + exit(Pid,kill), + kill_dse(Pids,[Pid|AlreadyKilled]). + +wait_dse([]) -> + ok; +wait_dse([Pid|Pids]) -> + receive + {'EXIT',Pid,Reason} -> + killed = Reason + end, + wait_dse(Pids). + +dirty_call_while_terminated(Config) when is_list(Config) -> + Me = self(), + Bin = list_to_binary(lists:duplicate(4711, $r)), + {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + {Dirty, DM} = spawn_opt(fun () -> + erts_debug:dirty_cpu(alive_waitexiting, Me), + blipp:blupp(Bin) + end, + [monitor,link]), + receive {alive, Dirty} -> ok end, + {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + Reason = die_dirty_process, + OT = process_flag(trap_exit, true), + exit(Dirty, Reason), + receive + {'DOWN', DM, process, Dirty, R0} -> + R0 = Reason + end, + receive + {'EXIT', Dirty, R1} -> + R1 = Reason + end, + undefined = process_info(Dirty), + undefined = process_info(Dirty, status), + false = erlang:is_process_alive(Dirty), + false = lists:member(Dirty, processes()), + %% Binary still refered by Dirty process not yet cleaned up + %% since the dirty bif has not yet returned... + {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + receive after 2000 -> ok end, + receive + Msg -> + ct:fail({unexpected_message, Msg}) + after + 0 -> + ok + end, + {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + process_flag(trap_exit, OT), + try + blipp:blupp(Bin) + catch + _ : _ -> ok + end. + +dirty_heap_access(Config) when is_list(Config) -> + {ok, Node} = start_node(Config), + Me = self(), + RGL = rpc:call(Node,erlang,whereis,[init]), + Ref = rpc:call(Node,erlang,make_ref,[]), + Dirty = spawn_link(fun () -> + Res = erts_debug:dirty_cpu(copy, Ref), + garbage_collect(), + Me ! {self(), Res}, + receive after infinity -> ok end + end), + {N, R} = access_dirty_heap(Dirty, RGL, 0, 0), + receive + {_Pid, Res} -> + 1000 = length(Res), + lists:foreach(fun (X) -> Ref = X end, Res) + end, + unlink(Dirty), + exit(Dirty, kill), + stop_node(Node), + {comment, integer_to_list(N) ++ " GL change loops; " + ++ integer_to_list(R) ++ " while running dirty"}. + +access_dirty_heap(Dirty, RGL, N, R) -> + case process_info(Dirty, status) of + {status, waiting} -> + {N, R}; + {status, Status} -> + {group_leader, GL} = process_info(Dirty, group_leader), + true = group_leader(RGL, Dirty), + {group_leader, RGL} = process_info(Dirty, group_leader), + true = group_leader(GL, Dirty), + {group_leader, GL} = process_info(Dirty, group_leader), + access_dirty_heap(Dirty, RGL, N+1, case Status of + running -> + R+1; + _ -> + R + end) + end. + +%% These tests verify that processes that access a process executing a +%% dirty BIF where the main lock is needed for that access do not get +%% blocked. Each test passes its pid to dirty_sleeper, which sends an +%% 'alive' message when it's running on a dirty scheduler and just before +%% it starts a 6 second sleep. When it receives the message, it verifies +%% that access to the dirty process is as it expects. After the dirty +%% process finishes its 6 second sleep but before it returns from the dirty +%% scheduler, it sends a 'done' message. If the tester already received +%% that message, the test fails because it means attempting to access the +%% dirty process waited for that process to return to a regular scheduler, +%% so verify that we haven't received that message, and also verify that +%% the dirty process is still alive immediately after accessing it. +dirty_process_info(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> ok end, + fun(BifPid) -> + PI = process_info(BifPid), + {current_function,{erts_debug,dirty_io,2}} = + lists:keyfind(current_function, 1, PI), + ok + end, + fun(_) -> ok end). + +dirty_process_register(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> ok end, + fun(BifPid) -> + register(test_dirty_process_register, BifPid), + BifPid = whereis(test_dirty_process_register), + unregister(test_dirty_process_register), + false = lists:member(test_dirty_process_register, + registered()), + ok + end, + fun(_) -> ok end). + +dirty_process_trace(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> + erlang:trace_pattern({erts_debug,dirty_io,2}, + [{'_',[],[{return_trace}]}], + [local,meta]), + ok + end, + fun(BifPid) -> + erlang:trace(BifPid, true, [call,timestamp]), + ok + end, + fun(BifPid) -> + receive + {done, BifPid} -> + receive + {trace_ts,BifPid,call,{erts_debug,dirty_io,_},_} -> + ok + after + 0 -> + error(missing_trace_call_message) + end %%, + %% receive + %% {trace_ts,BifPid,return_from,{erts_debug,dirty_io,2}, + %% ok,_} -> + %% ok + %% after + %% 100 -> + %% error(missing_trace_return_message) + %% end + after + 6500 -> + error(missing_done_message) + end, + ok + end). + +dirty_code_test_code() -> + " +-module(dirty_code_test). + +-export([func/1]). + +func(Fun) -> + Fun(), + blipp:blapp(). + +". + +code_purge(Config) when is_list(Config) -> + Path = ?config(data_dir, Config), + File = filename:join(Path, "dirty_code_test.erl"), + ok = file:write_file(File, dirty_code_test_code()), + {ok, dirty_code_test, Bin} = compile:file(File, [binary]), + {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin), + Start = erlang:monotonic_time(), + {Pid1, Mon1} = spawn_monitor(fun () -> + dirty_code_test:func(fun () -> + %% Sleep for 6 seconds + %% in dirty bif... + erts_debug:dirty_io(wait,6000) + end) + end), + {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin), + {Pid2, Mon2} = spawn_monitor(fun () -> + dirty_code_test:func(fun () -> + %% Sleep for 6 seconds + %% in dirty bif... + erts_debug:dirty_io(wait,6000) + end) + end), + receive + {'DOWN', Mon1, process, Pid1, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:purge_module(dirty_code_test), + receive + {'DOWN', Mon1, process, Pid1, Reason1} -> + killed = Reason1 + end, + receive + {'DOWN', Mon2, process, Pid2, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:delete_module(dirty_code_test), + receive + {'DOWN', Mon2, process, Pid2, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:purge_module(dirty_code_test), + receive + {'DOWN', Mon2, process, Pid2, Reason2} -> + killed = Reason2 + end, + End = erlang:monotonic_time(), + Time = erlang:convert_time_unit(End-Start, native, milli_seconds), + io:format("Time=~p~n", [Time]), + true = Time =< 1000, + ok. + +%% +%% Internal... +%% + +access_dirty_process(Config, Start, Test, Finish) -> + {ok, Node} = start_node(Config, ""), + [ok] = mcall(Node, + [fun() -> + ok = test_dirty_process_access(Start, Test, Finish) + end]), + stop_node(Node), + ok. + +test_dirty_process_access(Start, Test, Finish) -> + ok = Start(), + Self = self(), + BifPid = spawn_link(fun() -> + ok = erts_debug:dirty_io(ready_wait6_done, Self) + end), + ok = receive + {ready, BifPid} -> + ok = Test(BifPid), + receive + {done, BifPid} -> + error(dirty_process_info_blocked) + after + 0 -> + true = erlang:is_process_alive(BifPid), + ok + end + after + 3000 -> + error(timeout) + end, + ok = Finish(BifPid). + +start_node(Config) -> + start_node(Config, ""). + +start_node(Config, Args) when is_list(Config) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + +stop_node(Node) -> + test_server:stop_node(Node). + +mcall(Node, Funs) -> + Parent = self(), + Refs = lists:map(fun (Fun) -> + Ref = make_ref(), + spawn_link(Node, + fun () -> + Res = Fun(), + unlink(Parent), + Parent ! {Ref, Res} + end), + Ref + end, Funs), + lists:map(fun (Ref) -> + receive + {Ref, Res} -> + Res + end + end, Refs). diff --git a/erts/emulator/test/dirty_bif_SUITE_data/.gitignore b/erts/emulator/test/dirty_bif_SUITE_data/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/erts/emulator/test/dirty_bif_SUITE_data/.gitignore diff --git a/erts/emulator/test/dirty_nif_SUITE.erl b/erts/emulator/test/dirty_nif_SUITE.erl new file mode 100644 index 0000000000..13806fd5c4 --- /dev/null +++ b/erts/emulator/test/dirty_nif_SUITE.erl @@ -0,0 +1,683 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(dirty_nif_SUITE). + +%%-define(line_trace,true). +-define(CHECK(Exp,Got), check(Exp,Got,?LINE)). +%%-define(CHECK(Exp,Got), Exp = Got). + +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2, + dirty_nif/1, dirty_nif_send/1, + dirty_nif_exception/1, call_dirty_nif_exception/1, + dirty_scheduler_exit/1, dirty_call_while_terminated/1, + dirty_heap_access/1, dirty_process_info/1, + dirty_process_register/1, dirty_process_trace/1, + code_purge/1, dirty_nif_send_traced/1, + nif_whereis/1, nif_whereis_parallel/1, nif_whereis_proxy/1]). + +-define(nif_stub,nif_stub_error(?LINE)). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [dirty_nif, + dirty_nif_send, + dirty_nif_exception, + dirty_scheduler_exit, + dirty_call_while_terminated, + dirty_heap_access, + dirty_process_info, + dirty_process_register, + dirty_process_trace, + code_purge, + dirty_nif_send_traced, + nif_whereis, + nif_whereis_parallel]. + +init_per_suite(Config) -> + case erlang:system_info(dirty_cpu_schedulers) of + N when N > 0 -> + case lib_loaded() of + false -> + ok = erlang:load_nif( + filename:join(?config(data_dir, Config), + "dirty_nif_SUITE"), []); + true -> + ok + end, + Config; + _ -> + {skipped, "No dirty scheduler support"} + end. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(Case, Config) -> + [{testcase, Case} | Config]. + +end_per_testcase(_Case, _Config) -> + ok. + +dirty_nif(Config) when is_list(Config) -> + Val1 = 42, + Val2 = "Erlang", + Val3 = list_to_binary([Val2, 0]), + {Val1, Val2, Val3} = call_dirty_nif(Val1, Val2, Val3), + LargeArray = lists:duplicate(1000, ok), + LargeArray = call_dirty_nif_zero_args(), + ok. + +dirty_nif_send(Config) when is_list(Config) -> + Parent = self(), + Pid = spawn_link(fun() -> + Self = self(), + {ok, Self} = receive_any(), + Parent ! {ok, Self} + end), + {ok, Pid} = send_from_dirty_nif(Pid), + {ok, Pid} = receive_any(), + ok. + +dirty_nif_exception(Config) when is_list(Config) -> + try + %% this checks that the expected exception occurs when the + %% dirty NIF returns the result of enif_make_badarg + %% directly + call_dirty_nif_exception(1), + ct:fail(expected_badarg) + catch + error:badarg -> + [{?MODULE,call_dirty_nif_exception,[1],_}|_] = + erlang:get_stacktrace(), + ok + end, + try + %% this checks that the expected exception occurs when the + %% dirty NIF calls enif_make_badarg at some point but then + %% returns a value that isn't an exception + call_dirty_nif_exception(0), + ct:fail(expected_badarg) + catch + error:badarg -> + [{?MODULE,call_dirty_nif_exception,[0],_}|_] = + erlang:get_stacktrace(), + ok + end, + %% this checks that a dirty NIF can raise various terms as + %% exceptions + ok = nif_raise_exceptions(call_dirty_nif_exception). + +nif_raise_exceptions(NifFunc) -> + ExcTerms = [{error, test}, "a string", <<"a binary">>, + 42, [1,2,3,4,5], [{p,1},{p,2},{p,3}]], + lists:foldl(fun(Term, ok) -> + try + erlang:apply(?MODULE,NifFunc,[Term]), + ct:fail({expected,Term}) + catch + error:Term -> + [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(), + ok + end + end, ok, ExcTerms). + +dirty_scheduler_exit(Config) when is_list(Config) -> + {ok, Node} = start_node(Config, "+SDio 1"), + Path = proplists:get_value(data_dir, Config), + NifLib = filename:join(Path, atom_to_list(?MODULE)), + [ok] = mcall(Node, + [fun() -> + ok = erlang:load_nif(NifLib, []), + Start = erlang:monotonic_time(millisecond), + ok = test_dirty_scheduler_exit(), + End = erlang:monotonic_time(millisecond), + io:format("Time=~p ms~n", [End-Start]), + ok + end]), + stop_node(Node), + ok. + +test_dirty_scheduler_exit() -> + process_flag(trap_exit,true), + test_dse(10,[]). +test_dse(0,Pids) -> + timer:sleep(100), + kill_dse(Pids,[]); +test_dse(N,Pids) -> + Pid = spawn_link(fun dirty_sleeper/0), + test_dse(N-1,[Pid|Pids]). + +kill_dse([],Killed) -> + wait_dse(Killed); +kill_dse([Pid|Pids],AlreadyKilled) -> + exit(Pid,kill), + kill_dse(Pids,[Pid|AlreadyKilled]). + +wait_dse([]) -> + ok; +wait_dse([Pid|Pids]) -> + receive + {'EXIT',Pid,Reason} -> + killed = Reason + end, + wait_dse(Pids). + +dirty_call_while_terminated(Config) when is_list(Config) -> + Me = self(), + Bin = list_to_binary(lists:duplicate(4711, $r)), + {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + {Dirty, DM} = spawn_opt(fun () -> + dirty_call_while_terminated_nif(Me), + blipp:blupp(Bin) + end, + [monitor,link]), + receive {dirty_alive, _Pid} -> ok end, + {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + Reason = die_dirty_process, + OT = process_flag(trap_exit, true), + exit(Dirty, Reason), + receive + {'DOWN', DM, process, Dirty, R0} -> + R0 = Reason + end, + receive + {'EXIT', Dirty, R1} -> + R1 = Reason + end, + undefined = process_info(Dirty), + undefined = process_info(Dirty, status), + false = erlang:is_process_alive(Dirty), + false = lists:member(Dirty, processes()), + %% Binary still referred by Dirty process not yet cleaned up + %% since the dirty nif has not yet returned... + {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + receive after 2000 -> ok end, + receive + Msg -> + ct:fail({unexpected_message, Msg}) + after + 0 -> + ok + end, + {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + process_flag(trap_exit, OT), + try + blipp:blupp(Bin) + catch + _ : _ -> ok + end. + +dirty_heap_access(Config) when is_list(Config) -> + {ok, Node} = start_node(Config), + Me = self(), + RGL = rpc:call(Node,erlang,whereis,[init]), + Ref = rpc:call(Node,erlang,make_ref,[]), + Dirty = spawn_link(fun () -> + Res = dirty_heap_access_nif(Ref), + garbage_collect(), + Me ! {self(), Res}, + receive after infinity -> ok end + end), + {N, R} = access_dirty_heap(Dirty, RGL, 0, 0), + receive + {_Pid, Res} -> + 1000 = length(Res), + lists:foreach(fun (X) -> Ref = X end, Res) + end, + unlink(Dirty), + exit(Dirty, kill), + stop_node(Node), + {comment, integer_to_list(N) ++ " GL change loops; " + ++ integer_to_list(R) ++ " while running dirty"}. + +access_dirty_heap(Dirty, RGL, N, R) -> + case process_info(Dirty, status) of + {status, waiting} -> + {N, R}; + {status, Status} -> + {group_leader, GL} = process_info(Dirty, group_leader), + true = group_leader(RGL, Dirty), + {group_leader, RGL} = process_info(Dirty, group_leader), + true = group_leader(GL, Dirty), + {group_leader, GL} = process_info(Dirty, group_leader), + access_dirty_heap(Dirty, RGL, N+1, case Status of + running -> + R+1; + _ -> + R + end) + end. + +%% These tests verify that processes that access a process executing a +%% dirty NIF where the main lock is needed for that access do not get +%% blocked. Each test passes its pid to dirty_sleeper, which sends a +%% 'ready' message when it's running on a dirty scheduler and just before +%% it starts a 6 second sleep. When it receives the message, it verifies +%% that access to the dirty process is as it expects. After the dirty +%% process finishes its 6 second sleep but before it returns from the dirty +%% scheduler, it sends a 'done' message. If the tester already received +%% that message, the test fails because it means attempting to access the +%% dirty process waited for that process to return to a regular scheduler, +%% so verify that we haven't received that message, and also verify that +%% the dirty process is still alive immediately after accessing it. +dirty_process_info(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> ok end, + fun(NifPid) -> + PI = process_info(NifPid), + {current_function,{?MODULE,dirty_sleeper,1}} = + lists:keyfind(current_function, 1, PI), + ok + end, + fun(_) -> ok end). + +dirty_process_register(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> ok end, + fun(NifPid) -> + register(test_dirty_process_register, NifPid), + NifPid = whereis(test_dirty_process_register), + unregister(test_dirty_process_register), + false = lists:member(test_dirty_process_register, + registered()), + ok + end, + fun(_) -> ok end). + +dirty_process_trace(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> + erlang:trace_pattern({?MODULE,dirty_sleeper,1}, + [{'_',[],[{return_trace}]}], + [local,meta]), + ok + end, + fun(NifPid) -> + erlang:trace(NifPid, true, [call,timestamp]), + ok + end, + fun(NifPid) -> + receive + done -> + receive + {trace_ts,NifPid,call,{?MODULE,dirty_sleeper,_},_} -> + ok + after + 0 -> + error(missing_trace_call_message) + end, + receive + {trace_ts,NifPid,return_from,{?MODULE,dirty_sleeper,1}, + ok,_} -> + ok + after + 100 -> + error(missing_trace_return_message) + end + after + 6500 -> + error(missing_done_message) + end, + ok + end). + +dirty_code_test_code() -> + " +-module(dirty_code_test). + +-export([func/1]). + +func(Fun) -> + Fun(), + blipp:blapp(). + +". + +code_purge(Config) when is_list(Config) -> + Path = ?config(data_dir, Config), + File = filename:join(Path, "dirty_code_test.erl"), + ok = file:write_file(File, dirty_code_test_code()), + {ok, dirty_code_test, Bin} = compile:file(File, [binary]), + {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin), + Start = erlang:monotonic_time(), + {Pid1, Mon1} = spawn_monitor(fun () -> + dirty_code_test:func(fun () -> + %% Sleep for 6 seconds + %% in dirty nif... + dirty_sleeper() + end) + end), + {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin), + {Pid2, Mon2} = spawn_monitor(fun () -> + dirty_code_test:func(fun () -> + %% Sleep for 6 seconds + %% in dirty nif... + dirty_sleeper() + end) + end), + receive + {'DOWN', Mon1, process, Pid1, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:purge_module(dirty_code_test), + receive + {'DOWN', Mon1, process, Pid1, Reason1} -> + killed = Reason1 + end, + receive + {'DOWN', Mon2, process, Pid2, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:delete_module(dirty_code_test), + receive + {'DOWN', Mon2, process, Pid2, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:purge_module(dirty_code_test), + receive + {'DOWN', Mon2, process, Pid2, Reason2} -> + killed = Reason2 + end, + End = erlang:monotonic_time(), + Time = erlang:convert_time_unit(End-Start, native, milli_seconds), + io:format("Time=~p~n", [Time]), + true = Time =< 1000, + ok. + +dirty_nif_send_traced(Config) when is_list(Config) -> + Parent = self(), + Rcvr = spawn_link(fun() -> + Self = self(), + receive {ok, Self} -> ok end, + Parent ! {Self, received} + end), + Sndr = spawn_link(fun () -> + receive {Parent, go} -> ok end, + {ok, Rcvr} = send_wait_from_dirty_nif(Rcvr), + Parent ! {self(), sent} + end), + 1 = erlang:trace(Sndr, true, [send]), + Start = erlang:monotonic_time(), + Sndr ! {self(), go}, + receive {trace, Sndr, send, {ok, Rcvr}, Rcvr} -> ok end, + receive {Rcvr, received} -> ok end, + End1 = erlang:monotonic_time(), + Time1 = erlang:convert_time_unit(End1-Start, native, 1000), + io:format("Time1: ~p milliseconds~n", [Time1]), + true = Time1 < 500, + receive {Sndr, sent} -> ok end, + End2 = erlang:monotonic_time(), + Time2 = erlang:convert_time_unit(End2-Start, native, 1000), + io:format("Time2: ~p milliseconds~n", [Time2]), + true = Time2 >= 1900, + ok. + +%% +%% Internal... +%% + +access_dirty_process(Config, Start, Test, Finish) -> + {ok, Node} = start_node(Config, ""), + [ok] = mcall(Node, + [fun() -> + Path = ?config(data_dir, Config), + Lib = atom_to_list(?MODULE), + ok = erlang:load_nif(filename:join(Path,Lib), []), + ok = test_dirty_process_access(Start, Test, Finish) + end]), + stop_node(Node), + ok. + +test_dirty_process_access(Start, Test, Finish) -> + ok = Start(), + Self = self(), + NifPid = spawn_link(fun() -> + ok = dirty_sleeper(Self) + end), + ok = receive + ready -> + ok = Test(NifPid), + receive + done -> + error(dirty_process_info_blocked) + after + 0 -> + true = erlang:is_process_alive(NifPid), + ok + end + after + 3000 -> + error(timeout) + end, + ok = Finish(NifPid). + +receive_any() -> + receive M -> M end. + +start_node(Config) -> + start_node(Config, ""). + +start_node(Config, Args) when is_list(Config) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + +stop_node(Node) -> + test_server:stop_node(Node). + +mcall(Node, Funs) -> + Parent = self(), + Refs = lists:map(fun (Fun) -> + Ref = make_ref(), + spawn_link(Node, + fun () -> + Res = Fun(), + unlink(Parent), + Parent ! {Ref, Res} + end), + Ref + end, Funs), + lists:map(fun (Ref) -> + receive + {Ref, Res} -> + Res + end + end, Refs). + +%% Test enif_whereis_... +%% These tests are mostly identical to their counterparts in nif_SUITE.erl, +%% with just name and count changes in the first few lines. + +nif_whereis(Config) when is_list(Config) -> + erl_ddll:try_load(?config(data_dir, Config), echo_drv, []), + + RegName = dirty_nif_whereis_test_thing, + undefined = erlang:whereis(RegName), + false = whereis_term(pid, RegName), + + Mgr = self(), + Ref = make_ref(), + ProcMsg = {Ref, ?LINE}, + PortMsg = ?MODULE_STRING " whereis hello\n", + + {Pid, Mon} = spawn_monitor(?MODULE, nif_whereis_proxy, [Ref]), + true = register(RegName, Pid), + Pid = erlang:whereis(RegName), + Pid = whereis_term(pid, RegName), + false = whereis_term(port, RegName), + false = whereis_term(pid, [RegName]), + + ok = whereis_send(pid, RegName, {forward, Mgr, ProcMsg}), + ok = receive ProcMsg -> ok end, + + Pid ! {Ref, quit}, + ok = receive {'DOWN', Mon, process, Pid, normal} -> ok end, + undefined = erlang:whereis(RegName), + false = whereis_term(pid, RegName), + + Port = open_port({spawn, echo_drv}, [eof]), + true = register(RegName, Port), + Port = erlang:whereis(RegName), + Port = whereis_term(port, RegName), + false = whereis_term(pid, RegName), + false = whereis_term(port, [RegName]), + + ok = whereis_send(port, RegName, PortMsg), + ok = receive {Port, {data, PortMsg}} -> ok end, + + port_close(Port), + undefined = erlang:whereis(RegName), + false = whereis_term(port, RegName), + ok. + +nif_whereis_parallel(Config) when is_list(Config) -> + + %% try to be at least a little asymetric + NProcs = trunc(3.5 * erlang:system_info(schedulers)), + NSeq = lists:seq(1, NProcs), + Names = [list_to_atom("dirty_nif_whereis_proc_" ++ integer_to_list(N)) + || N <- NSeq], + Mgr = self(), + Ref = make_ref(), + + NotReg = fun(Name) -> + erlang:whereis(Name) == undefined + end, + PidReg = fun({Name, Pid, _Mon}) -> + erlang:whereis(Name) == Pid andalso whereis_term(pid, Name) == Pid + end, + RecvDown = fun({_Name, Pid, Mon}) -> + receive {'DOWN', Mon, process, Pid, normal} -> true + after 1500 -> false end + end, + RecvNum = fun(N) -> + receive {N, Ref} -> true + after 1500 -> false end + end, + + true = lists:all(NotReg, Names), + + %% {Name, Pid, Mon} + Procs = lists:map( + fun(N) -> + Name = lists:nth(N, Names), + Prev = lists:nth((if N == 1 -> NProcs; true -> (N - 1) end), Names), + Next = lists:nth((if N == NProcs -> 1; true -> (N + 1) end), Names), + {Pid, Mon} = spawn_monitor( + ?MODULE, nif_whereis_proxy, [{N, Ref, Mgr, [Prev, Next]}]), + true = register(Name, Pid), + {Name, Pid, Mon} + end, NSeq), + + true = lists:all(PidReg, Procs), + + %% tell them all to 'fire' as fast as we can + [P ! {Ref, send_proc} || {_, P, _} <- Procs], + + %% each gets forwarded through two processes + true = lists:all(RecvNum, NSeq), + true = lists:all(RecvNum, NSeq), + + %% tell them all to 'quit' by name + [N ! {Ref, quit} || {N, _, _} <- Procs], + true = lists:all(RecvDown, Procs), + true = lists:all(NotReg, Names), + ok. + +%% exported to be spawned by MFA by whereis tests +nif_whereis_proxy({N, Ref, Mgr, Targets} = Args) -> + receive + {forward, To, Data} -> + To ! Data, + nif_whereis_proxy(Args); + {Ref, quit} -> + ok; + {Ref, send_port} -> + Msg = ?MODULE_STRING " whereis " ++ integer_to_list(N) ++ "\n", + lists:foreach( + fun(T) -> + ok = whereis_send(port, T, Msg) + end, Targets), + nif_whereis_proxy(Args); + {Ref, send_proc} -> + lists:foreach( + fun(T) -> + ok = whereis_send(pid, T, {forward, Mgr, {N, Ref}}) + end, Targets), + nif_whereis_proxy(Args) + end; +nif_whereis_proxy(Ref) -> + receive + {forward, To, Data} -> + To ! Data, + nif_whereis_proxy(Ref); + {Ref, quit} -> + ok + end. + +%% The NIFs: +lib_loaded() -> false. +call_dirty_nif(_,_,_) -> ?nif_stub. +send_from_dirty_nif(_) -> ?nif_stub. +send_wait_from_dirty_nif(_) -> ?nif_stub. +call_dirty_nif_exception(_) -> ?nif_stub. +call_dirty_nif_zero_args() -> ?nif_stub. +dirty_call_while_terminated_nif(_) -> ?nif_stub. +dirty_sleeper() -> ?nif_stub. +dirty_sleeper(_) -> ?nif_stub. +dirty_heap_access_nif(_) -> ?nif_stub. +whereis_term(_Type,_Name) -> ?nif_stub. +whereis_send(_Type,_Name,_Msg) -> ?nif_stub. + +nif_stub_error(Line) -> + exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/dirty_nif_SUITE_data/Makefile.src b/erts/emulator/test/dirty_nif_SUITE_data/Makefile.src new file mode 100644 index 0000000000..4462afd815 --- /dev/null +++ b/erts/emulator/test/dirty_nif_SUITE_data/Makefile.src @@ -0,0 +1,6 @@ + +NIF_LIBS = dirty_nif_SUITE@dll@ + +all: $(NIF_LIBS) echo_drv@dll@ + +@SHLIB_RULES@ diff --git a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c new file mode 100644 index 0000000000..0321b9898f --- /dev/null +++ b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c @@ -0,0 +1,445 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2017. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ +#include <erl_nif.h> +#include <assert.h> +#ifdef __WIN32__ +#include <windows.h> +#else +#include <unistd.h> +#endif + +/* + * Hack to get around this function missing from the NIF API. + * TODO: Add this function/macro in the appropriate place, probably with + * enif_make_pid() in erl_nif_api_funcs.h + */ +#ifndef enif_make_port +#define enif_make_port(ENV, PORT) ((void)(ENV),(const ERL_NIF_TERM)((PORT)->port_id)) +#endif + +static ERL_NIF_TERM atom_badarg; +static ERL_NIF_TERM atom_error; +static ERL_NIF_TERM atom_false; +static ERL_NIF_TERM atom_lookup; +static ERL_NIF_TERM atom_ok; +static ERL_NIF_TERM atom_pid; +static ERL_NIF_TERM atom_port; +static ERL_NIF_TERM atom_send; + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + atom_badarg = enif_make_atom(env, "badarg"); + atom_error = enif_make_atom(env, "error"); + atom_false = enif_make_atom(env,"false"); + atom_lookup = enif_make_atom(env, "lookup"); + atom_ok = enif_make_atom(env,"ok"); + atom_pid = enif_make_atom(env, "pid"); + atom_port = enif_make_atom(env, "port"); + atom_send = enif_make_atom(env, "send"); + + return 0; +} + +static ERL_NIF_TERM lib_loaded(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_make_atom(env, "true"); +} + +static int have_dirty_schedulers(void) +{ + ErlNifSysInfo si; + enif_system_info(&si, sizeof(si)); + return si.dirty_scheduler_support; +} + +static ERL_NIF_TERM dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int n; + char s[10]; + ErlNifBinary b; + if (have_dirty_schedulers()) { + assert(ERL_NIF_THR_DIRTY_CPU_SCHEDULER == enif_thread_type() + || ERL_NIF_THR_DIRTY_IO_SCHEDULER == enif_thread_type()); + } + assert(argc == 3); + enif_get_int(env, argv[0], &n); + enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1); + enif_inspect_binary(env, argv[2], &b); + return enif_make_tuple3(env, + enif_make_int(env, n), + enif_make_string(env, s, ERL_NIF_LATIN1), + enif_make_binary(env, &b)); +} + +static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int n; + char s[10]; + ErlNifBinary b; + assert(ERL_NIF_THR_NORMAL_SCHEDULER == enif_thread_type()); + if (argc != 3) + return enif_make_badarg(env); + if (have_dirty_schedulers()) { + if (enif_get_int(env, argv[0], &n) && + enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1) && + enif_inspect_binary(env, argv[2], &b)) + return enif_schedule_nif(env, "call_dirty_nif", ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_nif, argc, argv); + else + return enif_make_badarg(env); + } else { + return dirty_nif(env, argc, argv); + } +} + +static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM result; + ErlNifPid pid; + ErlNifEnv* menv; + int res; + + if (!enif_get_local_pid(env, argv[0], &pid)) + return enif_make_badarg(env); + result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid)); + menv = enif_alloc_env(); + res = enif_send(env, &pid, menv, result); + enif_free_env(menv); + if (!res) + return enif_make_badarg(env); + else + return result; +} + +static ERL_NIF_TERM send_wait_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM result; + ErlNifPid pid; + ErlNifEnv* menv; + int res; + + if (!enif_get_local_pid(env, argv[0], &pid)) + return enif_make_badarg(env); + result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid)); + menv = enif_alloc_env(); + res = enif_send(env, &pid, menv, result); + enif_free_env(menv); + +#ifdef __WIN32__ + Sleep(2000); +#else + sleep(2); +#endif + + if (!res) + return enif_make_badarg(env); + else + return result; +} + +static ERL_NIF_TERM call_dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + switch (argc) { + case 1: { + int arg; + if (enif_get_int(env, argv[0], &arg) && arg < 2) { + ERL_NIF_TERM args[255]; + int i; + args[0] = argv[0]; + for (i = 1; i < 255; i++) + args[i] = enif_make_int(env, i); + return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND, + call_dirty_nif_exception, 255, args); + } else { + return enif_raise_exception(env, argv[0]); + } + } + case 2: { + int return_badarg_directly; + enif_get_int(env, argv[0], &return_badarg_directly); + assert(return_badarg_directly == 1 || return_badarg_directly == 0); + if (return_badarg_directly) + return enif_make_badarg(env); + else { + /* ignore return value */ enif_make_badarg(env); + return enif_make_atom(env, "ok"); + } + } + default: + return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND, + call_dirty_nif_exception, argc-1, argv); + } +} + +static ERL_NIF_TERM call_dirty_nif_zero_args(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int i; + ERL_NIF_TERM result[1000]; + ERL_NIF_TERM ok = enif_make_atom(env, "ok"); + assert(argc == 0); + for (i = 0; i < sizeof(result)/sizeof(*result); i++) { + result[i] = ok; + } + return enif_make_list_from_array(env, result, i); +} + +static ERL_NIF_TERM +dirty_sleeper(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid pid; + ErlNifEnv* msg_env = NULL; + + assert(ERL_NIF_THR_DIRTY_CPU_SCHEDULER == enif_thread_type() + || ERL_NIF_THR_DIRTY_IO_SCHEDULER == enif_thread_type()); + + /* If we get a pid argument, it indicates a process involved in the + test wants a message from us. Prior to the sleep we send a 'ready' + message, and then after the sleep, send a 'done' message. */ + if (argc == 1 && enif_get_local_pid(env, argv[0], &pid)) { + msg_env = enif_alloc_env(); + enif_send(env, &pid, msg_env, enif_make_atom(msg_env, "ready")); + } + +#ifdef __WIN32__ + Sleep(6000); +#else + sleep(6); +#endif + + if (argc == 1) { + assert(msg_env != NULL); + enif_send(env, &pid, msg_env, enif_make_atom(msg_env, "done")); + enif_free_env(msg_env); + } + + return enif_make_atom(env, "ok"); +} + +static ERL_NIF_TERM dirty_call_while_terminated_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid self; + ERL_NIF_TERM result, self_term; + ErlNifPid to; + ErlNifEnv* menv; + int res; + + if (!enif_get_local_pid(env, argv[0], &to)) + return enif_make_badarg(env); + + if (!enif_self(env, &self)) + return enif_make_badarg(env); + + self_term = enif_make_pid(env, &self); + + result = enif_make_tuple2(env, enif_make_atom(env, "dirty_alive"), self_term); + menv = enif_alloc_env(); + res = enif_send(env, &to, menv, result); + enif_free_env(menv); + if (!res) + return enif_make_badarg(env); + + /* Wait until we have been killed */ + while (enif_is_process_alive(env, &self)) + ; + + result = enif_make_tuple2(env, enif_make_atom(env, "dirty_dead"), self_term); + menv = enif_alloc_env(); + res = enif_send(env, &to, menv, result); + enif_free_env(menv); + +#ifdef __WIN32__ + Sleep(1000); +#else + sleep(1); +#endif + + return enif_make_atom(env, "ok"); +} + +static ERL_NIF_TERM dirty_heap_access_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM res = enif_make_list(env, 0); + int i; + assert(ERL_NIF_THR_DIRTY_CPU_SCHEDULER == enif_thread_type() + || ERL_NIF_THR_DIRTY_IO_SCHEDULER == enif_thread_type()); + for (i = 0; i < 1000; i++) + res = enif_make_list_cell(env, enif_make_copy(env, argv[0]), res); + + return res; +} + +/* + * enif_whereis_... tests + * subset of the functions in nif_SUITE.c + */ + +enum { + /* results */ + WHEREIS_SUCCESS, + WHEREIS_ERROR_TYPE, + WHEREIS_ERROR_LOOKUP, + WHEREIS_ERROR_SEND, + /* types */ + WHEREIS_LOOKUP_PID, /* enif_whereis_pid() */ + WHEREIS_LOOKUP_PORT /* enif_whereis_port() */ +}; + +typedef union { + ErlNifPid pid; + ErlNifPort port; +} whereis_term_data_t; + +static int whereis_type(ERL_NIF_TERM type) +{ + if (enif_is_identical(type, atom_pid)) + return WHEREIS_LOOKUP_PID; + + if (enif_is_identical(type, atom_port)) + return WHEREIS_LOOKUP_PORT; + + return WHEREIS_ERROR_TYPE; +} + +static int whereis_lookup_internal( + ErlNifEnv* env, int type, ERL_NIF_TERM name, whereis_term_data_t* out) +{ + if (type == WHEREIS_LOOKUP_PID) + return enif_whereis_pid(env, name, & out->pid) + ? WHEREIS_SUCCESS : WHEREIS_ERROR_LOOKUP; + + if (type == WHEREIS_LOOKUP_PORT) + return enif_whereis_port(env, name, & out->port) + ? WHEREIS_SUCCESS : WHEREIS_ERROR_LOOKUP; + + return WHEREIS_ERROR_TYPE; +} + +static int whereis_send_internal( + ErlNifEnv* env, int type, whereis_term_data_t* to, ERL_NIF_TERM msg) +{ + if (type == WHEREIS_LOOKUP_PID) + return enif_send(env, & to->pid, NULL, msg) + ? WHEREIS_SUCCESS : WHEREIS_ERROR_SEND; + + if (type == WHEREIS_LOOKUP_PORT) + return enif_port_command(env, & to->port, NULL, msg) + ? WHEREIS_SUCCESS : WHEREIS_ERROR_SEND; + + return WHEREIS_ERROR_TYPE; +} + +static int whereis_lookup_term( + ErlNifEnv* env, int type, ERL_NIF_TERM name, ERL_NIF_TERM* out) +{ + whereis_term_data_t res; + int rc = whereis_lookup_internal(env, type, name, &res); + if (rc == WHEREIS_SUCCESS) { + switch (type) { + case WHEREIS_LOOKUP_PID: + *out = enif_make_pid(env, & res.pid); + break; + case WHEREIS_LOOKUP_PORT: + *out = enif_make_port(env, & res.port); + break; + default: + rc = WHEREIS_ERROR_TYPE; + break; + } + } + return rc; +} + +static ERL_NIF_TERM whereis_result_term(ErlNifEnv* env, int result) +{ + ERL_NIF_TERM err; + switch (result) + { + case WHEREIS_SUCCESS: + return atom_ok; + case WHEREIS_ERROR_LOOKUP: + err = atom_lookup; + break; + case WHEREIS_ERROR_SEND: + err = atom_send; + break; + case WHEREIS_ERROR_TYPE: + err = atom_badarg; + break; + default: + err = enif_make_int(env, -result); + break; + } + return enif_make_tuple2(env, atom_error, err); +} + +/* whereis_term(Type, Name) -> pid() | port() | false */ +static ERL_NIF_TERM +whereis_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM ret; + int type, rc; + + if (argc != 2) /* allow non-atom name for testing */ + return enif_make_badarg(env); + + if ((type = whereis_type(argv[0])) == WHEREIS_ERROR_TYPE) + return enif_make_badarg(env); + + rc = whereis_lookup_term(env, type, argv[1], &ret); + return (rc == WHEREIS_SUCCESS) ? ret : atom_false; +} + +/* whereis_send(Type, Name, Message) -> ok | {error, Reason} */ +static ERL_NIF_TERM +whereis_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + whereis_term_data_t to; + int type, rc; + + if (argc != 3 || !enif_is_atom(env, argv[1])) + return enif_make_badarg(env); + + if ((type = whereis_type(argv[0])) == WHEREIS_ERROR_TYPE) + return enif_make_badarg(env); + + rc = whereis_lookup_internal(env, type, argv[1], & to); + if (rc == WHEREIS_SUCCESS) + rc = whereis_send_internal(env, type, & to, argv[2]); + + return whereis_result_term(env, rc); +} + + +static ErlNifFunc nif_funcs[] = +{ + {"lib_loaded", 0, lib_loaded}, + {"call_dirty_nif", 3, call_dirty_nif}, + {"send_from_dirty_nif", 1, send_from_dirty_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND}, + {"send_wait_from_dirty_nif", 1, send_wait_from_dirty_nif, ERL_NIF_DIRTY_JOB_IO_BOUND}, + {"call_dirty_nif_exception", 1, call_dirty_nif_exception, ERL_NIF_DIRTY_JOB_IO_BOUND}, + {"call_dirty_nif_zero_args", 0, call_dirty_nif_zero_args, ERL_NIF_DIRTY_JOB_CPU_BOUND}, + {"dirty_sleeper", 0, dirty_sleeper, ERL_NIF_DIRTY_JOB_IO_BOUND}, + {"dirty_sleeper", 1, dirty_sleeper, ERL_NIF_DIRTY_JOB_CPU_BOUND}, + {"dirty_call_while_terminated_nif", 1, dirty_call_while_terminated_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND}, + {"dirty_heap_access_nif", 1, dirty_heap_access_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND}, + {"whereis_send", 3, whereis_send, ERL_NIF_DIRTY_JOB_IO_BOUND}, + {"whereis_term", 2, whereis_term, ERL_NIF_DIRTY_JOB_CPU_BOUND} +}; + +ERL_NIF_INIT(dirty_nif_SUITE,nif_funcs,load,NULL,NULL,NULL) diff --git a/erts/emulator/test/dirty_nif_SUITE_data/echo_drv.c b/erts/emulator/test/dirty_nif_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..2b3510c641 --- /dev/null +++ b/erts/emulator/test/dirty_nif_SUITE_data/echo_drv.c @@ -0,0 +1,62 @@ +#include <stdio.h> +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData echo_start(ErlDrvPort, char *); +static void from_erlang(ErlDrvData, char*, ErlDrvSizeT); +static ErlDrvSSizeT echo_call(ErlDrvData drv_data, unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, unsigned *ret_flags); +static ErlDrvEntry echo_driver_entry = { + NULL, /* Init */ + echo_start, + NULL, /* Stop */ + from_erlang, + NULL, /* Ready input */ + NULL, /* Ready output */ + "echo_drv", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + echo_call, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, + NULL, + NULL +}; + +DRIVER_INIT(echo_drv) +{ + return &echo_driver_entry; +} + +static ErlDrvData +echo_start(ErlDrvPort port, char *buf) +{ + return (ErlDrvData) port; +} + +static void +from_erlang(ErlDrvData data, char *buf, ErlDrvSizeT count) +{ + driver_output((ErlDrvPort) data, buf, count); +} + +static ErlDrvSSizeT +echo_call(ErlDrvData drv_data, unsigned int command, + char *buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen, + unsigned *ret_flags) +{ + *rbuf = buf; + *ret_flags |= DRIVER_CALL_KEEP_BUFFER; + return len; +} + diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index aa6cf2b881..2d0ae9c83e 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -1,24 +1,25 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(distribution_SUITE). --compile(r15). +-compile(r16). -define(VERSION_MAGIC, 131). @@ -32,53 +33,58 @@ %% Tests distribution and the tcp driver. --include_lib("test_server/include/test_server.hrl"). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - ping/1, bulk_send_small/1, - bulk_send_big/1, bulk_send_bigbig/1, - local_send_small/1, local_send_big/1, - local_send_legal/1, link_to_busy/1, exit_to_busy/1, - lost_exit/1, link_to_dead/1, link_to_dead_new_node/1, - applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1, - trap_bif_1/1, trap_bif_2/1, trap_bif_3/1, - stop_dist/1, - dist_auto_connect_never/1, dist_auto_connect_once/1, - dist_parallel_send/1, - atom_roundtrip/1, - unicode_atom_roundtrip/1, - atom_roundtrip_r15b/1, - contended_atom_cache_entry/1, - contended_unicode_atom_cache_entry/1, - bad_dist_structure/1, - bad_dist_ext_receive/1, - bad_dist_ext_process_info/1, - bad_dist_ext_control/1, - bad_dist_ext_connection_id/1]). - --export([init_per_testcase/2, end_per_testcase/2]). +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0, groups/0, + ping/1, bulk_send_small/1, + bulk_send_big/1, bulk_send_bigbig/1, + local_send_small/1, local_send_big/1, + local_send_legal/1, link_to_busy/1, exit_to_busy/1, + lost_exit/1, link_to_dead/1, link_to_dead_new_node/1, + applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1, + trap_bif_1/1, trap_bif_2/1, trap_bif_3/1, + stop_dist/1, + dist_auto_connect_never/1, dist_auto_connect_once/1, + dist_parallel_send/1, + atom_roundtrip/1, + unicode_atom_roundtrip/1, + atom_roundtrip_r16b/1, + contended_atom_cache_entry/1, + contended_unicode_atom_cache_entry/1, + bad_dist_structure/1, + bad_dist_ext_receive/1, + bad_dist_ext_process_info/1, + bad_dist_ext_control/1, + bad_dist_ext_connection_id/1, + bad_dist_ext_size/1, + start_epmd_false/1, epmd_module/1]). %% Internal exports. -export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0, - roundtrip/1, bounce/1, do_dist_auto_connect/1, inet_rpc_server/1, - dist_parallel_sender/3, dist_parallel_receiver/0, - dist_evil_parallel_receiver/0, - sendersender/4, sendersender2/4]). + roundtrip/1, bounce/1, do_dist_auto_connect/1, inet_rpc_server/1, + dist_parallel_sender/3, dist_parallel_receiver/0, + dist_evil_parallel_receiver/0]). + +%% epmd_module exports +-export([start_link/0, register_node/2, register_node/3, port_please/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. -all() -> +all() -> [ping, {group, bulk_send}, {group, local_send}, link_to_busy, exit_to_busy, lost_exit, link_to_dead, link_to_dead_new_node, applied_monitor_node, ref_port_roundtrip, nil_roundtrip, stop_dist, {group, trap_bif}, {group, dist_auto_connect}, - dist_parallel_send, atom_roundtrip, unicode_atom_roundtrip, atom_roundtrip_r15b, + dist_parallel_send, atom_roundtrip, unicode_atom_roundtrip, + atom_roundtrip_r16b, contended_atom_cache_entry, contended_unicode_atom_cache_entry, - bad_dist_structure, {group, bad_dist_ext}]. + bad_dist_structure, {group, bad_dist_ext}, + start_epmd_false, epmd_module]. -groups() -> +groups() -> [{bulk_send, [], [bulk_send_small, bulk_send_big, bulk_send_bigbig]}, {local_send, [], [local_send_small, local_send_big, local_send_legal]}, @@ -87,114 +93,90 @@ groups() -> [dist_auto_connect_never, dist_auto_connect_once]}, {bad_dist_ext, [], [bad_dist_ext_receive, bad_dist_ext_process_info, + bad_dist_ext_size, bad_dist_ext_control, bad_dist_ext_connection_id]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - --define(DEFAULT_TIMETRAP, 4*60*1000). - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?DEFAULT_TIMETRAP), - [{watchdog, Dog},{testcase, Func}|Config]. - -end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -ping(doc) -> - ["Tests pinging a node in different ways."]; +%% Tests pinging a node in different ways. ping(Config) when is_list(Config) -> Times = 1024, %% Ping a non-existing node many times. This used to crash the emulator %% on Windows. - ?line Host = hostname(), - ?line BadName = list_to_atom("__pucko__@" ++ Host), - ?line io:format("Pinging ~s (assumed to not exist)", [BadName]), - ?line test_server:do_times(Times, fun() -> pang = net_adm:ping(BadName) - end), + Host = hostname(), + BadName = list_to_atom("__pucko__@" ++ Host), + io:format("Pinging ~s (assumed to not exist)", [BadName]), + test_server:do_times(Times, fun() -> pang = net_adm:ping(BadName) + end), %% Pings another node. - ?line {ok, OtherNode} = start_node(distribution_SUITE_other), - ?line io:format("Pinging ~s (assumed to exist)", [OtherNode]), - ?line test_server:do_times(Times, fun() -> pong = net_adm:ping(OtherNode) end), - ?line stop_node(OtherNode), + {ok, OtherNode} = start_node(distribution_SUITE_other), + io:format("Pinging ~s (assumed to exist)", [OtherNode]), + test_server:do_times(Times, fun() -> pong = net_adm:ping(OtherNode) end), + stop_node(OtherNode), %% Pings our own node many times. - ?line Node = node(), - ?line io:format("Pinging ~s (the same node)", [Node]), - ?line test_server:do_times(Times, fun() -> pong = net_adm:ping(Node) end), + Node = node(), + io:format("Pinging ~s (the same node)", [Node]), + test_server:do_times(Times, fun() -> pong = net_adm:ping(Node) end), ok. bulk_send_small(Config) when is_list(Config) -> - ?line bulk_send(64, 32). + bulk_send(64, 32). bulk_send_big(Config) when is_list(Config) -> - ?line bulk_send(32, 64). - -bulk_send_bigbig(Config) when is_list(Config) -> - ?line bulk_sendsend(32*5, 4). + bulk_send(32, 64). bulk_send(Terms, BinSize) -> - ?line Dog = test_server:timetrap(test_server:seconds(30)), - - ?line io:format("Sending ~w binaries, each of size ~w K", - [Terms, BinSize]), - ?line {ok, Node} = start_node(bulk_receiver), - ?line Recv = spawn(Node, erlang, apply, [fun receiver/2, [0, 0]]), - ?line Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)), - ?line Size = Terms*size(Bin), - ?line {Elapsed, {Terms, Size}} = test_server:timecall(?MODULE, sender, - [Recv, Bin, Terms]), - ?line stop_node(Node), - - ?line test_server:timetrap_cancel(Dog), - {comment, integer_to_list(trunc(Size/1024/Elapsed+0.5)) ++ " K/s"}. - -bulk_sendsend(Terms, BinSize) -> + ct:timetrap({seconds, 30}), + + io:format("Sending ~w binaries, each of size ~w K", [Terms, BinSize]), + {ok, Node} = start_node(bulk_receiver), + Recv = spawn(Node, erlang, apply, [fun receiver/2, [0, 0]]), + Bin = binary:copy(<<253>>, BinSize*1024), + Size = Terms*size(Bin), + {Elapsed, {Terms, Size}} = test_server:timecall(?MODULE, sender, + [Recv, Bin, Terms]), + stop_node(Node), + {comment, integer_to_list(round(Size/1024/max(1,Elapsed))) ++ " K/s"}. + +sender(To, _Bin, 0) -> + To ! {done, self()}, + receive + Any -> + Any + end; +sender(To, Bin, Left) -> + To ! {term, Bin}, + sender(To, Bin, Left-1). + +bulk_send_bigbig(Config) when is_list(Config) -> + Terms = 32*5, + BinSize = 4, {Rate1, MonitorCount1} = bulk_sendsend2(Terms, BinSize, 5), {Rate2, MonitorCount2} = bulk_sendsend2(Terms, BinSize, 995), Ratio = if MonitorCount2 == 0 -> MonitorCount1 / 1.0; true -> MonitorCount1 / MonitorCount2 end, - Comment = integer_to_list(Rate1) ++ " K/s, " ++ - integer_to_list(Rate2) ++ " K/s, " ++ - integer_to_list(MonitorCount1) ++ " monitor msgs, " ++ - integer_to_list(MonitorCount2) ++ " monitor msgs, " ++ - float_to_list(Ratio) ++ " monitor ratio", - if - %% A somewhat arbitrary ratio, but hopefully one that will - %% accommodate a wide range of CPU speeds. - Ratio > 8.0 -> - {comment,Comment}; - true -> - io:put_chars(Comment), - ?line ?t:fail(ratio_too_low) - end. + Comment0 = io_lib:format("~p K/s, ~p K/s, " + "~p monitor msgs, ~p monitor msgs, " + "~.1f monitor ratio", + [Rate1,Rate2,MonitorCount1, + MonitorCount2,Ratio]), + Comment = lists:flatten(Comment0), + {comment,Comment}. bulk_sendsend2(Terms, BinSize, BusyBufSize) -> - ?line Dog = test_server:timetrap(test_server:seconds(30)), + ct:timetrap({seconds, 30}), - ?line io:format("Sending ~w binaries, each of size ~w K", - [Terms, BinSize]), - ?line {ok, NodeRecv} = start_node(bulk_receiver), - ?line Recv = spawn(NodeRecv, erlang, apply, [fun receiver/2, [0, 0]]), - ?line Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)), - %%?line Size = Terms*size(Bin), + io:format("\nSending ~w binaries, each of size ~w K", + [Terms, BinSize]), + {ok, NodeRecv} = start_node(bulk_receiver), + Recv = spawn(NodeRecv, erlang, apply, [fun receiver/2, [0, 0]]), + Bin = binary:copy(<<253>>, BinSize*1024), %% SLF LEFT OFF HERE. %% When the caller uses small hunks, like 4k via @@ -205,143 +187,128 @@ bulk_sendsend2(Terms, BinSize, BusyBufSize) -> %% default busy size and "+zdbbl 5", and if the 5 case gets %% "many many more" monitor messages, then we know we're working. - ?line {ok, NodeSend} = start_node(bulk_sender, "+zdbbl " ++ integer_to_list(BusyBufSize)), - ?line _Send = spawn(NodeSend, erlang, apply, [fun sendersender/4, [self(), Recv, Bin, Terms]]), - ?line {Elapsed, {_TermsN, SizeN}, MonitorCount} = - receive {sendersender, BigRes} -> + {ok, NodeSend} = start_node(bulk_sender, "+zdbbl " ++ + integer_to_list(BusyBufSize)), + _Send = spawn(NodeSend, erlang, apply, + [fun sendersender/4, [self(), Recv, Bin, Terms]]), + {Elapsed, {_TermsN, SizeN}, MonitorCount} = + receive + %% On some platforms (Windows), the time taken is 0 so we + %% simulate that some little time has passed. + {sendersender, {0.0,T,MC}} -> + {0.0015, T, MC}; + {sendersender, BigRes} -> BigRes end, - ?line stop_node(NodeRecv), - ?line stop_node(NodeSend), - - ?line test_server:timetrap_cancel(Dog), - {trunc(SizeN/1024/Elapsed+0.5), MonitorCount}. - -sender(To, _Bin, 0) -> - To ! {done, self()}, - receive - Any -> - Any - end; -sender(To, Bin, Left) -> - To ! {term, Bin}, - sender(To, Bin, Left-1). + stop_node(NodeRecv), + stop_node(NodeSend), + {round(SizeN/1024/Elapsed), MonitorCount}. %% Sender process to be run on a slave node sendersender(Parent, To, Bin, Left) -> erlang:system_monitor(self(), [busy_dist_port]), - [spawn(fun() -> sendersender2(To, Bin, Left, false) end) || - _ <- lists:seq(1,1)], + _ = spawn(fun() -> + sendersender_send(To, Bin, Left), + exit(normal) + end), {USec, {Res, MonitorCount}} = - timer:tc(?MODULE, sendersender2, [To, Bin, Left, true]), + timer:tc(fun() -> + sendersender_send(To, Bin, Left), + To ! {done, self()}, + count_monitors(0) + end), Parent ! {sendersender, {USec/1000000, Res, MonitorCount}}. -sendersender2(To, Bin, Left, SendDone) -> - sendersender3(To, Bin, Left, SendDone, 0). +sendersender_send(_To, _Bin, 0) -> + ok; +sendersender_send(To, Bin, Left) -> + To ! {term, Bin}, + sendersender_send(To, Bin, Left-1). -sendersender3(To, _Bin, 0, SendDone, MonitorCount) -> - if SendDone -> - To ! {done, self()}; - true -> - ok - end, +count_monitors(MonitorCount) -> receive {monitor, _Pid, _Type, _Info} -> - sendersender3(To, _Bin, 0, SendDone, MonitorCount + 1) + count_monitors(MonitorCount + 1) after 0 -> - if SendDone -> - receive - Any when is_tuple(Any), size(Any) == 2 -> - {Any, MonitorCount} - end; - true -> - exit(normal) + receive + {_,_}=Any -> + {Any,MonitorCount} end - end; -sendersender3(To, Bin, Left, SendDone, MonitorCount) -> - To ! {term, Bin}, - %%timer:sleep(50), - sendersender3(To, Bin, Left-1, SendDone, MonitorCount). + end. %% Receiver process to be run on a slave node. receiver(Terms, Size) -> receive - {term, Bin} -> - receiver(Terms+1, Size+size(Bin)); - {done, ReplyTo} -> - ReplyTo ! {Terms, Size} + {term, Bin} -> + receiver(Terms+1, Size+byte_size(Bin)); + {done, ReplyTo} -> + ReplyTo ! {Terms, Size} end. -local_send_big(doc) -> - ["Sends several big message to an non-registered process on ", - "the local node."]; +%% Sends several big message to an non-registered process on the local node. local_send_big(Config) when is_list(Config) -> - Data0=local_send_big(doc)++ - ["Tests sending small and big messages to a non-existing ", - "local registered process."], + Data0= ["Tests sending small and big messages to a non-existing ", + "local registered process."], Data1=[Data0,[Data0, Data0, [Data0], Data0],Data0], Data2=Data0++lists:flatten(Data1)++ - list_to_binary(lists:flatten(Data1)), + list_to_binary(lists:flatten(Data1)), Func=fun() -> Data2= {arbitrary_name, node()} ! Data2 end, - ?line test_server:do_times(4096, Func), + test_server:do_times(4096, Func), ok. -local_send_small(doc) -> - ["Sends a small message to an non-registered process on the ", - "local node."]; +%% Sends a small message to an non-registered process on the local node. local_send_small(Config) when is_list(Config) -> Data={some_stupid, "arbitrary", 'Data'}, Func=fun() -> Data= {unregistered_name, node()} ! Data end, - ?line test_server:do_times(4096, Func), + test_server:do_times(4096, Func), ok. -local_send_legal(doc) -> - ["Sends data to a registered process on the local node, ", - "as if it was on another node."]; +%% Sends data to a registered process on the local node, as if it was on another node. local_send_legal(Config) when is_list(Config) -> Times=16384, - Data={local_send_legal(doc), local_send_legal(doc)}, + Txt = "Some Not so random Data", + Data={[Txt,Txt,Txt], [Txt,Txt,Txt]}, Pid=spawn(?MODULE,receiver2, [0, 0]) , - ?line true=register(registered_process, Pid), + true=register(registered_process, Pid), Func=fun() -> Data={registered_process, node()} ! Data end, TotalSize=size(Data)*Times, - ?line test_server:do_times(Times, Func), + test_server:do_times(Times, Func), % Check that all msgs really came through. Me=self(), - ?line {done, Me}= - {registered_process, node()} ! {done, Me}, + {done, Me}= + {registered_process, node()} ! {done, Me}, receive - {Times, TotalSize} -> - ok; - _ -> - test_server:fail("Wrong number of msgs received.") + {Times, TotalSize} -> + ok; + _ -> + ct:fail("Wrong number of msgs received.") end, ok. receiver2(Num, TotSize) -> receive - {done, ReplyTo} -> - ReplyTo ! {Num, TotSize}; - Stuff -> - receiver2(Num+1, TotSize+size(Stuff)) + {done, ReplyTo} -> + ReplyTo ! {Num, TotSize}; + Stuff -> + receiver2(Num+1, TotSize+size(Stuff)) end. -link_to_busy(doc) -> "Test that link/1 to a busy distribution port works."; +%% Test that link/1 to a busy distribution port works. link_to_busy(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {ok, Node} = start_node(link_to_busy), - ?line Recv = spawn(Node, erlang, apply, [fun sink/1, [link_to_busy_sink]]), + ct:timetrap({seconds, 60}), + {ok, Node} = start_node(link_to_busy), + Recv = spawn(Node, erlang, apply, [fun sink/1, [link_to_busy_sink]]), Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of - "true" -> start_busy_dist_port_tracer(); - _ -> false - end, + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, %% We will spawn off a process which will try to link to the other %% node. The linker process will not actually run until this @@ -350,20 +317,19 @@ link_to_busy(Config) when is_list(Config) -> %% process will block, too, because of the because busy port, %% and will later be restarted. - ?line do_busy_test(Node, fun () -> linker(Recv) end), + do_busy_test(Node, fun () -> linker(Recv) end), %% Same thing, but we apply link/1 instead of calling it directly. - ?line do_busy_test(Node, fun () -> applied_linker(Recv) end), + do_busy_test(Node, fun () -> applied_linker(Recv) end), %% Same thing again, but we apply link/1 in the tail of a function. - ?line do_busy_test(Node, fun () -> tail_applied_linker(Recv) end), + do_busy_test(Node, fun () -> tail_applied_linker(Recv) end), %% Done. - ?line stop_node(Node), - ?line stop_busy_dist_port_tracer(Tracer), - ?line test_server:timetrap_cancel(Dog), + stop_node(Node), + stop_busy_dist_port_tracer(Tracer), ok. linker(Pid) -> @@ -378,16 +344,16 @@ applied_linker(Pid) -> tail_applied_linker(Pid) -> apply(erlang, link, [Pid]). - -exit_to_busy(doc) -> "Test that exit/2 to a busy distribution port works."; + +%% Test that exit/2 to a busy distribution port works. exit_to_busy(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {ok, Node} = start_node(exit_to_busy), + ct:timetrap({seconds, 60}), + {ok, Node} = start_node(exit_to_busy), Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of - "true" -> start_busy_dist_port_tracer(); - _ -> false - end, + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, %% We will spawn off a process which will try to exit a process on %% the other node. That process will not actually run until this @@ -396,88 +362,89 @@ exit_to_busy(Config) when is_list(Config) -> %% too, because of the busy distribution port, and will be allowed %% to continue when the port becomes non-busy. - ?line Recv1 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), - ?line M1 = erlang:monitor(process, Recv1), - ?line do_busy_test(Node, fun () -> joey_killer(Recv1) end), - ?line receive - {'DOWN', M1, process, Recv1, R1} -> - ?line joey_said_die = R1 - end, + Recv1 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + M1 = erlang:monitor(process, Recv1), + do_busy_test(Node, fun () -> joey_killer(Recv1) end), + receive + {'DOWN', M1, process, Recv1, R1} -> + joey_said_die = R1 + end, %% Same thing, but tail call to exit/2. - ?line Recv2 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), - ?line M2 = erlang:monitor(process, Recv2), - ?line do_busy_test(Node, fun () -> tail_joey_killer(Recv2) end), - ?line receive - {'DOWN', M2, process, Recv2, R2} -> - ?line joey_said_die = R2 - end, + Recv2 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + M2 = erlang:monitor(process, Recv2), + do_busy_test(Node, fun () -> tail_joey_killer(Recv2) end), + receive + {'DOWN', M2, process, Recv2, R2} -> + joey_said_die = R2 + end, %% Same thing, but we apply exit/2 instead of calling it directly. - ?line Recv3 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), - ?line M3 = erlang:monitor(process, Recv3), - ?line do_busy_test(Node, fun () -> applied_joey_killer(Recv3) end), - ?line receive - {'DOWN', M3, process, Recv3, R3} -> - ?line joey_said_die = R3 - end, + Recv3 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + M3 = erlang:monitor(process, Recv3), + do_busy_test(Node, fun () -> applied_joey_killer(Recv3) end), + receive + {'DOWN', M3, process, Recv3, R3} -> + joey_said_die = R3 + end, %% Same thing again, but we apply exit/2 in the tail of a function. - ?line Recv4 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), - ?line M4 = erlang:monitor(process, Recv4), - ?line do_busy_test(Node, fun () -> tail_applied_joey_killer(Recv4) end), - ?line receive - {'DOWN', M4, process, Recv4, R4} -> - ?line joey_said_die = R4 - end, - + Recv4 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + M4 = erlang:monitor(process, Recv4), + do_busy_test(Node, fun () -> tail_applied_joey_killer(Recv4) end), + receive + {'DOWN', M4, process, Recv4, R4} -> + joey_said_die = R4 + end, + %% Done. - ?line stop_node(Node), - ?line stop_busy_dist_port_tracer(Tracer), - ?line test_server:timetrap_cancel(Dog), + stop_node(Node), + stop_busy_dist_port_tracer(Tracer), ok. make_busy_data() -> Size = 1024*1024, Key = '__busy__port__data__', case get(Key) of - undefined -> - Data = list_to_binary(lists:duplicate(Size, 253)), - put(Key, Data), - Data; - Data -> - true = is_binary(Data), - true = size(Data) == Size, - Data + undefined -> + Data = list_to_binary(lists:duplicate(Size, 253)), + put(Key, Data), + Data; + Data -> + true = is_binary(Data), + true = size(Data) == Size, + Data end. make_busy(Node, Time) when is_integer(Time) -> Own = 500, freeze_node(Node, Time+Own), Data = make_busy_data(), + DCtrl = dctrl(Node), %% first make port busy Pid = spawn_link(fun () -> - forever(fun () -> - dport_reg_send(Node, - '__noone__', - Data) - end) - end), + forever(fun () -> + dctrl_dop_reg_send(Node, + '__noone__', + Data) + end) + end), receive after Own -> ok end, until(fun () -> - case process_info(Pid, status) of - {status, suspended} -> true; - _ -> false - end - end), + case {DCtrl, process_info(Pid, status)} of + {DPrt, {status, suspended}} when is_port(DPrt) -> true; + {DPid, {status, waiting}} when is_pid(DPid) -> true; + _ -> false + end + end), %% then dist entry make_busy(Node, [nosuspend], Data), Pid. make_busy(Node, Opts, Data) -> case erlang:send({'__noone__', Node}, Data, Opts) of - nosuspend -> nosuspend; - _ -> make_busy(Node, Opts, Data) + nosuspend -> nosuspend; + _ -> make_busy(Node, Opts, Data) end. unmake_busy(Pid) -> @@ -490,29 +457,29 @@ do_busy_test(Node, Fun) -> receive after 100 -> ok end, Pinfo = process_info(P, [status, current_function]), unmake_busy(Busy), - ?t:format("~p : ~p~n", [P, Pinfo]), + io:format("~p : ~p~n", [P, Pinfo]), case Pinfo of - undefined -> - receive - {'DOWN', M, process, P, Reason} -> - ?t:format("~p died with exit reason ~p~n", [P, Reason]) - end, - ?t:fail(premature_death); - _ -> - %% Don't match arity; it is different in debug and - %% optimized emulator - [{status, suspended}, - {current_function, {erlang, bif_return_trap, _}}] = Pinfo, - receive - {'DOWN', M, process, P, Reason} -> - ?t:format("~p died with exit reason ~p~n", [P, Reason]), - normal = Reason - end + undefined -> + receive + {'DOWN', M, process, P, Reason} -> + io:format("~p died with exit reason ~p~n", [P, Reason]) + end, + ct:fail(premature_death); + _ -> + %% Don't match arity; it is different in debug and + %% optimized emulator + [{status, suspended}, + {current_function, {erlang, bif_return_trap, _}}] = Pinfo, + receive + {'DOWN', M, process, P, Reason} -> + io:format("~p died with exit reason ~p~n", [P, Reason]), + normal = Reason + end end. remote_is_process_alive(Pid) -> rpc:call(node(Pid), erlang, is_process_alive, - [Pid]). + [Pid]). joey_killer(Pid) -> exit(Pid, joey_said_die), @@ -534,234 +501,227 @@ sink(Name) -> sink1() -> receive - _Any -> sink1() + _Any -> sink1() end. -lost_exit(doc) -> - "Test that EXIT and DOWN messages send to another node are not lost if " - "the distribution port is busy."; +%% Test that EXIT and DOWN messages send to another node are not lost if +%% the distribution port is busy. lost_exit(Config) when is_list(Config) -> - ?line {ok, Node} = start_node(lost_exit), + {ok, Node} = start_node(lost_exit), Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of - "true" -> start_busy_dist_port_tracer(); - _ -> false - end, + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, Self = self(), Die = make_ref(), - ?line R1 = spawn(fun () -> receive after infinity -> ok end end), - ?line MR1 = erlang:monitor(process, R1), - - ?line {L1, ML1} = spawn_monitor(fun() -> - link(R1), - Self ! {self(), linked}, - receive - Die -> - exit(controlled_suicide) - end - end), - - ?line R2 = spawn(fun () -> - M = erlang:monitor(process, L1), - receive - {'DOWN', M, process, L1, R} -> - Self ! {self(), got_down_message, L1, R} - end - end), - - ?line receive {L1, linked} -> ok end, - + R1 = spawn(fun () -> receive after infinity -> ok end end), + MR1 = erlang:monitor(process, R1), + + {L1, ML1} = spawn_monitor(fun() -> + link(R1), + Self ! {self(), linked}, + receive + Die -> + exit(controlled_suicide) + end + end), + + R2 = spawn(fun () -> + M = erlang:monitor(process, L1), + receive + {'DOWN', M, process, L1, R} -> + Self ! {self(), got_down_message, L1, R} + end + end), + + receive {L1, linked} -> ok end, + Busy = make_busy(Node, 2000), receive after 100 -> ok end, L1 ! Die, - ?line receive - {'DOWN', ML1, process, L1, RL1} -> - ?line controlled_suicide = RL1 - end, + receive + {'DOWN', ML1, process, L1, RL1} -> + controlled_suicide = RL1 + end, receive after 500 -> ok end, unmake_busy(Busy), - ?line receive - {'DOWN', MR1, process, R1, RR1} -> - ?line controlled_suicide = RR1 - end, - - ?line receive - {R2, got_down_message, L1, RR2} -> - ?line controlled_suicide = RR2 - end, + receive + {'DOWN', MR1, process, R1, RR1} -> + controlled_suicide = RR1 + end, + + receive + {R2, got_down_message, L1, RR2} -> + controlled_suicide = RR2 + end, %% Done. - ?line stop_busy_dist_port_tracer(Tracer), - ?line stop_node(Node), + stop_busy_dist_port_tracer(Tracer), + stop_node(Node), ok. dummy_waiter() -> receive after infinity -> - ok + ok end. -link_to_dead(doc) -> - ["Test that linking to a dead remote process gives an EXIT message ", - "AND that the link is teared down."]; +%% Test that linking to a dead remote process gives an EXIT message +%% AND that the link is teared down. link_to_dead(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line {ok, Node} = start_node(link_to_dead), -% ?line monitor_node(Node, true), - ?line net_adm:ping(Node), %% Ts_cross_server workaround. - ?line Pid = spawn(Node, ?MODULE, dead_process, []), + process_flag(trap_exit, true), + {ok, Node} = start_node(link_to_dead), + % monitor_node(Node, true), + net_adm:ping(Node), %% Ts_cross_server workaround. + Pid = spawn(Node, ?MODULE, dead_process, []), receive after 5000 -> ok end, - ?line link(Pid), - ?line receive - {'EXIT', Pid, noproc} -> - ok; - Other -> - ?line test_server:fail({unexpected_message, Other}) - after 5000 -> - ?line test_server:fail(nothing_received) - end, - ?line {links, Links} = process_info(self(), links), - ?line io:format("Pid=~p, links=~p", [Pid, Links]), - ?line false = lists:member(Pid, Links), - ?line stop_node(Node), - ?line receive - Message -> - ?line test_server:fail({unexpected_message, Message}) - after 3000 -> - ok - end, + link(Pid), + receive + {'EXIT', Pid, noproc} -> + ok; + Other -> + ct:fail({unexpected_message, Other}) + after 5000 -> + ct:fail(nothing_received) + end, + {links, Links} = process_info(self(), links), + io:format("Pid=~p, links=~p", [Pid, Links]), + false = lists:member(Pid, Links), + stop_node(Node), + receive + Message -> + ct:fail({unexpected_message, Message}) + after 3000 -> + ok + end, ok. - + dead_process() -> erlang:error(die). -link_to_dead_new_node(doc) -> - ["Test that linking to a pid on node that has gone and restarted gives ", - "the correct EXIT message (OTP-2304)."]; +%% Test that linking to a pid on node that has gone and restarted gives +%% the correct EXIT message (OTP-2304). link_to_dead_new_node(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), + process_flag(trap_exit, true), %% Start the node, get a Pid and stop the node again. - ?line {ok, Node} = start_node(link_to_dead_new_node), - ?line Pid = spawn(Node, ?MODULE, dead_process, []), - ?line stop_node(Node), + {ok, Node} = start_node(link_to_dead_new_node), + Pid = spawn(Node, ?MODULE, dead_process, []), + stop_node(Node), %% Start a new node with the same name. - ?line {ok, Node} = start_node(link_to_dead_new_node), - ?line link(Pid), - ?line receive - {'EXIT', Pid, noproc} -> - ok; - Other -> - ?line test_server:fail({unexpected_message, Other}) - after 5000 -> - ?line test_server:fail(nothing_received) - end, + {ok, Node} = start_node(link_to_dead_new_node), + link(Pid), + receive + {'EXIT', Pid, noproc} -> + ok; + Other -> + ct:fail({unexpected_message, Other}) + after 5000 -> + ct:fail(nothing_received) + end, %% Make sure that the link wasn't created. - ?line {links, Links} = process_info(self(), links), - ?line io:format("Pid=~p, links=~p", [Pid, Links]), - ?line false = lists:member(Pid, Links), - ?line stop_node(Node), - ?line receive - Message -> - ?line test_server:fail({unexpected_message, Message}) - after 3000 -> - ok - end, + {links, Links} = process_info(self(), links), + io:format("Pid=~p, links=~p", [Pid, Links]), + false = lists:member(Pid, Links), + stop_node(Node), + receive + Message -> + ct:fail({unexpected_message, Message}) + after 3000 -> + ok + end, ok. -applied_monitor_node(doc) -> - "Test that monitor_node/2 works when applied."; +%% Test that monitor_node/2 works when applied. applied_monitor_node(Config) when is_list(Config) -> - ?line NonExisting = list_to_atom("__non_existing__@" ++ hostname()), + NonExisting = list_to_atom("__non_existing__@" ++ hostname()), %% Tail-recursive call to apply (since the node is non-existing, %% there will be a trap). - ?line true = tail_apply(erlang, monitor_node, [NonExisting, true]), - ?line [{nodedown, NonExisting}] = test_server:messages_get(), + true = tail_apply(erlang, monitor_node, [NonExisting, true]), + [{nodedown, NonExisting}] = test_server:messages_get(), %% Ordinary call (with trap). - ?line true = apply(erlang, monitor_node, [NonExisting, true]), - ?line [{nodedown, NonExisting}] = test_server:messages_get(), - + true = apply(erlang, monitor_node, [NonExisting, true]), + [{nodedown, NonExisting}] = test_server:messages_get(), + ok. tail_apply(M, F, A) -> apply(M, F, A). -ref_port_roundtrip(doc) -> - "Test that sending a port or reference to another node and back again " - "doesn't correct them in any way."; +%% Test that sending a port or reference to another node and back again +%% doesn't correct them in any way. ref_port_roundtrip(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line Port = open_port({spawn, efile}, []), - ?line Ref = make_ref(), - ?line {ok, Node} = start_node(ref_port_roundtrip), - ?line net_adm:ping(Node), - ?line Term = {Port, Ref}, - ?line io:format("Term before: ~p", [show_term(Term)]), - ?line Pid = spawn_link(Node, ?MODULE, roundtrip, [Term]), - ?line receive after 5000 -> ok end, - ?line stop_node(Node), - ?line receive - {'EXIT', Pid, {Port, Ref}} -> - ?line io:format("Term after: ~p", [show_term(Term)]), - ok; - Other -> - ?line io:format("Term after: ~p", [show_term(Term)]), - ?line test_server:fail({unexpected, Other}) - after 10000 -> - ?line test_server:fail(timeout) - end, + process_flag(trap_exit, true), + Port = open_port({spawn, efile}, []), + Ref = make_ref(), + {ok, Node} = start_node(ref_port_roundtrip), + net_adm:ping(Node), + Term = {Port, Ref}, + io:format("Term before: ~p", [show_term(Term)]), + Pid = spawn_link(Node, ?MODULE, roundtrip, [Term]), + receive after 5000 -> ok end, + stop_node(Node), + receive + {'EXIT', Pid, {Port, Ref}} -> + io:format("Term after: ~p", [show_term(Term)]), + ok; + Other -> + io:format("Term after: ~p", [show_term(Term)]), + ct:fail({unexpected, Other}) + after 10000 -> + ct:fail(timeout) + end, ok. roundtrip(Term) -> exit(Term). -nil_roundtrip(doc) -> - "Test that the smallest external term [] aka NIL can be sent to " - "another node node and back again."; +%% Test that the smallest external term [] aka NIL can be sent to +%% another node node and back again. nil_roundtrip(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line {ok, Node} = start_node(nil_roundtrip), - ?line net_adm:ping(Node), - ?line Pid = spawn_link(Node, ?MODULE, bounce, [self()]), - ?line Pid ! [], - ?line receive - [] -> - ?line receive - {'EXIT', Pid, []} -> - ?line stop_node(Node), - ok - end - end. + process_flag(trap_exit, true), + {ok, Node} = start_node(nil_roundtrip), + net_adm:ping(Node), + Pid = spawn_link(Node, ?MODULE, bounce, [self()]), + Pid ! [], + receive + [] -> + receive + {'EXIT', Pid, []} -> + stop_node(Node), + ok + end + end. bounce(Dest) -> receive Msg -> - Dest ! Msg, - exit(Msg) + Dest ! Msg, + exit(Msg) end. show_term(Term) -> binary_to_list(term_to_binary(Term)). -stop_dist(doc) -> - ["Tests behaviour after net_kernel:stop (OTP-2586)."]; +%% Tests behaviour after net_kernel:stop (OTP-2586). stop_dist(Config) when is_list(Config) -> - ?line Str = os:cmd(atom_to_list(lib:progname()) - ++ " -noshell -pa " - ++ ?config(data_dir, Config) - ++ " -s run"), + Str = os:cmd(atom_to_list(lib:progname()) + ++ " -noshell -pa " + ++ proplists:get_value(data_dir, Config) + ++ " -s run"), %% The "true" may be followed by an error report, so ignore anything that %% follows it. - ?line "true\n"++_ = Str, + "true\n"++_ = Str, %% "May fail on FreeBSD due to differently configured name lookup - ask Arndt", %% if you can find him. @@ -769,37 +729,31 @@ stop_dist(Config) when is_list(Config) -> ok. -trap_bif_1(doc) -> - [""]; trap_bif_1(Config) when is_list(Config) -> - ?line {true} = tr1(), + {true} = tr1(), ok. -trap_bif_2(doc) -> - [""]; trap_bif_2(Config) when is_list(Config) -> - ?line {true} = tr2(), + {true} = tr2(), ok. -trap_bif_3(doc) -> - [""]; trap_bif_3(Config) when is_list(Config) -> - ?line {hoo} = tr3(), + {hoo} = tr3(), ok. tr1() -> - ?line NonExisting = 'abc@boromir', - ?line X = erlang:monitor_node(NonExisting, true), + NonExisting = 'abc@boromir', + X = erlang:monitor_node(NonExisting, true), {X}. tr2() -> - ?line NonExisting = 'abc@boromir', - ?line X = apply(erlang, monitor_node, [NonExisting, true]), + NonExisting = 'abc@boromir', + X = apply(erlang, monitor_node, [NonExisting, true]), {X}. tr3() -> - ?line NonExisting = 'abc@boromir', - ?line X = {NonExisting, glirp} ! hoo, + NonExisting = 'abc@boromir', + X = {NonExisting, glirp} ! hoo, {X}. @@ -820,60 +774,61 @@ tr3() -> % * n2 gets pang when pinging n1 % * n2 forces connection by using net_kernel:connect_node (ovverrides) % * n2 gets pong when pinging n1. -dist_auto_connect_once(doc) -> "Test the dist_auto_connect once kernel parameter"; + +%% Test the dist_auto_connect once kernel parameter dist_auto_connect_once(Config) when is_list(Config) -> - ?line Sock = start_relay_node(dist_auto_connect_relay_node,[]), - ?line NN = inet_rpc_nodename(Sock), - ?line Sock2 = start_relay_node(dist_auto_connect_once_node, - "-kernel dist_auto_connect once"), - ?line NN2 = inet_rpc_nodename(Sock2), - ?line {ok,[]} = do_inet_rpc(Sock,erlang,nodes,[]), - ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), - ?line {ok,[NN2]} = do_inet_rpc(Sock,erlang,nodes,[]), - ?line {ok,[NN]} = do_inet_rpc(Sock2,erlang,nodes,[]), - ?line [_,HostPartPeer] = string:tokens(atom_to_list(NN),"@"), - ?line [_,MyHostPart] = string:tokens(atom_to_list(node()),"@"), + Sock = start_relay_node(dist_auto_connect_relay_node,[]), + NN = inet_rpc_nodename(Sock), + Sock2 = start_relay_node(dist_auto_connect_once_node, + "-kernel dist_auto_connect once"), + NN2 = inet_rpc_nodename(Sock2), + {ok,[]} = do_inet_rpc(Sock,erlang,nodes,[]), + {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + {ok,[NN2]} = do_inet_rpc(Sock,erlang,nodes,[]), + {ok,[NN]} = do_inet_rpc(Sock2,erlang,nodes,[]), + [_,HostPartPeer] = string:lexemes(atom_to_list(NN),"@"), + [_,MyHostPart] = string:lexemes(atom_to_list(node()),"@"), % Give net_kernel a chance to change the state of the node to up to. - ?line receive after 1000 -> ok end, + receive after 1000 -> ok end, case HostPartPeer of - MyHostPart -> - ?line ok = stop_relay_node(Sock), - ?line {ok,pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]); - _ -> - ?line {ok, true} = do_inet_rpc(Sock,net_kernel,disconnect,[NN2]), - receive - after 500 -> ok - end + MyHostPart -> + ok = stop_relay_node(Sock), + {ok,pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]); + _ -> + {ok, true} = do_inet_rpc(Sock,net_kernel,disconnect,[NN2]), + receive + after 500 -> ok + end end, - ?line {ok, []} = do_inet_rpc(Sock2,erlang,nodes,[]), + {ok, []} = do_inet_rpc(Sock2,erlang,nodes,[]), Sock3 = case HostPartPeer of - MyHostPart -> - ?line start_relay_node(dist_auto_connect_relay_node,[]); - _ -> - Sock - end, - ?line TS1 = timestamp(), - ?line {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]), - ?line TS2 = timestamp(), + MyHostPart -> + start_relay_node(dist_auto_connect_relay_node,[]); + _ -> + Sock + end, + TS1 = timestamp(), + {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + TS2 = timestamp(), RefT = net_kernel:connecttime() - 1000, - ?line true = ((TS2 - TS1) < RefT), - ?line TS3 = timestamp(), - ?line {ok, true} = do_inet_rpc(Sock2,erlang,monitor_node, - [NN,true,[allow_passive_connect]]), - ?line TS4 = timestamp(), - ?line true = ((TS4 - TS3) > RefT), - ?line {ok, pong} = do_inet_rpc(Sock3,net_adm,ping,[NN2]), - ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), - ?line {ok, true} = do_inet_rpc(Sock3,net_kernel,disconnect,[NN2]), + true = ((TS2 - TS1) < RefT), + TS3 = timestamp(), + {ok, true} = do_inet_rpc(Sock2,erlang,monitor_node, + [NN,true,[allow_passive_connect]]), + TS4 = timestamp(), + true = ((TS4 - TS3) > RefT), + {ok, pong} = do_inet_rpc(Sock3,net_adm,ping,[NN2]), + {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + {ok, true} = do_inet_rpc(Sock3,net_kernel,disconnect,[NN2]), receive after 500 -> ok end, - ?line {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]), - ?line {ok, true} = do_inet_rpc(Sock2,net_kernel,connect_node,[NN]), - ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), - ?line stop_relay_node(Sock3), - ?line stop_relay_node(Sock2). - + {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + {ok, true} = do_inet_rpc(Sock2,net_kernel,connect_node,[NN]), + {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + stop_relay_node(Sock3), + stop_relay_node(Sock2). + %% Start a relay node and a lonely (dist_auto_connect never) node. @@ -882,62 +837,53 @@ dist_auto_connect_once(Config) when is_list(Config) -> %% Result is sent here through relay node. dist_auto_connect_never(Config) when is_list(Config) -> Self = self(), - ?line {ok, RelayNode} = - start_node(dist_auto_connect_relay), - ?line spawn(RelayNode, - fun() -> - register(dist_auto_connect_relay, self()), - dist_auto_connect_relay(Self) - end), - ?line {ok, Handle} = dist_auto_connect_start(dist_auto_connect, never), - ?line Result = - receive - {do_dist_auto_connect, ok} -> - ok; - {do_dist_auto_connect, Error} -> - {error, Error}; - Other -> - {error, Other} - after 32000 -> - timeout - end, - ?line stop_node(RelayNode), - ?line Stopped = dist_auto_connect_stop(Handle), - ?line Junk = - receive - {do_dist_auto_connect, _} = J -> - J - after 0 -> - ok - end, - ?line {ok, ok, ok} = {Result, Stopped, Junk}, + {ok, RelayNode} = start_node(dist_auto_connect_relay), + spawn(RelayNode, + fun() -> + register(dist_auto_connect_relay, self()), + dist_auto_connect_relay(Self) + end), + {ok, Handle} = dist_auto_connect_start(dist_auto_connect, never), + Result = receive + {do_dist_auto_connect, ok} -> + ok; + {do_dist_auto_connect, Error} -> + {error, Error}; + Other -> + {error, Other} + after 32000 -> + timeout + end, + stop_node(RelayNode), + Stopped = dist_auto_connect_stop(Handle), + Junk = receive + {do_dist_auto_connect, _} = J -> J + after 0 -> ok + end, + {ok, ok, ok} = {Result, Stopped, Junk}, ok. do_dist_auto_connect([never]) -> Node = list_to_atom("dist_auto_connect_relay@" ++ hostname()), - io:format("~p:do_dist_auto_connect([false]) Node=~p~n", - [?MODULE, Node]), + io:format("~p:do_dist_auto_connect([false]) Node=~p~n", [?MODULE, Node]), Ping = net_adm:ping(Node), - io:format("~p:do_dist_auto_connect([false]) Ping=~p~n", - [?MODULE, Ping]), + io:format("~p:do_dist_auto_connect([false]) Ping=~p~n", [?MODULE, Ping]), Result = case Ping of - pang -> ok; - _ -> {error, Ping} - end, - io:format("~p:do_dist_auto_connect([false]) Result=~p~n", - [?MODULE, Result]), + pang -> ok; + _ -> {error, Ping} + end, + io:format("~p:do_dist_auto_connect([false]) Result=~p~n", [?MODULE, Result]), net_kernel:connect_node(Node), catch {dist_auto_connect_relay, Node} ! {do_dist_auto_connect, Result}; % receive after 1000 -> ok end, % halt(); do_dist_auto_connect(Arg) -> - io:format("~p:do_dist_auto_connect(~p)~n", - [?MODULE, Arg]), + io:format("~p:do_dist_auto_connect(~p)~n", [?MODULE, Arg]), receive after 10000 -> ok end, halt(). - + dist_auto_connect_start(Name, Value) when is_atom(Name) -> dist_auto_connect_start(atom_to_list(Name), Value); @@ -947,16 +893,16 @@ dist_auto_connect_start(Name, Value) when is_list(Name), is_atom(Value) -> ValueStr = atom_to_list(Value), Cookie = atom_to_list(erlang:get_cookie()), Cmd = lists:concat( - [%"xterm -e ", - atom_to_list(lib:progname()), -% " -noinput ", - " -detached ", - long_or_short(), " ", Name, - " -setcookie ", Cookie, - " -pa ", ModuleDir, - " -s ", atom_to_list(?MODULE), - " do_dist_auto_connect ", ValueStr, - " -kernel dist_auto_connect ", ValueStr]), + [%"xterm -e ", + atom_to_list(lib:progname()), + % " -noinput ", + " -detached ", + long_or_short(), " ", Name, + " -setcookie ", Cookie, + " -pa ", ModuleDir, + " -s ", atom_to_list(?MODULE), + " do_dist_auto_connect ", ValueStr, + " -kernel dist_auto_connect ", ValueStr]), io:format("~p:dist_auto_connect_start() cmd: ~p~n", [?MODULE, Cmd]), Port = open_port({spawn, Cmd}, [stream]), {ok, {Port, Node}}. @@ -974,102 +920,83 @@ dist_auto_connect_stop(Port, _Node, Pid, N) when is_integer(N), N =< 0 -> Result; dist_auto_connect_stop(Port, Node, Pid, N) when is_integer(N) -> case net_adm:ping(Node) of - pong -> - receive after 100 -> ok end, - dist_auto_connect_stop(Port, Node, Pid, N-100); - pang -> - exit(Pid, normal), - catch erlang:port_close(Port), - io:format("~p:dist_auto_connect_stop() ok~n", [?MODULE]), - ok + pong -> + receive after 100 -> ok end, + dist_auto_connect_stop(Port, Node, Pid, N-100); + pang -> + exit(Pid, normal), + catch erlang:port_close(Port), + io:format("~p:dist_auto_connect_stop() ok~n", [?MODULE]), + ok end. -dist_auto_connect_relay(Parent) -> +dist_auto_connect_relay(Parent) -> receive X -> - catch Parent ! X + catch Parent ! X end, dist_auto_connect_relay(Parent). -dist_parallel_send(doc) -> - []; -dist_parallel_send(suite) -> - []; dist_parallel_send(Config) when is_list(Config) -> - ?line {ok, RNode} = start_node(dist_parallel_receiver), - ?line {ok, SNode} = start_node(dist_parallel_sender), - ?line WatchDog = spawn_link( - fun () -> - TRef = erlang:start_timer((?DEFAULT_TIMETRAP - div 2), - self(), - oops), - receive - {timeout, TRef, _ } -> - spawn(SNode, - fun () -> - abort(timeout) - end), - spawn(RNode, - fun () -> - abort(timeout) - end) -%% rpc:cast(SNode, erlang, halt, -%% ["Timetrap (sender)"]), -%% rpc:cast(RNode, erlang, halt, -%% ["Timetrap (receiver)"]) - end - end), - ?line MkSndrs = fun (Receiver) -> - lists:map(fun (_) -> - spawn_link(SNode, - ?MODULE, - dist_parallel_sender, - [self(), - Receiver, - 1000]) - end, - lists:seq(1, 64)) - end, - ?line SndrsStart = fun (Sndrs) -> - Parent = self(), - spawn_link( - SNode, - fun () -> - lists:foreach(fun (P) -> - P ! {go, Parent} - end, - Sndrs) - end) - end, - ?line SndrsWait = fun (Sndrs) -> - lists:foreach(fun (P) -> - receive {P, done} -> ok end - end, - Sndrs) - end, - ?line DPR = spawn_link(RNode, ?MODULE, dist_parallel_receiver, []), - ?line Sndrs1 = MkSndrs(DPR), - ?line SndrsStart(Sndrs1), - ?line SndrsWait(Sndrs1), - ?line unlink(DPR), - ?line exit(DPR, bang), - - ?line DEPR = spawn_link(RNode, ?MODULE, dist_evil_parallel_receiver, []), - ?line Sndrs2 = MkSndrs(DEPR), - ?line SndrsStart(Sndrs2), - ?line SndrsWait(Sndrs2), - ?line unlink(DEPR), - ?line exit(DEPR, bang), - - ?line unlink(WatchDog), - ?line exit(WatchDog, bang), - - ?line stop_node(RNode), - ?line stop_node(SNode), - - ?line ok. + {ok, RNode} = start_node(dist_parallel_receiver), + {ok, SNode} = start_node(dist_parallel_sender), + WatchDog = spawn_link( + fun () -> + TRef = erlang:start_timer((2*60*1000), self(), oops), + receive + {timeout, TRef, _ } -> + spawn(SNode, fun () -> abort(timeout) end), + spawn(RNode, fun () -> abort(timeout) end) + %% rpc:cast(SNode, erlang, halt, + %% ["Timetrap (sender)"]), + %% rpc:cast(RNode, erlang, halt, + %% ["Timetrap (receiver)"]) + end + end), + MkSndrs = fun (Receiver) -> + lists:map(fun (_) -> + spawn_link(SNode, + ?MODULE, + dist_parallel_sender, + [self(), Receiver, 1000]) + end, lists:seq(1, 64)) + end, + SndrsStart = fun (Sndrs) -> + Parent = self(), + spawn_link(SNode, + fun () -> + lists:foreach(fun (P) -> + P ! {go, Parent} + end, Sndrs) + end) + end, + SndrsWait = fun (Sndrs) -> + lists:foreach(fun (P) -> + receive {P, done} -> ok end + end, Sndrs) + end, + DPR = spawn_link(RNode, ?MODULE, dist_parallel_receiver, []), + Sndrs1 = MkSndrs(DPR), + SndrsStart(Sndrs1), + SndrsWait(Sndrs1), + unlink(DPR), + exit(DPR, bang), + + DEPR = spawn_link(RNode, ?MODULE, dist_evil_parallel_receiver, []), + Sndrs2 = MkSndrs(DEPR), + SndrsStart(Sndrs2), + SndrsWait(Sndrs2), + unlink(DEPR), + exit(DEPR, bang), + + unlink(WatchDog), + exit(WatchDog, bang), + + stop_node(RNode), + stop_node(SNode), + + ok. do_dist_parallel_sender(Parent, _Receiver, 0) -> Parent ! {self(), done}; @@ -1091,71 +1018,75 @@ dist_evil_parallel_receiver() -> dist_evil_parallel_receiver(). atom_roundtrip(Config) when is_list(Config) -> - ?line AtomData = atom_data(), - ?line verify_atom_data(AtomData), - ?line {ok, Node} = start_node(Config), - ?line do_atom_roundtrip(Node, AtomData), - ?line stop_node(Node), - ?line ok. - -atom_roundtrip_r15b(Config) when is_list(Config) -> - case ?t:is_release_available("r15b") of - true -> - ?line AtomData = atom_data(), - ?line verify_atom_data(AtomData), - ?line {ok, Node} = start_node(Config, [], "r15b"), - ?line do_atom_roundtrip(Node, AtomData), - ?line stop_node(Node), - ?line ok; - false -> - ?line {skip,"No OTP R15B available"} + AtomData = atom_data(), + verify_atom_data(AtomData), + {ok, Node} = start_node(Config), + do_atom_roundtrip(Node, AtomData), + stop_node(Node), + ok. + +atom_roundtrip_r16b(Config) when is_list(Config) -> + case test_server:is_release_available("r16b") of + true -> + ct:timetrap({minutes, 6}), + AtomData = unicode_atom_data(), + verify_atom_data(AtomData), + case start_node(Config, [], "r16b") of + {ok, Node} -> + do_atom_roundtrip(Node, AtomData), + stop_node(Node); + {error, timeout} -> + {skip,"Unable to start OTP R16B release"} + end; + false -> + {skip,"No OTP R16B available"} end. unicode_atom_roundtrip(Config) when is_list(Config) -> - ?line AtomData = unicode_atom_data(), - ?line verify_atom_data(AtomData), - ?line {ok, Node} = start_node(Config), - ?line do_atom_roundtrip(Node, AtomData), - ?line stop_node(Node), - ?line ok. + AtomData = unicode_atom_data(), + verify_atom_data(AtomData), + {ok, Node} = start_node(Config), + do_atom_roundtrip(Node, AtomData), + stop_node(Node), + ok. do_atom_roundtrip(Node, AtomData) -> - ?line Parent = self(), - ?line Proc = spawn_link(Node, fun () -> verify_atom_data_loop(Parent) end), - ?line Proc ! {self(), AtomData}, - ?line receive {Proc, AD1} -> AtomData = AD1 end, - ?line Proc ! {self(), AtomData}, - ?line receive {Proc, AD2} -> AtomData = AD2 end, - ?line RevAtomData = lists:reverse(AtomData), - ?line Proc ! {self(), RevAtomData}, - ?line receive {Proc, RAD1} -> RevAtomData = RAD1 end, - ?line unlink(Proc), - ?line exit(Proc, bang), - ?line ok. + Parent = self(), + Proc = spawn_link(Node, fun () -> verify_atom_data_loop(Parent) end), + Proc ! {self(), AtomData}, + receive {Proc, AD1} -> AtomData = AD1 end, + Proc ! {self(), AtomData}, + receive {Proc, AD2} -> AtomData = AD2 end, + RevAtomData = lists:reverse(AtomData), + Proc ! {self(), RevAtomData}, + receive {Proc, RAD1} -> RevAtomData = RAD1 end, + unlink(Proc), + exit(Proc, bang), + ok. verify_atom_data_loop(From) -> receive - {From, AtomData} -> - verify_atom_data(AtomData), - From ! {self(), AtomData}, - verify_atom_data_loop(From) + {From, AtomData} -> + verify_atom_data(AtomData), + From ! {self(), AtomData}, + verify_atom_data_loop(From) end. atom_data() -> lists:map(fun (N) -> - ATxt = "a"++integer_to_list(N), - {list_to_atom(ATxt), ATxt} - end, - lists:seq(1, 2000)). + ATxt = "a"++integer_to_list(N), + {list_to_atom(ATxt), ATxt} + end, + lists:seq(1, 2000)). verify_atom_data(AtomData) -> lists:foreach(fun ({Atom, AtomTxt}) when is_atom(Atom) -> - AtomTxt = atom_to_list(Atom); - ({PPR, AtomTxt}) -> - % Pid, Port, or Ref - AtomTxt = atom_to_list(node(PPR)) - end, - AtomData). + AtomTxt = atom_to_list(Atom); + ({PPR, AtomTxt}) -> + % Pid, Port, or Ref + AtomTxt = atom_to_list(node(PPR)) + end, + AtomData). uc_atom_tup(ATxt) -> Atom = string_to_atom(ATxt), @@ -1208,9 +1139,8 @@ unicode_atom_data() -> uc_atom_tup(lists:seq(65500, 65754)), uc_atom_tup(lists:seq(65500, 65563)) | lists:map(fun (N) -> - uc_atom_tup(lists:seq(64000+N, 64254+N)) - end, - lists:seq(1, 2000))]. + uc_atom_tup(lists:seq(64000+N, 64254+N)) + end, lists:seq(1, 2000))]. contended_atom_cache_entry(Config) when is_list(Config) -> contended_atom_cache_entry_test(Config, latin1). @@ -1219,79 +1149,77 @@ contended_unicode_atom_cache_entry(Config) when is_list(Config) -> contended_atom_cache_entry_test(Config, unicode). contended_atom_cache_entry_test(Config, Type) -> - ?line TestServer = self(), - ?line ProcessPairs = 10, - ?line Msgs = 100000, - ?line {ok, SNode} = start_node(Config), - ?line {ok, RNode} = start_node(Config), - ?line Success = make_ref(), - ?line spawn_link( - SNode, - fun () -> - erts_debug:set_internal_state(available_internal_state, - true), - Master = self(), - CIX = get_cix(), - TestAtoms = case Type of - latin1 -> - get_conflicting_atoms(CIX, - ProcessPairs); - unicode -> - get_conflicting_unicode_atoms(CIX, - ProcessPairs) - end, - io:format("Testing with the following atoms all using " - "cache index ~p:~n ~w~n", - [CIX, TestAtoms]), - Ps = lists:map( - fun (A) -> - Ref = make_ref(), - R = spawn_link( - RNode, - fun () -> - Atom = receive - {Ref, txt, ATxt} -> - case Type of - latin1 -> - list_to_atom(ATxt); - unicode -> - string_to_atom(ATxt) - end - end, - receive_ref_atom(Ref, - Atom, - Msgs), - Master ! {self(), success} - end), - S = spawn_link( - SNode, - fun () -> - receive go -> ok end, - R ! {Ref, - txt, - atom_to_list(A)}, - send_ref_atom(R, Ref, A, Msgs) - end), - {S, R} - end, - TestAtoms), - lists:foreach(fun ({S, _}) -> - S ! go - end, - Ps), - lists:foreach(fun ({_, R}) -> - receive {R, success} -> ok end - end, - Ps), - TestServer ! Success - end), - ?line receive - Success -> - ok - end, - ?line stop_node(SNode), - ?line stop_node(RNode), - ?line ok. + TestServer = self(), + ProcessPairs = 10, + Msgs = 100000, + {ok, SNode} = start_node(Config), + {ok, RNode} = start_node(Config), + Success = make_ref(), + spawn_link( + SNode, + fun () -> + erts_debug:set_internal_state(available_internal_state, + true), + Master = self(), + CIX = get_cix(), + TestAtoms = case Type of + latin1 -> + get_conflicting_atoms(CIX, + ProcessPairs); + unicode -> + get_conflicting_unicode_atoms(CIX, + ProcessPairs) + end, + io:format("Testing with the following atoms all using " + "cache index ~p:~n ~w~n", + [CIX, TestAtoms]), + Ps = lists:map( + fun (A) -> + Ref = make_ref(), + R = spawn_link(RNode, + fun () -> + Atom = receive + {Ref, txt, ATxt} -> + case Type of + latin1 -> + list_to_atom(ATxt); + unicode -> + string_to_atom(ATxt) + end + end, + receive_ref_atom(Ref, + Atom, + Msgs), + Master ! {self(), success} + end), + S = spawn_link(SNode, + fun () -> + receive go -> ok end, + R ! {Ref, + txt, + atom_to_list(A)}, + send_ref_atom(R, Ref, A, Msgs) + end), + {S, R} + end, + TestAtoms), + lists:foreach(fun ({S, _}) -> + S ! go + end, + Ps), + lists:foreach(fun ({_, R}) -> + receive {R, success} -> ok end + end, + Ps), + TestServer ! Success + end), + receive + Success -> + ok + end, + stop_node(SNode), + stop_node(RNode), + ok. send_ref_atom(_To, _Ref, _Atom, 0) -> ok; @@ -1303,11 +1231,11 @@ receive_ref_atom(_Ref, _Atom, 0) -> ok; receive_ref_atom(Ref, Atom, N) -> receive - {Ref, Value} -> - Atom = Value + {Ref, Value} -> + Atom = Value end, receive_ref_atom(Ref, Atom, N-1). - + get_cix() -> get_cix(1000). @@ -1315,51 +1243,45 @@ get_cix(CIX) when is_integer(CIX), CIX < 0 -> get_cix(0); get_cix(CIX) when is_integer(CIX) -> get_cix(CIX, - unwanted_cixs(), - erts_debug:get_internal_state(max_atom_out_cache_index)). + unwanted_cixs(), + erts_debug:get_internal_state(max_atom_out_cache_index)). get_cix(CIX, Unwanted, MaxCIX) when CIX > MaxCIX -> get_cix(0, Unwanted, MaxCIX); get_cix(CIX, Unwanted, MaxCIX) -> case lists:member(CIX, Unwanted) of - true -> get_cix(CIX+1, Unwanted, MaxCIX); - false -> CIX + true -> get_cix(CIX+1, Unwanted, MaxCIX); + false -> CIX end. unwanted_cixs() -> lists:map(fun (Node) -> - erts_debug:get_internal_state({atom_out_cache_index, - Node}) - end, - nodes()). - - + erts_debug:get_internal_state({atom_out_cache_index, + Node}) + end, + nodes()). + + get_conflicting_atoms(_CIX, 0) -> []; get_conflicting_atoms(CIX, N) -> - {A, B, C} = now(), - Atom = list_to_atom("atom" ++ integer_to_list(A*1000000000000 - + B*1000000 - + C)), + Atom = list_to_atom("atom" ++ integer_to_list(erlang:unique_integer([positive]))), case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of - CIX -> - [Atom|get_conflicting_atoms(CIX, N-1)]; - _ -> - get_conflicting_atoms(CIX, N) + CIX -> + [Atom|get_conflicting_atoms(CIX, N-1)]; + _ -> + get_conflicting_atoms(CIX, N) end. get_conflicting_unicode_atoms(_CIX, 0) -> []; get_conflicting_unicode_atoms(CIX, N) -> - {A, B, C} = now(), - Atom = string_to_atom([16#1f608] ++ "atom" ++ integer_to_list(A*1000000000000 - + B*1000000 - + C)), + Atom = string_to_atom([16#1f608] ++ "atom" ++ integer_to_list(erlang:unique_integer([positive]))), case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of - CIX -> - [Atom|get_conflicting_unicode_atoms(CIX, N-1)]; - _ -> - get_conflicting_unicode_atoms(CIX, N) + CIX -> + [Atom|get_conflicting_unicode_atoms(CIX, N-1)]; + _ -> + get_conflicting_unicode_atoms(CIX, N) end. -define(COOKIE, ''). @@ -1381,482 +1303,526 @@ get_conflicting_unicode_atoms(CIX, N) -> -define(DOP_MONITOR_P_EXIT, 21). start_monitor(Offender,P) -> - ?line Parent = self(), - ?line Q = spawn(Offender, - fun () -> - Ref = erlang:monitor(process,P), - Parent ! {self(),ref,Ref}, - receive - just_stay_alive -> ok - end - end), - ?line Ref = receive - {Q,ref,R} -> - R - after 5000 -> - error - end, + Parent = self(), + Q = spawn(Offender, + fun () -> + Ref = erlang:monitor(process,P), + Parent ! {self(),ref,Ref}, + receive + just_stay_alive -> ok + end + end), + Ref = receive + {Q,ref,R} -> + R + after 5000 -> + error + end, io:format("Ref is ~p~n",[Ref]), ok. start_link(Offender,P) -> - ?line Parent = self(), - ?line Q = spawn(Offender, - fun () -> - process_flag(trap_exit,true), - link(P), - Parent ! {self(),ref,P}, - receive - just_stay_alive -> ok - end - end), - ?line Ref = receive - {Q,ref,R} -> - R - after 5000 -> - error - end, + Parent = self(), + Q = spawn(Offender, + fun () -> + process_flag(trap_exit,true), + link(P), + Parent ! {self(),ref,P}, + receive + just_stay_alive -> ok + end + end), + Ref = receive + {Q,ref,R} -> + R + after 5000 -> + error + end, io:format("Ref is ~p~n",[Ref]), ok. -bad_dist_structure(suite) -> - []; -bad_dist_structure(doc) -> - ["Test dist messages with valid structure (binary to term ok) but malformed" - "control content"]; +%% Test dist messages with valid structure (binary to term ok) but malformed control content bad_dist_structure(Config) when is_list(Config) -> - %process_flag(trap_exit,true), - ODog = ?config(watchdog, Config), - ?t:timetrap_cancel(ODog), - Dog = ?t:timetrap(?t:seconds(15)), - - ?line {ok, Offender} = start_node(bad_dist_structure_offender), - ?line {ok, Victim} = start_node(bad_dist_structure_victim), - ?line start_node_monitors([Offender,Victim]), - ?line Parent = self(), - ?line P = spawn(Victim, - fun () -> - process_flag(trap_exit,true), - Parent ! {self(), started}, - receive check_msgs -> ok end, - bad_dist_struct_check_msgs([one, - two]), - Parent ! {self(), messages_checked}, - receive done -> ok end - end), - ?line receive {P, started} -> ok end, - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), - ?line start_monitor(Offender,P), - ?line P ! one, - ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_monitor(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_link(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_LINK},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_link(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_link(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_link(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_link(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_monitor(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_monitor(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_monitor(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_monitor(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line P ! two, - ?line P ! check_msgs, - ?line receive - {P, messages_checked} -> ok - after 5000 -> - exit(victim_is_dead) - end, - - ?line {message_queue_len, 0} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line unlink(P), - ?line P ! done, - ?line stop_node(Offender), - ?line stop_node(Victim), - ?t:timetrap_cancel(Dog), + ct:timetrap({seconds, 15}), + + {ok, Offender} = start_node(bad_dist_structure_offender), + {ok, Victim} = start_node(bad_dist_structure_victim), + start_node_monitors([Offender,Victim]), + Parent = self(), + P = spawn(Victim, + fun () -> + process_flag(trap_exit,true), + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_struct_check_msgs([one, + two]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + receive {P, started} -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + start_monitor(Offender,P), + P ! one, + send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), + send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), + send_bad_structure(Offender, P,{?DOP_LINK},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), + send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), + send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), + send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), + send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), + send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), + send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), + send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), + send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + P ! two, + P ! check_msgs, + receive + {P, messages_checked} -> ok + after 5000 -> + exit(victim_is_dead) + end, + + {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + unlink(P), + P ! done, + stop_node(Offender), + stop_node(Victim), ok. bad_dist_ext_receive(Config) when is_list(Config) -> - ?line {ok, Offender} = start_node(bad_dist_ext_receive_offender), - ?line {ok, Victim} = start_node(bad_dist_ext_receive_victim), - ?line start_node_monitors([Offender,Victim]), - - ?line Parent = self(), - - ?line P = spawn_link(Victim, - fun () -> - Parent ! {self(), started}, - receive check_msgs -> ok end, - bad_dist_ext_check_msgs([one, - two, - three]), - Parent ! {self(), messages_checked}, - receive done -> ok end - end), - - ?line receive {P, started} -> ok end, - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), - ?line P ! one, - ?line send_bad_msg(Offender, P), - ?line P ! two, - ?line verify_down(Offender, connection_closed, Victim, killed), - ?line {message_queue_len, 2} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line Suspended = make_ref(), - ?line S = spawn(Victim, - fun () -> - erlang:suspend_process(P), - Parent ! Suspended, - receive after infinity -> ok end - end), - ?line MS = erlang:monitor(process, S), - ?line receive Suspended -> ok end, - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), - ?line send_bad_msgs(Offender, P, 5), - ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), - ?line P ! three, - ?line send_bad_msgs(Offender, P, 5), + {ok, Offender} = start_node(bad_dist_ext_receive_offender), + {ok, Victim} = start_node(bad_dist_ext_receive_victim), + start_node_monitors([Offender,Victim]), + + Parent = self(), + + P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_ext_check_msgs([one, + two, + three]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + + receive {P, started} -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + P ! one, + send_bad_msg(Offender, P), + P ! two, + verify_down(Offender, connection_closed, Victim, killed), + {message_queue_len, 2} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + Suspended = make_ref(), + S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + MS = erlang:monitor(process, S), + receive Suspended -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + send_bad_msgs(Offender, P, 5), + true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + P ! three, + send_bad_msgs(Offender, P, 5), %% Make sure bad msgs has reached Victim - ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), - - ?line verify_still_up(Offender, Victim), - ?line {message_queue_len, 13} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line exit(S, bang), - ?line receive {'DOWN', MS, process, S, bang} -> ok end, - ?line verify_down(Offender, connection_closed, Victim, killed), - ?line {message_queue_len, 3} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line P ! check_msgs, - ?line receive {P, messages_checked} -> ok end, - - ?line {message_queue_len, 0} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line P ! done, - ?line unlink(P), - ?line verify_no_down(Offender, Victim), - ?line stop_node(Offender), - ?line stop_node(Victim). + rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + + verify_still_up(Offender, Victim), + {message_queue_len, 13} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + exit(S, bang), + receive {'DOWN', MS, process, S, bang} -> ok end, + verify_down(Offender, connection_closed, Victim, killed), + {message_queue_len, 3} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + P ! check_msgs, + receive {P, messages_checked} -> ok end, + + {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + P ! done, + unlink(P), + verify_no_down(Offender, Victim), + stop_node(Offender), + stop_node(Victim). bad_dist_ext_process_info(Config) when is_list(Config) -> - ?line {ok, Offender} = start_node(bad_dist_ext_process_info_offender), - ?line {ok, Victim} = start_node(bad_dist_ext_process_info_victim), - ?line start_node_monitors([Offender,Victim]), - - ?line Parent = self(), - ?line P = spawn_link(Victim, - fun () -> - Parent ! {self(), started}, - receive check_msgs -> ok end, - bad_dist_ext_check_msgs([one, two]), - Parent ! {self(), messages_checked}, - receive done -> ok end - end), - - ?line receive {P, started} -> ok end, - ?line P ! one, - - ?line Suspended = make_ref(), - ?line S = spawn(Victim, - fun () -> - erlang:suspend_process(P), - Parent ! Suspended, - receive after infinity -> ok end - end), - - ?line receive Suspended -> ok end, - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line send_bad_msgs(Offender, P, 5), - - ?line P ! two, - ?line send_bad_msgs(Offender, P, 5), + {ok, Offender} = start_node(bad_dist_ext_process_info_offender), + {ok, Victim} = start_node(bad_dist_ext_process_info_victim), + start_node_monitors([Offender,Victim]), + + Parent = self(), + P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_ext_check_msgs([one, two]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + + receive {P, started} -> ok end, + P ! one, + + Suspended = make_ref(), + S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + + receive Suspended -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + send_bad_msgs(Offender, P, 5), + + P ! two, + send_bad_msgs(Offender, P, 5), %% Make sure bad msgs has reached Victim - ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), - - ?line verify_still_up(Offender, Victim), - ?line {message_queue_len, 12} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - ?line verify_still_up(Offender, Victim), - ?line [{message_queue_len, 2}, - {messages, [one, two]}] - = rpc:call(Victim, erlang, process_info, [P, [message_queue_len, - messages]]), - ?line verify_down(Offender, connection_closed, Victim, killed), - - ?line P ! check_msgs, - ?line exit(S, bang), - ?line receive {P, messages_checked} -> ok end, - - ?line {message_queue_len, 0} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line P ! done, - ?line unlink(P), - ?line verify_no_down(Offender, Victim), - ?line stop_node(Offender), - ?line stop_node(Victim). + rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + + verify_still_up(Offender, Victim), + {message_queue_len, 12} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + verify_still_up(Offender, Victim), + [{message_queue_len, 2}, + {messages, [one, two]}] + = rpc:call(Victim, erlang, process_info, [P, [message_queue_len, + messages]]), + verify_down(Offender, connection_closed, Victim, killed), + + P ! check_msgs, + exit(S, bang), + receive {P, messages_checked} -> ok end, + + {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + P ! done, + unlink(P), + verify_no_down(Offender, Victim), + stop_node(Offender), + stop_node(Victim). bad_dist_ext_control(Config) when is_list(Config) -> - ?line {ok, Offender} = start_node(bad_dist_ext_control_offender), - ?line {ok, Victim} = start_node(bad_dist_ext_control_victim), - ?line start_node_monitors([Offender,Victim]), + {ok, Offender} = start_node(bad_dist_ext_control_offender), + {ok, Victim} = start_node(bad_dist_ext_control_victim), + start_node_monitors([Offender,Victim]), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line send_bad_dhdr(Offender, Victim), - ?line verify_down(Offender, connection_closed, Victim, killed), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + send_bad_dhdr(Offender, Victim), + verify_down(Offender, connection_closed, Victim, killed), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line send_bad_ctl(Offender, Victim), - ?line verify_down(Offender, connection_closed, Victim, killed), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + send_bad_ctl(Offender, Victim), + verify_down(Offender, connection_closed, Victim, killed), - ?line verify_no_down(Offender, Victim), - ?line stop_node(Offender), - ?line stop_node(Victim). + verify_no_down(Offender, Victim), + stop_node(Offender), + stop_node(Victim). bad_dist_ext_connection_id(Config) when is_list(Config) -> - ?line {ok, Offender} = start_node(bad_dist_ext_connection_id_offender), - ?line {ok, Victim} = start_node(bad_dist_ext_connection_id_victim), - ?line start_node_monitors([Offender,Victim]), - - ?line Parent = self(), - ?line P = spawn_link(Victim, - fun () -> - Parent ! {self(), started}, - receive check_msgs -> ok end, - bad_dist_ext_check_msgs([]), - Parent ! {self(), messages_checked}, - receive done -> ok end - end), - - ?line receive {P, started} -> ok end, - ?line Suspended = make_ref(), - ?line S = spawn(Victim, - fun () -> - erlang:suspend_process(P), - Parent ! Suspended, - receive after infinity -> ok end - end), - ?line MS = erlang:monitor(process, S), - ?line receive Suspended -> ok end, - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line send_bad_msg(Offender, P), + {ok, Offender} = start_node(bad_dist_ext_connection_id_offender), + {ok, Victim} = start_node(bad_dist_ext_connection_id_victim), + start_node_monitors([Offender,Victim]), + + Parent = self(), + P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_ext_check_msgs([]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + + receive {P, started} -> ok end, + Suspended = make_ref(), + S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + MS = erlang:monitor(process, S), + receive Suspended -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + send_bad_msg(Offender, P), %% Make sure bad msg has reached Victim - ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), - ?line {message_queue_len, 1} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + {message_queue_len, 1} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - ?line true = rpc:call(Offender, net_kernel, disconnect, [Victim]), - ?line verify_down(Offender, disconnect, Victim, connection_closed), - ?line pong = rpc:call(Offender, net_adm, ping, [Victim]), + true = rpc:call(Offender, net_kernel, disconnect, [Victim]), + verify_down(Offender, disconnect, Victim, connection_closed), + pong = rpc:call(Offender, net_adm, ping, [Victim]), - ?line verify_up(Offender, Victim), + verify_up(Offender, Victim), %% We have a new connection between Offender and Victim, bad message %% should not bring it down. - ?line {message_queue_len, 1} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + {message_queue_len, 1} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - ?line exit(S, bang), - ?line receive {'DOWN', MS, process, S, bang} -> ok end, + exit(S, bang), + receive {'DOWN', MS, process, S, bang} -> ok end, %% Wait for a while (if the connection is taken down it might take a %% while). - ?line receive after 2000 -> ok end, - ?line verify_still_up(Offender, Victim), + receive after 2000 -> ok end, + verify_still_up(Offender, Victim), + + P ! check_msgs, + receive {P, messages_checked} -> ok end, + + {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + verify_still_up(Offender, Victim), + P ! done, + unlink(P), + verify_no_down(Offender, Victim), + stop_node(Offender), + stop_node(Victim). + +%% OTP-14661: Bad message is discovered by erts_msg_attached_data_size +bad_dist_ext_size(Config) when is_list(Config) -> + {ok, Offender} = start_node(bad_dist_ext_process_info_offender), + %%Prog = "Prog=/home/uabseri/src/otp_new3/bin/cerl -rr -debug", + Prog = [], + {ok, Victim} = start_node(bad_dist_ext_process_info_victim, [], Prog), + start_node_monitors([Offender,Victim]), - ?line P ! check_msgs, - ?line receive {P, messages_checked} -> ok end, + Parent = self(), + P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, %% DID CRASH HERE + bad_dist_ext_check_msgs([one]), + Parent ! {self(), messages_checked} + end), + + receive {P, started} -> ok end, + P ! one, + + Suspended = make_ref(), + S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + + receive Suspended -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + send_bad_msgs(Offender, P, 1, dmsg_bad_tag()), + + %% Make sure bad msgs has reached Victim + rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + + verify_still_up(Offender, Victim), + + rpc:call(Victim, erlang, process_info, [P, total_heap_size]), - ?line {message_queue_len, 0} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line verify_still_up(Offender, Victim), - ?line P ! done, - ?line unlink(P), - ?line verify_no_down(Offender, Victim), - ?line stop_node(Offender), - ?line stop_node(Victim). + verify_down(Offender, connection_closed, Victim, killed), + + P ! check_msgs, + exit(S, bang), % resume Victim + receive {P, messages_checked} -> ok end, + + unlink(P), + verify_no_down(Offender, Victim), + stop_node(Offender), + stop_node(Victim). bad_dist_struct_check_msgs([]) -> receive - Msg -> - exit({unexpected_message, Msg}) + Msg -> + exit({unexpected_message, Msg}) after 0 -> - ok + ok end; bad_dist_struct_check_msgs([M|Ms]) -> receive - {'EXIT',_,_} = EM -> - io:format("Ignoring exit message: ~p~n",[EM]), - bad_dist_struct_check_msgs([M|Ms]); - Msg -> - M = Msg, - bad_dist_struct_check_msgs(Ms) + {'EXIT',_,_} = EM -> + io:format("Ignoring exit message: ~p~n",[EM]), + bad_dist_struct_check_msgs([M|Ms]); + Msg -> + M = Msg, + bad_dist_struct_check_msgs(Ms) end. bad_dist_ext_check_msgs([]) -> receive - Msg -> - exit({unexpected_message, Msg}) + Msg -> + exit({unexpected_message, Msg}) after 0 -> - ok + ok end; bad_dist_ext_check_msgs([M|Ms]) -> receive - Msg -> - M = Msg, - bad_dist_ext_check_msgs(Ms) + Msg -> + M = Msg, + bad_dist_ext_check_msgs(Ms) + end. + +ensure_dctrl(Node) -> + case dctrl(Node) of + undefined -> + pong = net_adm:ping(Node), + dctrl(Node); + DCtrl -> + DCtrl end. - - -dport_reg_send(Node, Name, Msg) -> - DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, - port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_REG_SEND, - self(), - ?COOKIE, - Name}), - dmsg_ext(Msg)]). - - -dport_send(To, Msg) -> + +dctrl_send(DPrt, Data) when is_port(DPrt) -> + port_command(DPrt, Data); +dctrl_send(DPid, Data) when is_pid(DPid) -> + Ref = make_ref(), + DPid ! {send, self(), Ref, Data}, + receive {Ref, Res} -> Res end. + +dctrl_dop_reg_send(Node, Name, Msg) -> + dctrl_send(ensure_dctrl(Node), + [dmsg_hdr(), + dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + Name}), + dmsg_ext(Msg)]). + +dctrl_dop_send(To, Msg) -> Node = node(To), - DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, - port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_SEND, - ?COOKIE, - To}), - dmsg_ext(Msg)]). + dctrl_send(ensure_dctrl(Node), + [dmsg_hdr(), + dmsg_ext({?DOP_SEND, ?COOKIE, To}), + dmsg_ext(Msg)]). + send_bad_structure(Offender,Victim,Bad,WhereToPutSelf) -> send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,[]). send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> Parent = self(), Done = make_ref(), spawn(Offender, - fun () -> - Node = node(Victim), - pong = net_adm:ping(Node), - DPrt = dport(Node), - Bad1 = case WhereToPutSelf of - 0 -> - Bad; - N when N > 0 -> - setelement(N,Bad,self()) - end, - DData = [dmsg_hdr(), - dmsg_ext(Bad1)] ++ - case PayLoad of - [] -> []; - _Other -> [dmsg_ext(PayLoad)] - end, - port_command(DPrt, DData), - Parent ! {DData,Done} - end), - receive - {WhatSent,Done} -> - io:format("Offender sent ~p~n",[WhatSent]), - ok + fun () -> + Node = node(Victim), + pong = net_adm:ping(Node), + DCtrl = dctrl(Node), + Bad1 = case WhereToPutSelf of + 0 -> + Bad; + N when N > 0 -> + setelement(N,Bad,self()) + end, + DData = [dmsg_hdr(), + dmsg_ext(Bad1)] ++ + case PayLoad of + [] -> []; + _Other -> [dmsg_ext(PayLoad)] + end, + dctrl_send(DCtrl, DData), + Parent ! {DData,Done} + end), + receive + {WhatSent,Done} -> + io:format("Offender sent ~p~n",[WhatSent]), + ok after 5000 -> - exit(unable_to_send) + exit(unable_to_send) end. - + %% send_bad_msgs(): %% Send a valid distribution header and control message @@ -1865,22 +1831,25 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> send_bad_msg(BadNode, To) -> send_bad_msgs(BadNode, To, 1). -send_bad_msgs(BadNode, To, Repeat) when is_atom(BadNode), - is_pid(To), - is_integer(Repeat) -> +send_bad_msgs(BadNode, To, Repeat) -> + send_bad_msgs(BadNode, To, Repeat, dmsg_bad_atom_cache_ref()). + +send_bad_msgs(BadNode, To, Repeat, BadTerm) when is_atom(BadNode), + is_pid(To), + is_integer(Repeat) -> Parent = self(), Done = make_ref(), spawn_link(BadNode, - fun () -> - Node = node(To), - pong = net_adm:ping(Node), - DPrt = dport(Node), - DData = [dmsg_hdr(), - dmsg_ext({?DOP_SEND, ?COOKIE, To}), - dmsg_bad_atom_cache_ref()], - repeat(fun () -> port_command(DPrt, DData) end, Repeat), - Parent ! Done - end), + fun () -> + Node = node(To), + pong = net_adm:ping(Node), + DCtrl = dctrl(Node), + DData = [dmsg_hdr(), + dmsg_ext({?DOP_SEND, ?COOKIE, To}), + BadTerm], + repeat(fun () -> dctrl_send(DCtrl, DData) end, Repeat), + Parent ! Done + end), receive Done -> ok end. %% send_bad_ctl(): @@ -1889,24 +1858,25 @@ send_bad_ctl(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> Parent = self(), Done = make_ref(), spawn_link(BadNode, - fun () -> - pong = net_adm:ping(ToNode), - %% We creat a valid ctl msg and replace an - %% atom with an invalid atom cache reference - <<131,Replace/binary>> = term_to_binary(replace), - Ctl = dmsg_ext({?DOP_REG_SEND, - self(), - ?COOKIE, - replace}), - CtlBeginSize = size(Ctl) - size(Replace), - <<CtlBegin:CtlBeginSize/binary, Replace/binary>> = Ctl, - port_command(dport(ToNode), - [dmsg_fake_hdr2(), - CtlBegin, - dmsg_bad_atom_cache_ref(), - dmsg_ext({a, message})]), - Parent ! Done - end), + fun () -> + pong = net_adm:ping(ToNode), + %% We creat a valid ctl msg and replace an + %% atom with an invalid atom cache reference + <<131,Replace/binary>> = term_to_binary(replace), + Ctl = dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + replace}), + CtlBeginSize = size(Ctl) - size(Replace), + <<CtlBegin:CtlBeginSize/binary, Replace/binary>> = Ctl, + DCtrl = dctrl(ToNode), + Data = [dmsg_fake_hdr2(), + CtlBegin, + dmsg_bad_atom_cache_ref(), + dmsg_ext({a, message})], + dctrl_send(DCtrl, Data), + Parent ! Done + end), receive Done -> ok end. %% send_bad_dhr(): @@ -1915,19 +1885,19 @@ send_bad_dhdr(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> Parent = self(), Done = make_ref(), spawn_link(BadNode, - fun () -> - pong = net_adm:ping(ToNode), - port_command(dport(ToNode), dmsg_bad_hdr()), - Parent ! Done - end), + fun () -> + pong = net_adm:ping(ToNode), + dctrl_send(dctrl(ToNode), dmsg_bad_hdr()), + Parent ! Done + end), receive Done -> ok end. -dport(Node) when is_atom(Node) -> +dctrl(Node) when is_atom(Node) -> case catch erts_debug:get_internal_state(available_internal_state) of - true -> true; - _ -> erts_debug:set_internal_state(available_internal_state, true) + true -> true; + _ -> erts_debug:set_internal_state(available_internal_state, true) end, - erts_debug:get_internal_state({dist_port, Node}). + erts_debug:get_internal_state({dist_ctrl, Node}). dmsg_hdr() -> [131, % Version Magic @@ -1938,7 +1908,7 @@ dmsg_bad_hdr() -> [131, % Version Magic $D, % Dist header 255]. % 255 atom references - + %% dmsg_fake_hdr1() -> %% A = <<"fake header atom 1">>, @@ -1957,18 +1927,82 @@ dmsg_fake_hdr2() -> 1, size(A2), A2, 2, size(A3), A3]. -dmsg_ext(Term) -> +dmsg_ext(Term) -> <<131, Res/binary>> = term_to_binary(Term), Res. dmsg_bad_atom_cache_ref() -> [$R, 137]. +dmsg_bad_tag() -> %% Will fail early at heap size calculation + [$?, 66]. + +start_epmd_false(Config) when is_list(Config) -> + %% Start a node with the option -start_epmd false. + {ok, OtherNode} = start_node(start_epmd_false, "-start_epmd false"), + %% We should be able to ping it, as epmd was started by us: + pong = net_adm:ping(OtherNode), + stop_node(OtherNode), + + ok. + +epmd_module(Config) when is_list(Config) -> + %% We need a relay node to test this, since the test node uses the + %% standard epmd module. + Sock1 = start_relay_node(epmd_module_node1, "-epmd_module " ++ ?MODULE_STRING), + Node1 = inet_rpc_nodename(Sock1), + %% Ask what port it's listening on - it won't have registered with + %% epmd. + {ok, {ok, Port1}} = do_inet_rpc(Sock1, application, get_env, [kernel, dist_listen_port]), + + %% Start a second node, passing the port number as a secret + %% argument. + Sock2 = start_relay_node(epmd_module_node2, "-epmd_module " ++ ?MODULE_STRING + ++ " -other_node_port " ++ integer_to_list(Port1)), + Node2 = inet_rpc_nodename(Sock2), + %% Node 1 can't ping node 2 + {ok, pang} = do_inet_rpc(Sock1, net_adm, ping, [Node2]), + {ok, []} = do_inet_rpc(Sock1, erlang, nodes, []), + {ok, []} = do_inet_rpc(Sock2, erlang, nodes, []), + %% But node 2 can ping node 1 + {ok, pong} = do_inet_rpc(Sock2, net_adm, ping, [Node1]), + {ok, [Node2]} = do_inet_rpc(Sock1, erlang, nodes, []), + {ok, [Node1]} = do_inet_rpc(Sock2, erlang, nodes, []), + + stop_relay_node(Sock2), + stop_relay_node(Sock1). + +%% epmd_module functions: + +start_link() -> + ignore. + +register_node(Name, Port) -> + register_node(Name, Port, inet_tcp). +register_node(_Name, Port, _Driver) -> + %% Save the port number we're listening on. + application:set_env(kernel, dist_listen_port, Port), + Creation = rand:uniform(3), + {ok, Creation}. + +port_please(_Name, _Ip) -> + case init:get_argument(other_node_port) of + error -> + %% None specified. Default to 42. + Port = 42, + Version = 5, + {port, Port, Version}; + {ok, [[PortS]]} -> + %% Port number given on command line. + Port = list_to_integer(PortS), + Version = 5, + {port, Port, Version} + end. + %%% Utilities timestamp() -> - {A,B,C} = erlang:now(), - (C div 1000) + (B * 1000) + (A * 1000000000). + erlang:monotonic_time(millisecond). start_node(X) -> start_node(X, [], []). @@ -1980,19 +2014,21 @@ start_node(Name, Args, Rel) when is_atom(Name), is_list(Rel) -> Pa = filename:dirname(code:which(?MODULE)), Cookie = atom_to_list(erlang:get_cookie()), RelArg = case Rel of - [] -> []; - _ -> [{erl,[{release,Rel}]}] - end, - test_server:start_node(Name, slave, - [{args, - Args++" -setcookie "++Cookie++" -pa \""++Pa++"\""} - | RelArg]); + [] -> []; + _ -> [{erl,[{release,Rel}]}] + end, + test_server:start_node(Name, slave, + [{args, + Args++" -setcookie "++Cookie++" -pa \""++Pa++"\""} + | RelArg]); start_node(Config, Args, Rel) when is_list(Config), is_list(Rel) -> Name = list_to_atom((atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(timestamp()))), + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive])))), start_node(Name, Args, Rel). stop_node(Node) -> @@ -2003,13 +2039,13 @@ freeze_node(Node, MS) -> DoingIt = make_ref(), Freezer = self(), spawn_link(Node, - fun () -> - erts_debug:set_internal_state(available_internal_state, - true), - dport_send(Freezer, DoingIt), - receive after Own -> ok end, - erts_debug:set_internal_state(block, MS+Own) - end), + fun () -> + erts_debug:set_internal_state(available_internal_state, + true), + dctrl_dop_send(Freezer, DoingIt), + receive after Own -> ok end, + erts_debug:set_internal_state(block, MS+Own) + end), receive DoingIt -> ok end, receive after Own -> ok end. @@ -2020,47 +2056,45 @@ do_inet_rpc({_,_,Sock},M,F,A) -> Bin = term_to_binary({M,F,A}), gen_tcp:send(Sock,Bin), case gen_tcp:recv(Sock,0) of - {ok, Bin2} -> - T = binary_to_term(Bin2), - {ok,T}; - Else -> - {error, Else} + {ok, Bin2} -> + T = binary_to_term(Bin2), + {ok,T}; + Else -> + {error, Else} end. inet_rpc_server([Host, PortList]) -> Port = list_to_integer(PortList), {ok, Sock} = gen_tcp:connect(Host, Port,[binary, {packet, 4}, - {active, false}]), + {active, false}]), inet_rpc_server_loop(Sock). inet_rpc_server_loop(Sock) -> case gen_tcp:recv(Sock,0) of - {ok, Bin} -> - {M,F,A} = binary_to_term(Bin), - Res = (catch apply(M,F,A)), - RB = term_to_binary(Res), - gen_tcp:send(Sock,RB), - inet_rpc_server_loop(Sock); - _ -> - erlang:halt() + {ok, Bin} -> + {M,F,A} = binary_to_term(Bin), + Res = (catch apply(M,F,A)), + RB = term_to_binary(Res), + gen_tcp:send(Sock,RB), + inet_rpc_server_loop(Sock); + _ -> + erlang:halt() end. - + start_relay_node(Node, Args) -> Pa = filename:dirname(code:which(?MODULE)), Cookie = "NOT"++atom_to_list(erlang:get_cookie()), - {ok, LSock} = gen_tcp:listen(0, [binary, {packet, 4}, - {active, false}]), + {ok, LSock} = gen_tcp:listen(0, [binary, {packet, 4}, {active, false}]), {ok, Port} = inet:port(LSock), {ok, Host} = inet:gethostname(), RunArg = "-run " ++ atom_to_list(?MODULE) ++ " inet_rpc_server " ++ - Host ++ " " ++ integer_to_list(Port), - {ok, NN} = - test_server:start_node(Node, peer, - [{args, Args ++ - " -setcookie "++Cookie++" -pa "++Pa++" "++ - RunArg}]), - [N,H] = string:tokens(atom_to_list(NN),"@"), + Host ++ " " ++ integer_to_list(Port), + {ok, NN} = test_server:start_node(Node, peer, + [{args, Args ++ + " -setcookie "++Cookie++" -pa "++Pa++" "++ + RunArg}]), + [N,H] = string:lexemes(atom_to_list(NN),"@"), {ok, Sock} = gen_tcp:accept(LSock), pang = net_adm:ping(NN), {N,H,Sock}. @@ -2074,28 +2108,28 @@ wait_dead(N,H,0) -> {error,{not_dead,N,H}}; wait_dead(N,H,X) -> case erl_epmd:port_please(N,H) of - {port,_,_} -> - receive - after 1000 -> - ok - end, - wait_dead(N,H,X-1); - noport -> - ok; - Else -> - {error, {unexpected, Else}} + {port,_,_} -> + receive + after 1000 -> + ok + end, + wait_dead(N,H,X-1); + noport -> + ok; + Else -> + {error, {unexpected, Else}} end. - + start_node_monitors(Nodes) -> Master = self(), lists:foreach(fun (Node) -> - spawn(Node, - fun () -> - node_monitor(Master) - end) - end, - Nodes), + spawn(Node, + fun () -> + node_monitor(Master) + end) + end, + Nodes), ok. node_monitor(Master) -> @@ -2104,42 +2138,42 @@ node_monitor(Master) -> net_kernel:monitor_nodes(true, Opts), Nodes1 = nodes(connected), case lists:sort(Nodes0) == lists:sort(Nodes1) of - true -> - lists:foreach(fun (Node) -> - Master ! {nodeup, node(), Node} - end, - Nodes0), - ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Nodes0]), - node_monitor_loop(Master); - false -> - net_kernel:monitor_nodes(false, Opts), - flush_node_changes(), - node_monitor(Master) + true -> + lists:foreach(fun (Node) -> + Master ! {nodeup, node(), Node} + end, + Nodes0), + io:format("~p ~p: ~p~n", [node(), erlang:system_time(microsecond), Nodes0]), + node_monitor_loop(Master); + false -> + net_kernel:monitor_nodes(false, Opts), + flush_node_changes(), + node_monitor(Master) end. flush_node_changes() -> receive - {NodeChange, _Node, _InfoList} when NodeChange == nodeup; - NodeChange == nodedown -> - flush_node_changes() + {NodeChange, _Node, _InfoList} when NodeChange == nodeup; + NodeChange == nodedown -> + flush_node_changes() after 0 -> - ok + ok end. node_monitor_loop(Master) -> receive - {nodeup, Node, _InfoList} = Msg -> - Master ! {nodeup, node(), Node}, - ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Msg]), - node_monitor_loop(Master); - {nodedown, Node, InfoList} = Msg -> - Reason = case lists:keysearch(nodedown_reason, 1, InfoList) of - {value, {nodedown_reason, R}} -> R; - _ -> undefined - end, - Master ! {nodedown, node(), Node, Reason}, - ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Msg]), - node_monitor_loop(Master) + {nodeup, Node, _InfoList} = Msg -> + Master ! {nodeup, node(), Node}, + io:format("~p ~p: ~p~n", [node(), erlang:system_time(microsecond), Msg]), + node_monitor_loop(Master); + {nodedown, Node, InfoList} = Msg -> + Reason = case lists:keysearch(nodedown_reason, 1, InfoList) of + {value, {nodedown_reason, R}} -> R; + _ -> undefined + end, + Master ! {nodedown, node(), Node, Reason}, + io:format("~p ~p: ~p~n", [node(), erlang:system_time(microsecond), Msg]), + node_monitor_loop(Master) end. verify_up(A, B) -> @@ -2153,16 +2187,16 @@ verify_still_up(A, B) -> verify_no_down(A, B) -> receive - {nodedown, A, B, _} = Msg0 -> - ?t:fail(Msg0) + {nodedown, A, B, _} = Msg0 -> + ct:fail(Msg0) after 0 -> - ok + ok end, receive - {nodedown, B, A, _} = Msg1 -> - ?t:fail(Msg1) + {nodedown, B, A, _} = Msg1 -> + ct:fail(Msg1) after 0 -> - ok + ok end. %% verify_down(A, B) -> @@ -2171,12 +2205,12 @@ verify_no_down(A, B) -> verify_down(A, ReasonA, B, ReasonB) -> receive - {nodedown, A, B, _} = Msg0 -> - {nodedown, A, B, ReasonA} = Msg0 + {nodedown, A, B, _} = Msg0 -> + {nodedown, A, B, ReasonA} = Msg0 end, receive - {nodedown, B, A, _} = Msg1 -> - {nodedown, B, A, ReasonB} = Msg1 + {nodedown, B, A, _} = Msg1 -> + {nodedown, B, A, ReasonB} = Msg1 end, ok. @@ -2196,17 +2230,17 @@ from(_, []) -> []. long_or_short() -> case net_kernel:longnames() of - true -> " -name "; - false -> " -sname " + true -> " -name "; + false -> " -sname " end. until(Fun) -> case Fun() of - true -> - ok; - false -> - receive after 10 -> ok end, - until(Fun) + true -> + ok; + false -> + receive after 10 -> ok end, + until(Fun) end. forever(Fun) -> @@ -2231,9 +2265,9 @@ stop_busy_dist_port_tracer(_) -> busy_dist_port_tracer() -> receive - {monitor, _SuspendedProcess, busy_dist_port, _Port} = M -> - erlang:display(M), - busy_dist_port_tracer() + {monitor, _SuspendedProcess, busy_dist_port, _Port} = M -> + erlang:display(M), + busy_dist_port_tracer() end. repeat(_Fun, 0) -> @@ -2246,106 +2280,60 @@ string_to_atom_ext(String) -> Utf8List = string_to_utf8_list(String), Len = length(Utf8List), case Len < 256 of - true -> - [?SMALL_ATOM_UTF8_EXT, Len | Utf8List]; - false -> - [?ATOM_UTF8_EXT, Len bsr 8, Len band 16#ff | Utf8List] + true -> + [?SMALL_ATOM_UTF8_EXT, Len | Utf8List]; + false -> + [?ATOM_UTF8_EXT, Len bsr 8, Len band 16#ff | Utf8List] end. string_to_atom(String) -> binary_to_term(list_to_binary([?VERSION_MAGIC - | string_to_atom_ext(String)])). + | string_to_atom_ext(String)])). string_to_utf8_list([]) -> []; string_to_utf8_list([CP|CPs]) when is_integer(CP), - 0 =< CP, - CP =< 16#7F -> + 0 =< CP, + CP =< 16#7F -> [CP | string_to_utf8_list(CPs)]; string_to_utf8_list([CP|CPs]) when is_integer(CP), - 16#80 =< CP, - CP =< 16#7FF -> + 16#80 =< CP, + CP =< 16#7FF -> [16#C0 bor (CP bsr 6), 16#80 bor (16#3F band CP) | string_to_utf8_list(CPs)]; string_to_utf8_list([CP|CPs]) when is_integer(CP), - 16#800 =< CP, - CP =< 16#FFFF -> + 16#800 =< CP, + CP =< 16#FFFF -> [16#E0 bor (CP bsr 12), 16#80 bor (16#3F band (CP bsr 6)), 16#80 bor (16#3F band CP) | string_to_utf8_list(CPs)]; string_to_utf8_list([CP|CPs]) when is_integer(CP), - 16#10000 =< CP, - CP =< 16#10FFFF -> + 16#10000 =< CP, + CP =< 16#10FFFF -> [16#F0 bor (CP bsr 18), 16#80 bor (16#3F band (CP bsr 12)), 16#80 bor (16#3F band (CP bsr 6)), 16#80 bor (16#3F band CP) | string_to_utf8_list(CPs)]. -utf8_list_to_string([]) -> - []; -utf8_list_to_string([B|Bs]) when is_integer(B), - 0 =< B, - B =< 16#7F -> - [B | utf8_list_to_string(Bs)]; -utf8_list_to_string([B0, B1 | Bs]) when is_integer(B0), - 16#C0 =< B0, - B0 =< 16#DF, - is_integer(B1), - 16#80 =< B1, - B1 =< 16#BF -> - [(((B0 band 16#1F) bsl 6) - bor (B1 band 16#3F)) - | utf8_list_to_string(Bs)]; -utf8_list_to_string([B0, B1, B2 | Bs]) when is_integer(B0), - 16#E0 =< B0, - B0 =< 16#EF, - is_integer(B1), - 16#80 =< B1, - B1 =< 16#BF, - is_integer(B2), - 16#80 =< B2, - B2 =< 16#BF -> - [(((B0 band 16#F) bsl 12) - bor ((B1 band 16#3F) bsl 6) - bor (B2 band 16#3F)) - | utf8_list_to_string(Bs)]; -utf8_list_to_string([B0, B1, B2, B3 | Bs]) when is_integer(B0), - 16#F0 =< B0, - B0 =< 16#F7, - is_integer(B1), - 16#80 =< B1, - B1 =< 16#BF, - is_integer(B2), - 16#80 =< B2, - B2 =< 16#BF, - is_integer(B3), - 16#80 =< B3, - B3 =< 16#BF -> - [(((B0 band 16#7) bsl 18) - bor ((B1 band 16#3F) bsl 12) - bor ((B2 band 16#3F) bsl 6) - bor (B3 band 16#3F)) - | utf8_list_to_string(Bs)]. - mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), mk_pid({NodeNameExt, Creation}, Number, Serial); mk_pid({NodeNameExt, Creation}, Number, Serial) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PID_EXT, - NodeNameExt, - uint32_be(Number), - uint32_be(Serial), - uint8(Creation)])) of - Pid when is_pid(Pid) -> - Pid; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_pid, [{NodeNameExt, Creation}, Number, Serial]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?PID_EXT, + NodeNameExt, + uint32_be(Number), + uint32_be(Serial), + uint8(Creation)])) of + Pid when is_pid(Pid) -> + Pid; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_pid, [{NodeNameExt, Creation}, Number, Serial]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> @@ -2353,59 +2341,59 @@ mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> mk_port({NodeNameExt, Creation}, Number); mk_port({NodeNameExt, Creation}, Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PORT_EXT, - NodeNameExt, - uint32_be(Number), - uint8(Creation)])) of - Port when is_port(Port) -> - Port; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_port, [{NodeNameExt, Creation}, Number]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?PORT_EXT, + NodeNameExt, + uint32_be(Number), + uint8(Creation)])) of + Port when is_port(Port) -> + Port; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_port, [{NodeNameExt, Creation}, Number]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. mk_ref({NodeName, Creation}, [Number] = NL) when is_atom(NodeName), - is_integer(Creation), - is_integer(Number) -> + is_integer(Creation), + is_integer(Number) -> <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), mk_ref({NodeNameExt, Creation}, NL); mk_ref({NodeNameExt, Creation}, [Number]) when is_integer(Creation), - is_integer(Number) -> + is_integer(Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?REFERENCE_EXT, - NodeNameExt, - uint32_be(Number), - uint8(Creation)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeNameExt, Creation}, [Number]]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?REFERENCE_EXT, + NodeNameExt, + uint32_be(Number), + uint8(Creation)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeNameExt, Creation}, [Number]]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end; mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), - is_integer(Creation), - is_list(Numbers) -> + is_integer(Creation), + is_list(Numbers) -> <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), mk_ref({NodeNameExt, Creation}, Numbers); mk_ref({NodeNameExt, Creation}, Numbers) when is_integer(Creation), - is_list(Numbers) -> + is_list(Numbers) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEW_REFERENCE_EXT, - uint16_be(length(Numbers)), - NodeNameExt, - uint8(Creation), - lists:map(fun (N) -> - uint32_be(N) - end, - Numbers)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeNameExt, Creation}, Numbers]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?NEW_REFERENCE_EXT, + uint16_be(length(Numbers)), + NodeNameExt, + uint8(Creation), + lists:map(fun (N) -> + uint32_be(N) + end, + Numbers)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeNameExt, Creation}, Numbers]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. diff --git a/erts/emulator/test/distribution_SUITE_data/run.erl b/erts/emulator/test/distribution_SUITE_data/run.erl index e2137a1ec5..f574b2c02c 100644 --- a/erts/emulator/test/distribution_SUITE_data/run.erl +++ b/erts/emulator/test/distribution_SUITE_data/run.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,16 +30,19 @@ from(H, [_ | T]) -> from(H, T); from(H, []) -> []. start() -> - net_kernel:start([fideridum,shortnames]), - {ok, Node} = slave:start(host(), heppel), - P = spawn(Node, a, b, []), - B1 = term_to_binary(P), - N1 = node(P), - ok = net_kernel:stop(), - N2 = node(P), - io:format("~w~n", [N1 == N2]), + Result = do_it(), + + %% Do GCs and node_and_dist_references + %% in an attempt to crash the VM (without OTP-13076 fix) + lists:foreach(fun(P) -> erlang:garbage_collect(P) end, + processes()), + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:get_internal_state(node_and_dist_references), + + io:format("~w~n", [Result]), + if - N1 == N2 -> + Result -> init:stop(); true -> %% Make sure that the io:format/2 output is really written @@ -46,3 +50,29 @@ start() -> erlang:yield(), init:stop() end. + + +do_it() -> + {ok, _} = net_kernel:start([fideridum,shortnames]), + {ok, Node} = slave:start(host(), heppel), + P = spawn(Node, net_kernel, stop, []), + B1 = term_to_binary(P), + N1 = node(P), + ok = net_kernel:stop(), + N2 = node(P), + + %% OTP-13076 + %% Restart distribution with same node name as previous remote node + %% Repeat to wrap around creation + Result = lists:foldl(fun(_, Acc) -> + timer:sleep(2), % give net_kernel:stop() time to take effect :-( + {ok, _} = net_kernel:start([heppel,shortnames]), + N3 = node(P), + ok = net_kernel:stop(), + N4 = node(P), + Acc and (N3 =:= N1) and (N4 =:= N1) + end, + (N2 =:= N1), + lists:seq(1,3)), + + Result. diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index c62bc0c454..475e03087a 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% @@ -28,62 +29,64 @@ -module(driver_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, - end_per_suite/1, init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, - outputv_echo/1, - - timer_measure/1, - timer_cancel/1, - timer_change/1, - timer_delay/1, - queue_echo/1, - outputv_errors/1, - driver_unloaded/1, - io_ready_exit/1, - use_fallback_pollset/1, - bad_fd_in_pollset/1, - driver_event/1, - fd_change/1, - steal_control/1, - otp_6602/1, - driver_system_info_base_ver/1, - driver_system_info_prev_ver/1, - driver_system_info_current_ver/1, - driver_monitor/1, - - ioq_exit_ready_input/1, - ioq_exit_ready_output/1, - ioq_exit_timeout/1, - ioq_exit_ready_async/1, - ioq_exit_event/1, - ioq_exit_ready_input_async/1, - ioq_exit_ready_output_async/1, - ioq_exit_timeout_async/1, - ioq_exit_event_async/1, - zero_extended_marker_garb_drv/1, - invalid_extended_marker_drv/1, - larger_major_vsn_drv/1, - larger_minor_vsn_drv/1, - smaller_major_vsn_drv/1, - smaller_minor_vsn_drv/1, - peek_non_existing_queue/1, - otp_6879/1, - caller/1, - many_events/1, - missing_callbacks/1, - smp_select/1, - driver_select_use/1, - thread_mseg_alloc_cache_clean/1, - otp_9302/1, - thr_free_drv/1, - async_blast/1, - thr_msg_blast/1, - consume_timeslice/1]). + end_per_suite/1, init_per_group/2,end_per_group/2, + init_per_testcase/2, + end_per_testcase/2, + + a_test/1, + outputv_echo/1, + timer_measure/1, + timer_cancel/1, + timer_change/1, + timer_delay/1, + queue_echo/1, + outputv_errors/1, + driver_unloaded/1, + io_ready_exit/1, + use_fallback_pollset/0, + use_fallback_pollset/1, + bad_fd_in_pollset/1, + fd_change/1, + steal_control/1, + otp_6602/1, + driver_system_info_base_ver/1, + driver_system_info_prev_ver/1, + driver_system_info_current_ver/1, + driver_monitor/1, + + ioq_exit_ready_input/1, + ioq_exit_ready_output/1, + ioq_exit_timeout/1, + ioq_exit_ready_async/1, + ioq_exit_ready_input_async/1, + ioq_exit_ready_output_async/1, + ioq_exit_timeout_async/1, + zero_extended_marker_garb_drv/1, + invalid_extended_marker_drv/1, + larger_major_vsn_drv/1, + larger_minor_vsn_drv/1, + smaller_major_vsn_drv/1, + smaller_minor_vsn_drv/1, + peek_non_existing_queue/1, + otp_6879/1, + caller/1, + many_events/1, + missing_callbacks/1, + smp_select/1, + driver_select_use/1, + thread_mseg_alloc_cache_clean/1, + otp_9302/1, + thr_free_drv/1, + async_blast/1, + thr_msg_blast/1, + consume_timeslice/1, + z_test/1]). -export([bin_prefix/2]). --include_lib("test_server/include/test_server.hrl"). +-export([get_check_io_total/1]). % for z_SUITE.erl + +-include_lib("common_test/include/ct.hrl"). % First byte in communication with the timer driver @@ -111,33 +114,45 @@ -define(MAX_DATA_SIZE, 16384). % This is the allowed delay when testing the driver timer functionality --define(delay, 100). +-define(delay, 400). -define(heap_binary_size, 64). init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(2)), - case catch erts_debug:get_internal_state(available_internal_state) of - true -> ok; - _ -> erts_debug:set_internal_state(available_internal_state, true) - end, + CIOD = rpc(Config, + fun() -> + case catch erts_debug:get_internal_state(available_internal_state) of + true -> ok; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end, + erts_debug:get_internal_state(check_io_debug) + end), erlang:display({init_per_testcase, Case}), - ?line 0 = erts_debug:get_internal_state(check_io_debug), - [{watchdog, Dog},{testcase, Case}|Config]. + 0 = element(1, CIOD), + [{testcase, Case}|Config]. end_per_testcase(Case, Config) -> - Dog = ?config(watchdog, Config), erlang:display({end_per_testcase, Case}), - ?line 0 = erts_debug:get_internal_state(check_io_debug), - ?t:timetrap_cancel(Dog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. + CIOD = rpc(Config, + fun() -> + get_stable_check_io_info(), + erts_debug:get_internal_state(check_io_debug) + end), + 0 = element(1, CIOD), + ok. -all() -> - [outputv_errors, outputv_echo, queue_echo, {group, timer}, - driver_unloaded, io_ready_exit, use_fallback_pollset, - bad_fd_in_pollset, driver_event, fd_change, - steal_control, otp_6602, driver_system_info_base_ver, +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. + +all() -> %% Keep a_test first and z_test last... + [a_test, outputv_errors, outputv_echo, queue_echo, + {group, timer}, + driver_unloaded, io_ready_exit, otp_6602, + {group, polling}, + {group, poll_thread}, + {group, poll_set}, + driver_system_info_base_ver, driver_system_info_prev_ver, driver_system_info_current_ver, driver_monitor, {group, ioq_exit}, zero_extended_marker_garb_drv, @@ -145,23 +160,30 @@ all() -> larger_minor_vsn_drv, smaller_major_vsn_drv, smaller_minor_vsn_drv, peek_non_existing_queue, otp_6879, caller, many_events, missing_callbacks, - smp_select, driver_select_use, thread_mseg_alloc_cache_clean, otp_9302, thr_free_drv, async_blast, thr_msg_blast, - consume_timeslice]. + consume_timeslice, + z_test]. groups() -> [{timer, [], [timer_measure, timer_cancel, timer_delay, timer_change]}, + {poll_thread, [], [{group, polling}]}, + {poll_set, [], [{group, polling}]}, + {polling, [], + [a_test, use_fallback_pollset, + bad_fd_in_pollset, fd_change, + steal_control, smp_select, + driver_select_use, z_test]}, {ioq_exit, [], [ioq_exit_ready_input, ioq_exit_ready_output, - ioq_exit_timeout, ioq_exit_ready_async, ioq_exit_event, + ioq_exit_timeout, ioq_exit_ready_async, ioq_exit_ready_input_async, ioq_exit_ready_output_async, - ioq_exit_timeout_async, ioq_exit_event_async]}]. + ioq_exit_timeout_async]}]. init_per_suite(Config) -> Config. @@ -169,48 +191,66 @@ init_per_suite(Config) -> end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false). +init_per_group(poll_thread, Config) -> + [{node_args, "+IOt 2"} | Config]; +init_per_group(poll_set, Config) -> + [{node_args, "+IOt 2 +IOp 2"} | Config]; +init_per_group(polling, Config) -> + case proplists:get_value(node_args, Config) of + undefined -> + Config; + Args -> + {ok, Node} = start_node(polling, Args), + [{node, Node} | Config] + end; init_per_group(_GroupName, Config) -> Config. end_per_group(_GroupName, Config) -> + case proplists:get_value(node, Config) of + undefined -> + ok; + Node -> + stop_node(Node) + end, Config. -outputv_errors(doc) -> "Test sending bad types to port with an outputv-capable driver."; +%% Test sending bad types to port with an outputv-capable driver. outputv_errors(Config) when is_list(Config) -> - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, outputv_drv), + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, outputv_drv), outputv_bad_types(fun(T) -> - ?line outputv_errors_1(T), - ?line outputv_errors_1([1|T]), - ?line L = [1,2,3], - ?line outputv_errors_1([L,T]), - ?line outputv_errors_1([L|T]) - end), + outputv_errors_1(T), + outputv_errors_1([1|T]), + L = [1,2,3], + outputv_errors_1([L,T]), + outputv_errors_1([L|T]) + end), outputv_errors_1(42), %% Test iolists that do not fit in the address space. %% Unfortunately, it would be too slow to test in a 64-bit emulator. case erlang:system_info(wordsize) of - 4 -> outputv_huge_iolists(); - _ -> ok + 4 -> outputv_huge_iolists(); + _ -> ok end. outputv_bad_types(Test) -> Types = [-1,256,atom,42.0,{a,b,c},make_ref(),fun() -> 42 end, - [1|2],<<1:1>>,<<1:9>>,<<1:15>>], + [1|2],<<1:1>>,<<1:9>>,<<1:15>>], _ = [Test(Type) || Type <- Types], ok. outputv_huge_iolists() -> FourGigs = 1 bsl 32, - ?line Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++ - [1 bsl N || N <- lists:seq(33, 37)], - ?line Base = <<0:(1 bsl 20)/unit:8>>, + Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++ + [1 bsl N || N <- lists:seq(33, 37)], + Base = <<0:(1 bsl 20)/unit:8>>, [begin - ?line L = build_iolist(Sz, Base), - ?line outputv_errors_1(L) + L = build_iolist(Sz, Base), + outputv_errors_1(L) end || Sz <- Sizes], ok. @@ -220,95 +260,94 @@ outputv_errors_1(Term) -> port_close(Port). build_iolist(N, Base) when N < 16 -> - case random:uniform(3) of - 1 -> - <<Bin:N/binary,_/binary>> = Base, - Bin; - _ -> - lists:seq(1, N) + case rand:uniform(3) of + 1 -> + <<Bin:N/binary,_/binary>> = Base, + Bin; + _ -> + lists:seq(1, N) end; build_iolist(N, Base) when N =< byte_size(Base) -> - case random:uniform(3) of - 1 -> - <<Bin:N/binary,_/binary>> = Base, - Bin; - 2 -> - <<Bin:N/binary,_/binary>> = Base, - [Bin]; - 3 -> - case N rem 2 of - 0 -> - L = build_iolist(N div 2, Base), - [L,L]; - 1 -> - L = build_iolist(N div 2, Base), - [L,L,45] - end + case rand:uniform(3) of + 1 -> + <<Bin:N/binary,_/binary>> = Base, + Bin; + 2 -> + <<Bin:N/binary,_/binary>> = Base, + [Bin]; + 3 -> + case N rem 2 of + 0 -> + L = build_iolist(N div 2, Base), + [L,L]; + 1 -> + L = build_iolist(N div 2, Base), + [L,L,45] + end end; build_iolist(N0, Base) -> - Small = random:uniform(15), + Small = rand:uniform(15), Seq = lists:seq(1, Small), N = N0 - Small, case N rem 2 of - 0 -> - L = build_iolist(N div 2, Base), - [L,L|Seq]; - 1 -> - L = build_iolist(N div 2, Base), - [47,L,L|Seq] + 0 -> + L = build_iolist(N div 2, Base), + [L,L|Seq]; + 1 -> + L = build_iolist(N div 2, Base), + [47,L,L|Seq] end. -outputv_echo(doc) -> ["Test echoing data with a driver that supports outputv."]; +%% Test echoing data with a driver that supports outputv. outputv_echo(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(10)), + ct:timetrap({minutes, 10}), Name = 'outputv_drv', P = start_driver(Config, Name, true), - ?line ov_test(P, {bin,0}), - ?line ov_test(P, {bin,1}), - ?line ov_test(P, {bin,2}), - ?line ov_test(P, {bin,3}), - ?line ov_test(P, {bin,4}), - ?line ov_test(P, {bin,5}), - ?line ov_test(P, {bin,6}), - ?line ov_test(P, {bin,7}), - ?line ov_test(P, {bin,8}), - ?line ov_test(P, {bin,15}), - ?line ov_test(P, {bin,16}), - ?line ov_test(P, {bin,17}), - - ?line ov_test(P, {list,0}), - ?line ov_test(P, {list,1}), - ?line ov_test(P, {list,2}), - ?line ov_test(P, [int,int,{list,0},int]), - ?line ov_test(P, [int,int,{list,1},int]), - ?line ov_test(P, [int,int,{list,2}]), - ?line ov_test(P, [{list,3},int,int,{list,2}]), - ?line ov_test(P, {list,33}), - - ?line ov_test(P, [{bin,0}]), - ?line ov_test(P, [{bin,1}]), - ?line ov_test(P, [{bin,2}]), - ?line ov_test(P, [{bin,3}]), - ?line ov_test(P, [{bin,4}]), - ?line ov_test(P, [{bin,5}]), - ?line ov_test(P, [{bin,6},int]), - ?line ov_test(P, [int,{bin,3}]), - ?line ov_test(P, [int|{bin,4}]), - ?line ov_test(P, [{bin,17},int,{bin,13}|{bin,3}]), - - ?line ov_test(P, [int,{bin,17},int,{bin,?heap_binary_size+1}|{bin,3}]), + ov_test(P, {bin,0}), + ov_test(P, {bin,1}), + ov_test(P, {bin,2}), + ov_test(P, {bin,3}), + ov_test(P, {bin,4}), + ov_test(P, {bin,5}), + ov_test(P, {bin,6}), + ov_test(P, {bin,7}), + ov_test(P, {bin,8}), + ov_test(P, {bin,15}), + ov_test(P, {bin,16}), + ov_test(P, {bin,17}), + + ov_test(P, {list,0}), + ov_test(P, {list,1}), + ov_test(P, {list,2}), + ov_test(P, [int,int,{list,0},int]), + ov_test(P, [int,int,{list,1},int]), + ov_test(P, [int,int,{list,2}]), + ov_test(P, [{list,3},int,int,{list,2}]), + ov_test(P, {list,33}), + + ov_test(P, [{bin,0}]), + ov_test(P, [{bin,1}]), + ov_test(P, [{bin,2}]), + ov_test(P, [{bin,3}]), + ov_test(P, [{bin,4}]), + ov_test(P, [{bin,5}]), + ov_test(P, [{bin,6},int]), + ov_test(P, [int,{bin,3}]), + ov_test(P, [int|{bin,4}]), + ov_test(P, [{bin,17},int,{bin,13}|{bin,3}]), + + ov_test(P, [int,{bin,17},int,{bin,?heap_binary_size+1}|{bin,3}]), stop_driver(P, Name), - ?line test_server:timetrap_cancel(Dog), ok. ov_test(Port, Template) -> Self = self(), spawn_opt(erlang, apply, [fun () -> ov_test(Self, Port, Template) end,[]], - [link,{fullsweep_after,0}]), + [link,{fullsweep_after,0}]), receive - done -> ok + done -> ok end. ov_test(Parent, Port, Template) -> @@ -350,21 +389,20 @@ ov_send_and_test(Port, Data, ExpectedResult) -> io:format("~p ! ~P", [Port,Data,12]), Port ! {self(),{command,Data}}, receive - {Port,{data,ReturnData}} -> - io:format("~p returned ~P", [Port,ReturnData,12]), - compare(ReturnData, ExpectedResult); - {Port,{data,OtherData}} -> - io:format("~p returned WRONG data ~p", [Port,OtherData]), - ?line test_server:fail(); - Wrong -> - ?line test_server:fail({unexpected_port_or_data,Wrong}) + {Port,{data,ReturnData}} -> + io:format("~p returned ~P", [Port,ReturnData,12]), + compare(ReturnData, ExpectedResult); + {Port,{data,OtherData}} -> + ct:fail("~p returned WRONG data ~p", [Port,OtherData]); + Wrong -> + ct:fail({unexpected_port_or_data,Wrong}) end. compare(Got, Expected) -> case {list_to_binary([Got]),list_to_binary([Expected])} of - {B,B} -> ok; - {_Gb,_Eb} -> - ?t:fail(got_bad_data) + {B,B} -> ok; + {_Gb,_Eb} -> + ct:fail(got_bad_data) end. @@ -373,146 +411,134 @@ compare(Got, Expected) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -timer_measure(doc) -> ["Check that timers time out in good time."]; +%% Check that timers time out in good time. timer_measure(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(1)), Name = 'timer_drv', - ?line Port = start_driver(Config, Name, false), + Port = start_driver(Config, Name, false), - ?line try_timeouts(Port, 8997), + try_timeouts(Port, 8997), - ?line stop_driver(Port, Name), - ?line test_server:timetrap_cancel(Dog), + stop_driver(Port, Name), ok. try_timeouts(_, 0) -> ok; try_timeouts(Port, Timeout) -> - ?line TimeBefore = now(), - ?line erlang:port_command(Port, <<?START_TIMER,Timeout:32>>), + TimeBefore = erlang:monotonic_time(), + erlang:port_command(Port, <<?START_TIMER,Timeout:32>>), receive - {Port,{data,[?TIMER]}} -> - ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), - io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed,Timeout]), - if - Elapsed < Timeout -> - ?line ?t:fail(too_short); - Elapsed > Timeout + ?delay -> - ?line ?t:fail(too_long); - true -> - try_timeouts(Port, Timeout div 2) - end - after Timeout + ?delay -> - ?line test_server:fail("driver failed to timeout") + {Port,{data,[?TIMER]}} -> + Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), + io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed, Timeout]), + if + Elapsed < Timeout -> + ct:fail(too_short); + Elapsed > Timeout + ?delay -> + ct:fail(too_long); + true -> + try_timeouts(Port, Timeout div 2) + end + after Timeout + 100*?delay -> + ct:fail("driver failed to timeout") end. -timer_cancel(doc) -> ["Try cancelling timers set in a driver."]; +%% Try cancelling timers set in a driver. timer_cancel(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(1)), Name = 'timer_drv', - ?line Port = start_driver(Config, Name, false), + Port = start_driver(Config, Name, false), - ?line try_cancel(Port, 10000), + try_cancel(Port, 10000), - ?line stop_driver(Port, Name), - ?line test_server:timetrap_cancel(Dog), + stop_driver(Port, Name), ok. - + try_cancel(Port, Timeout) -> - ?line T_before = erl_millisecs(), + T_before = erl_millisecs(), Port ! {self(),{command,<<?START_TIMER,(Timeout + ?delay):32>>}}, receive - {Port, {data, [?TIMER]}} -> - ?line test_server:fail("driver timed out before cancelling it") + {Port, {data, [?TIMER]}} -> + ct:fail("driver timed out before cancelling it") after Timeout -> - Port ! {self(), {command, [?CANCEL_TIMER]}}, - receive - {Port, {data, [?TIMER]}} -> - ?line test_server:fail("driver timed out after cancelling it"); - {Port, {data, [?CANCELLED]}} -> - ?line Time_milli_secs = erl_millisecs() - T_before, - - io:format("Time_milli_secs: ~p Timeout: ~p\n", - [Time_milli_secs, Timeout]), - if - Time_milli_secs > (Timeout + ?delay) -> - ?line test_server:fail("too long real time"); - Timeout == 0 -> ok; - true -> try_cancel(Port, Timeout div 2) - end - after ?delay -> - test_server:fail("No message from driver") - end + Port ! {self(), {command, [?CANCEL_TIMER]}}, + receive + {Port, {data, [?TIMER]}} -> + ct:fail("driver timed out after cancelling it"); + {Port, {data, [?CANCELLED]}} -> + Time_milli_secs = erl_millisecs() - T_before, + + io:format("Time_milli_secs: ~p Timeout: ~p\n", + [Time_milli_secs, Timeout]), + if + Time_milli_secs > (Timeout + ?delay) -> + ct:fail("too long real time"); + Timeout == 0 -> ok; + true -> try_cancel(Port, Timeout div 2) + end + after 100*?delay -> + ct:fail("No message from driver") + end end. %% Test that timers don't time out too early if we do a sleep %% before setting a timer. timer_delay(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(1)), Name = 'timer_drv', - ?line Port = start_driver(Config, Name, false), + Port = start_driver(Config, Name, false), - ?line TimeBefore = now(), + TimeBefore = erlang:monotonic_time(), Timeout0 = 350, - ?line erlang:port_command(Port, <<?DELAY_START_TIMER,Timeout0:32>>), - Timeout = Timeout0 + - case os:type() of - {win32,_} -> 0; %Driver doesn't sleep on Windows. - _ -> 1000 - end, + erlang:port_command(Port, <<?DELAY_START_TIMER,Timeout0:32>>), + Timeout = Timeout0 + 1000, receive - {Port,{data,[?TIMER]}} -> - ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), - io:format("Elapsed time: ~p Timeout: ~p\n", - [Elapsed,Timeout]), - if - Elapsed < Timeout -> - ?line ?t:fail(too_short); - Elapsed > Timeout + ?delay -> - ?line ?t:fail(too_long); - true -> - ok - end + {Port,{data,[?TIMER]}} -> + Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), + io:format("Elapsed time: ~p Timeout: ~p\n", + [Elapsed,Timeout]), + if + Elapsed < Timeout -> + ct:fail(too_short); + Elapsed > Timeout + ?delay -> + ct:fail(too_long); + true -> + ok + end end, - ?line stop_driver(Port, Name), - ?line test_server:timetrap_cancel(Dog), + stop_driver(Port, Name), ok. %% Test that driver_set_timer with new timout really changes %% the timer (ticket OTP-5942), it didn't work before timer_change(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(1)), Name = 'timer_drv', - ?line Port = start_driver(Config, Name, false), + Port = start_driver(Config, Name, false), - ?line try_change_timer(Port, 10000), + try_change_timer(Port, 10000), - ?line stop_driver(Port, Name), - ?line test_server:timetrap_cancel(Dog), + stop_driver(Port, Name), ok. - + try_change_timer(_Port, 0) -> ok; try_change_timer(Port, Timeout) -> - ?line Timeout_3 = Timeout*3, - ?line TimeBefore = now(), - ?line erlang:port_command(Port, <<?START_TIMER,Timeout_3:32>>), - ?line erlang:port_command(Port, <<?START_TIMER,Timeout:32>>), + Timeout_3 = Timeout*3, + TimeBefore = erlang:monotonic_time(), + erlang:port_command(Port, <<?START_TIMER,Timeout_3:32>>), + erlang:port_command(Port, <<?START_TIMER,Timeout:32>>), receive - {Port,{data,[?TIMER]}} -> - ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), - io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed,Timeout]), - if - Elapsed < Timeout -> - ?line ?t:fail(too_short); - Elapsed > Timeout + ?delay -> - ?line ?t:fail(too_long); - true -> - try_timeouts(Port, Timeout div 2) - end - after Timeout + ?delay -> - ?line test_server:fail("driver failed to timeout") + {Port,{data,[?TIMER]}} -> + Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), + io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed,Timeout]), + if + Elapsed < Timeout -> + ct:fail(too_short); + Elapsed > Timeout + ?delay -> + ct:fail(too_long); + true -> + try_timeouts(Port, Timeout div 2) + end + after Timeout + 100*?delay -> + ct:fail("driver failed to timeout") end. @@ -520,49 +546,47 @@ try_change_timer(Port, Timeout) -> %% Queue test suites %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -queue_echo(doc) -> - ["1) Queue up data in a driver that uses the full driver_queue API to do this." - "2) Get the data back, a random amount at a time."]; +%% 1) Queue up data in a driver that uses the full driver_queue API to do this. +%% 2) Get the data back, a random amount at a time. queue_echo(Config) when is_list(Config) -> - case ?t:is_native(?MODULE) of - true -> exit(crashes_native_code); - false -> queue_echo_1(Config) + case test_server:is_native(?MODULE) of + true -> exit(crashes_native_code); + false -> queue_echo_1(Config) end. queue_echo_1(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(10)), + ct:timetrap({minutes, 10}), Name = 'queue_drv', - ?line P = start_driver(Config, Name, true), - - ?line q_echo(P, [{?ENQ, {list,1}}, - {?ENQ, {list,0}}, - {?ENQ, {bin,0}}, - {?ENQ, {bin,1}}, - {?ENQ, {bin,2}}, - {?ENQ, {bin,3}}, - {?ENQ, {bin,4}}, - {?ENQ, {bin,5}}, - {?ENQ, {bin,600}}, - {?PUSHQ, {list,0}}, - {?PUSHQ, {list,1}}, - {?PUSHQ, {bin,0}}, - {?PUSHQ, {bin,1}}, - {?PUSHQ, {bin,888}}, - {?ENQ_BIN, {bin,0}}, - {?ENQ_BIN, {bin,1}}, - {?ENQ_BIN, {bin,2}}, - {?ENQ_BIN, {bin,3}}, - {?ENQ_BIN, {bin,4}}, - {?ENQ_BIN, {bin,777}}, - {?PUSHQ_BIN, {bin,0}}, - {?PUSHQ_BIN, {bin,1}}, - {?PUSHQ_BIN, {bin,334}}, - {?ENQV, [{bin,0},{list,1},{bin,1},{bin,555}]}, - {?ENQV, [{bin,0},{list,1},{bin,1}]}, - {?PUSHQV, [{bin,0},{list,1},{bin,1},{bin,319}]}]), - - ?line stop_driver(P, Name), - ?line test_server:timetrap_cancel(Dog), + P = start_driver(Config, Name, true), + + q_echo(P, [{?ENQ, {list,1}}, + {?ENQ, {list,0}}, + {?ENQ, {bin,0}}, + {?ENQ, {bin,1}}, + {?ENQ, {bin,2}}, + {?ENQ, {bin,3}}, + {?ENQ, {bin,4}}, + {?ENQ, {bin,5}}, + {?ENQ, {bin,600}}, + {?PUSHQ, {list,0}}, + {?PUSHQ, {list,1}}, + {?PUSHQ, {bin,0}}, + {?PUSHQ, {bin,1}}, + {?PUSHQ, {bin,888}}, + {?ENQ_BIN, {bin,0}}, + {?ENQ_BIN, {bin,1}}, + {?ENQ_BIN, {bin,2}}, + {?ENQ_BIN, {bin,3}}, + {?ENQ_BIN, {bin,4}}, + {?ENQ_BIN, {bin,777}}, + {?PUSHQ_BIN, {bin,0}}, + {?PUSHQ_BIN, {bin,1}}, + {?PUSHQ_BIN, {bin,334}}, + {?ENQV, [{bin,0},{list,1},{bin,1},{bin,555}]}, + {?ENQV, [{bin,0},{list,1},{bin,1}]}, + {?PUSHQV, [{bin,0},{list,1},{bin,1},{bin,319}]}]), + + stop_driver(P, Name), ok. q_echo(Port, SpecList) -> @@ -602,7 +626,7 @@ q_echo(Port, SpecList) -> feed_and_dequeue(Port, HeapData, 2), feed_and_dequeue(Port, HeapData, 3), feed_and_dequeue(Port, HeapData, 4), - + io:format("\n"). feed_and_dequeue(Port, Data, DeqSize) -> @@ -622,9 +646,9 @@ feed_driver(Port, [], ExpectedInPort, Qb) -> {ExpectedInPort,Qb}; feed_driver(Port, [{Method0,Data}|T], Expected_return, Qb_before) -> Method = case Method0 of - ?RANDOM -> uniform(6)-1; - Other -> Other - end, + ?RANDOM -> uniform(6)-1; + Other -> Other + end, Size = size(list_to_binary([Data])), %% *********************************************************************** @@ -639,22 +663,21 @@ feed_driver(Port, [{Method0,Data}|T], Expected_return, Qb_before) -> Qb_in_driver = bytes_queued(Port), case Qb_before + Size of - Qb_in_driver -> ok; - Sum -> - io:format("Qb_before: ~p\n" - "Qb_before+Size: ~p\n" - "Qb_in_driver: ~p", - [Qb_before,Sum,Qb_in_driver]), - ?t:fail() + Qb_in_driver -> ok; + Sum -> + ct:fail("Qb_before: ~p\n" + "Qb_before+Size: ~p\n" + "Qb_in_driver: ~p", + [Qb_before,Sum,Qb_in_driver]) end, X_return = case Method of - ?ENQ -> list_to_binary([Expected_return,Data]); - ?PUSHQ -> list_to_binary([Data,Expected_return]); - ?PUSHQ_BIN -> list_to_binary([Data,Expected_return]); - ?ENQ_BIN -> list_to_binary([Expected_return,Data]); - ?PUSHQV -> list_to_binary([Data,Expected_return]); - ?ENQV -> list_to_binary([Expected_return,Data]) - end, + ?ENQ -> list_to_binary([Expected_return,Data]); + ?PUSHQ -> list_to_binary([Data,Expected_return]); + ?PUSHQ_BIN -> list_to_binary([Data,Expected_return]); + ?ENQ_BIN -> list_to_binary([Expected_return,Data]); + ?PUSHQV -> list_to_binary([Data,Expected_return]); + ?ENQV -> list_to_binary([Expected_return,Data]) + end, feed_driver(Port, T, X_return, Qb_before + Size). %% method_name(0) -> pushq; @@ -672,26 +695,22 @@ compare_return(Port, _Data_list, 0, _Back_len) -> 0 = bytes_queued(Port); compare_return(Port, QueuedInPort0, Len_to_get, DeqSize) -> case bytes_queued(Port) of - Len_to_get -> ok; - BytesInQueue -> - io:format("Len_to_get: ~p", [Len_to_get]), - io:format("Bytes in queue: ~p", [BytesInQueue]), - ?line test_server:fail() + Len_to_get -> ok; + BytesInQueue -> + ct:fail("Len_to_get: ~p\nBytes in queue: ~p", [Len_to_get,BytesInQueue]) end, BytesToDequeue = if (DeqSize > Len_to_get) -> Len_to_get; - true -> DeqSize - end, + true -> DeqSize + end, Dequeued = read_head(Port, BytesToDequeue), case bin_prefix(Dequeued, QueuedInPort0) of - true -> - deq(Port, BytesToDequeue), - <<_:BytesToDequeue/binary,QueuedInPort/binary>> = QueuedInPort0, - compare_return(Port, QueuedInPort, Len_to_get - BytesToDequeue, DeqSize); - false -> - io:format("Bytes to dequeue: ~p", [BytesToDequeue]), - io:format("Dequeued: ~p", [Dequeued]), - io:format("Queued in port: ~P", [QueuedInPort0,12]), - ?t:fail() + true -> + deq(Port, BytesToDequeue), + <<_:BytesToDequeue/binary,QueuedInPort/binary>> = QueuedInPort0, + compare_return(Port, QueuedInPort, Len_to_get - BytesToDequeue, DeqSize); + false -> + ct:fail("Bytes to dequeue: ~p\nDequeued: ~p\nQueued in port: ~P", + [BytesToDequeue, Dequeued, QueuedInPort0,12]) end. %% bin_prefix(PrefixBinary, Binary) @@ -709,8 +728,8 @@ queue_op(Port, Method, Data) -> bytes_queued(Port) -> case erlang:port_control(Port, ?BYTES_QUEUED, []) of - <<I:32>> -> I; - Bad -> ?t:fail({bad_result,Bad}) + <<I:32>> -> I; + Bad -> ct:fail({bad_result,Bad}) end. deq(Port, Size) -> @@ -720,228 +739,217 @@ read_head(Port, Size) -> erlang:port_control(Port, ?READ_HEAD, <<Size:32>>). -driver_unloaded(doc) -> - []; -driver_unloaded(suite) -> - []; driver_unloaded(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line Drv = timer_drv, - ?line User = self(), - ?line Loaded = make_ref(), - ?line Die = make_ref(), - ?line Loader = spawn(fun () -> - erl_ddll:start(), - ok = load_driver(?config(data_dir, - Config), - Drv), - User ! Loaded, - receive Die -> exit(bye) end - end), - ?line receive Loaded -> ok end, - ?line Port = open_port({spawn, Drv}, []), - ?line Loader ! Die, - ?line receive - {'EXIT', Port, Reason} -> - ?line driver_unloaded = Reason - %% Reason used to be -1 - end. - - -io_ready_exit(doc) -> []; -io_ready_exit(suite) -> []; + process_flag(trap_exit, true), + Drv = timer_drv, + User = self(), + Loaded = make_ref(), + Die = make_ref(), + Loader = spawn(fun () -> + erl_ddll:start(), + ok = load_driver(proplists:get_value(data_dir, + Config), + Drv), + User ! Loaded, + receive Die -> exit(bye) end + end), + receive Loaded -> ok end, + Port = open_port({spawn, Drv}, []), + Loader ! Die, + receive + {'EXIT', Port, Reason} -> + driver_unloaded = Reason + %% Reason used to be -1 + end. + + io_ready_exit(Config) when is_list(Config) -> - ?line OTE = process_flag(trap_exit, true), - ?line Test = self(), - ?line Dgawd = spawn(fun () -> - ok = dgawd_handler:install(), - Mon = erlang:monitor(process, Test), - Test ! dgawd_handler_started, - receive - {'DOWN', Mon, _, _, _} -> ok; - stop_dgawd_handler -> ok - end, - dgawd_handler:restore(), - Test ! dgawd_handler_stopped - end), - ?line receive dgawd_handler_started -> ok end, - ?line Drv = io_ready_exit_drv, - ?line erl_ddll:start(), - ?line ok = load_driver(?config(data_dir, Config), Drv), - ?line Port = open_port({spawn, Drv}, []), - ?line case erlang:port_control(Port, 0, "") of - "ok" -> - receive - {'EXIT', Port, Reason} -> - ?line case Reason of - ready_output_driver_failure -> - ?t:format("Exited in output_ready()~n"), - ?line ok; - ready_input_driver_failure -> - ?t:format("Exited in input_ready()~n"), - ?line ok; - Error -> ?line ?t:fail(Error) - end - end, - receive after 2000 -> ok end, - ?line false = dgawd_handler:got_dgawd_report(), - ?line Dgawd ! stop_dgawd_handler, - ?line receive dgawd_handler_stopped -> ok end, - ?line process_flag(trap_exit, OTE), - ?line ok; - "nyiftos" -> - ?line process_flag(trap_exit, OTE), - ?line {skipped, "Not yet implemented for this OS"}; - Error -> - ?line process_flag(trap_exit, OTE), - ?line ?t:fail({unexpected_control_result, Error}) - end. - + OTE = process_flag(trap_exit, true), + Test = self(), + Dgawd = spawn(fun () -> + ok = dgawd_handler:install(), + Mon = erlang:monitor(process, Test), + Test ! dgawd_handler_started, + receive + {'DOWN', Mon, _, _, _} -> ok; + stop_dgawd_handler -> ok + end, + dgawd_handler:restore(), + Test ! dgawd_handler_stopped + end), + receive dgawd_handler_started -> ok end, + Drv = io_ready_exit_drv, + erl_ddll:start(), + ok = load_driver(proplists:get_value(data_dir, Config), Drv), + Port = open_port({spawn, Drv}, []), + case erlang:port_control(Port, 0, "") of + "ok" -> + receive + {'EXIT', Port, Reason} -> + case Reason of + ready_output_driver_failure -> + io:format("Exited in output_ready()~n"), + ok; + ready_input_driver_failure -> + io:format("Exited in input_ready()~n"), + ok; + Error -> ct:fail(Error) + end + end, + receive after 2000 -> ok end, + false = dgawd_handler:got_dgawd_report(), + Dgawd ! stop_dgawd_handler, + receive dgawd_handler_stopped -> ok end, + process_flag(trap_exit, OTE), + ok; + "nyiftos" -> + process_flag(trap_exit, OTE), + {skipped, "Not yet implemented for this OS"}; + Error -> + process_flag(trap_exit, OTE), + ct:fail({unexpected_control_result, Error}) + end. + -define(CHKIO_STOP, 0). -define(CHKIO_USE_FALLBACK_POLLSET, 1). -define(CHKIO_BAD_FD_IN_POLLSET, 2). --define(CHKIO_DRIVER_EVENT, 3). -define(CHKIO_FD_CHANGE, 4). -define(CHKIO_STEAL, 5). -define(CHKIO_STEAL_AUX, 6). -define(CHKIO_SMP_SELECT, 7). -define(CHKIO_DRV_USE, 8). -use_fallback_pollset(doc) -> []; -use_fallback_pollset(suite) -> []; +use_fallback_pollset() -> + [{timetrap, {minutes, 2}}]. + use_fallback_pollset(Config) when is_list(Config) -> + rpc(Config, fun() -> use_fallback_pollset_t(Config) end). + +use_fallback_pollset_t(Config) when is_list(Config) -> FlbkFun = fun () -> - ChkIoDuring = erlang:system_info(check_io), - case lists:keysearch(fallback_poll_set_size, - 1, - ChkIoDuring) of - {value, - {fallback_poll_set_size, N}} when N > 0 -> - ?line ok; - Error -> - ?line ?t:fail({failed_to_use_fallback, Error}) - end - end, - ?line {BckupTest, Handel, OkRes} - = case chkio_test_init(Config) of - {erts_poll_info, ChkIo} = Hndl -> - case lists:keysearch(fallback, 1, ChkIo) of - {value, {fallback, B}} when B =/= false -> - ?line {FlbkFun, Hndl, ok}; - _ -> - ?line {fun () -> ok end, - Hndl, - {comment, - "This implementation does not use " - "a fallback pollset"}} - end; - Skip -> - {fun () -> ok end, Skip, ok} - end, - ?line case chkio_test_fini(chkio_test(Handel, - ?CHKIO_USE_FALLBACK_POLLSET, - fun () -> - ?line sleep(1000), - ?line BckupTest() - end)) of - {skipped, _} = Res -> ?line Res; - _ -> ?line OkRes - end. - -bad_fd_in_pollset(doc) -> []; -bad_fd_in_pollset(suite) -> []; + {Flbk, _} = get_fallback(erlang:system_info(check_io)), + case lists:keysearch(total_poll_set_size, 1, Flbk) of + {value, {total_poll_set_size, N}} when N > 0 -> + ok; + Error -> + ct:fail({failed_to_use_fallback, Error}) + end + end, + {BckupTest, Handel, OkRes} + = case chkio_test_init(Config) of + {erts_poll_info, ChkIo} = Hndl -> + case lists:keysearch(fallback, 1, ChkIo) of + {value, {fallback, B}} when B =/= false -> + {FlbkFun, Hndl, ok}; + _ -> + {fun () -> ok end, + Hndl, + {comment, + "This implementation does not use " + "a fallback pollset"}} + end; + Skip -> + {fun () -> ok end, Skip, ok} + end, + io:format("Node = ~p~n",[node()]), + case chkio_test_fini(chkio_test(Handel, + ?CHKIO_USE_FALLBACK_POLLSET, + fun () -> + sleep(1000), + BckupTest() + end)) of + {skipped, _} = Res -> Res; + _ -> OkRes + end. + bad_fd_in_pollset(Config) when is_list(Config) -> - ?line chkio_test_fini(chkio_test(chkio_test_init(Config), - ?CHKIO_BAD_FD_IN_POLLSET, - fun () -> ?line sleep(1000) end)). - -driver_event(doc) -> []; -driver_event(suite) -> []; -driver_event(Config) when is_list(Config) -> - ?line chkio_test_fini(chkio_test(chkio_test_init(Config), - ?CHKIO_DRIVER_EVENT, - fun () -> ?line sleep(1000) end)). - -fd_change(doc) -> []; -fd_change(suite) -> []; + rpc(Config, + fun() -> + chkio_test_fini(chkio_test(chkio_test_init(Config), + ?CHKIO_BAD_FD_IN_POLLSET, + fun () -> sleep(1000) end)) + end). + fd_change(Config) when is_list(Config) -> - ?line chkio_test_fini(chkio_test(chkio_test_init(Config), - ?CHKIO_FD_CHANGE, - fun () -> ?line sleep(1000) end)). + rpc(Config, + fun() -> + chkio_test_fini(chkio_test(chkio_test_init(Config), + ?CHKIO_FD_CHANGE, + fun () -> sleep(1000) end)) + end). -steal_control(doc) -> []; -steal_control(suite) -> []; steal_control(Config) when is_list(Config) -> - ?line chkio_test_fini(case chkio_test_init(Config) of - {erts_poll_info, _} = Hndl -> - ?line steal_control_test(Hndl); - Skip -> - ?line Skip - end). + rpc(Config, + fun() -> + chkio_test_fini(case chkio_test_init(Config) of + {erts_poll_info, _} = Hndl -> + steal_control_test(Hndl); + Skip -> + Skip + end) + end). steal_control_test(Hndl = {erts_poll_info, Before}) -> - ?line Port = open_chkio_port(), - ?line case erlang:port_control(Port, ?CHKIO_STEAL_AUX, "") of - [$f,$d,$s,$:| _] = FdList -> - ?line chk_chkio_port(Port), - sleep(500), - ?line chk_chkio_port(Port), - ?line Res = chkio_test(Hndl, - ?CHKIO_STEAL, - FdList, - fun () -> - ?line chk_chkio_port(Port), - ?line sleep(500), - ?line chk_chkio_port(Port) - end), - ?line case erlang:port_control(Port, ?CHKIO_STOP, "") of - "ok" -> - ?line chk_chkio_port(Port), - ?line ok; - StopErr -> - ?line chk_chkio_port(Port), - ?line ?t:fail({stop_error, StopErr}) - end, - ?line close_chkio_port(Port), - ?line Res; - [$s,$k,$i,$p,$:,$\ |Skip] -> - ?line chk_chkio_port(Port), - ?line close_chkio_port(Port), - {chkio_test_result, - {skipped, Skip}, - Before}; - StartErr -> - ?line chk_chkio_port(Port), - ?line ?t:fail({start_error, StartErr}) - end. + Port = open_chkio_port(), + case erlang:port_control(Port, ?CHKIO_STEAL_AUX, "") of + [$f,$d,$s,$:| _] = FdList -> + chk_chkio_port(Port), + sleep(500), + chk_chkio_port(Port), + Res = chkio_test(Hndl, + ?CHKIO_STEAL, + FdList, + fun () -> + chk_chkio_port(Port), + sleep(500), + chk_chkio_port(Port) + end), + case erlang:port_control(Port, ?CHKIO_STOP, "") of + "ok" -> + chk_chkio_port(Port), + ok; + StopErr -> + chk_chkio_port(Port), + ct:fail({stop_error, StopErr}) + end, + close_chkio_port(Port), + Res; + [$s,$k,$i,$p,$:,$\ |Skip] -> + chk_chkio_port(Port), + close_chkio_port(Port), + {chkio_test_result, + {skipped, Skip}, + Before}; + StartErr -> + chk_chkio_port(Port), + ct:fail({start_error, StartErr}) + end. chkio_test_init(Config) when is_list(Config) -> - ?line wait_until_no_pending_updates(), - ?line ChkIo = erlang:system_info(check_io), - ?line case catch lists:keysearch(name, 1, ChkIo) of - {value, {name, erts_poll}} -> - ?line ?t:format("Before test: ~p~n", [ChkIo]), - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, 'chkio_drv'), - ?line process_flag(trap_exit, true), - ?line {erts_poll_info, ChkIo}; - _ -> - ?line {skipped, "Test written to test erts_poll() which isn't used"} - end. - + ChkIo = get_stable_check_io_info(), + case catch lists:keysearch(name, 1, ChkIo) of + {value, {name, erts_poll}} -> + ct:log("Before test: ~p~n", [ChkIo]), + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, 'chkio_drv'), + process_flag(trap_exit, true), + {erts_poll_info, ChkIo}; + _ -> + {skipped, "Test written to test erts_poll() which isn't used"} + end. + chkio_test_fini({skipped, _} = Res) -> Res; chkio_test_fini({chkio_test_result, Res, Before}) -> - ?line ok = erl_ddll:unload_driver('chkio_drv'), - ?line ok = erl_ddll:stop(), - ?line wait_until_no_pending_updates(), - ?line After = erlang:system_info(check_io), - ?line ?t:format("After test: ~p~n", [After]), - ?line verify_chkio_state(Before, After), - ?line Res. + ok = erl_ddll:unload_driver('chkio_drv'), + ok = erl_ddll:stop(), + After = get_stable_check_io_info(), + io:format("After test: ~p~n", [After]), + verify_chkio_state(Before, After), + Res. open_chkio_port() -> open_port({spawn, 'chkio_drv'}, []). @@ -949,248 +957,315 @@ open_chkio_port() -> close_chkio_port(Port) when is_port(Port) -> true = erlang:port_close(Port), receive - {'EXIT', Port, normal} -> - ok; - {'EXIT', Port, Reason} -> - ?t:fail({abnormal_port_exit, Port, Reason}); - {Port, Message} -> - ?t:fail({strange_message_from_port, Message}) + {'EXIT', Port, normal} -> + ok; + {'EXIT', Port, Reason} -> + ct:fail({abnormal_port_exit, Port, Reason}); + {Port, Message} -> + ct:fail({strange_message_from_port, Message}) end. chk_chkio_port(Port) -> receive - {'EXIT', Port, Reason} when Reason /= normal -> - ?t:fail({port_exited, Port, Reason}) + {'EXIT', Port, Reason} when Reason /= normal -> + ct:fail({port_exited, Port, Reason}) after 0 -> - ok + ok end. - + chkio_test({skipped, _} = Res, _Test, _Fun) -> - ?line Res; + Res; chkio_test({erts_poll_info, _Before} = EPI, Test, Fun) when is_integer(Test) -> chkio_test(EPI, Test, "", Fun). chkio_test({skipped, _} = Res, _Test, _TestArgs, _Fun) -> - ?line Res; + Res; chkio_test({erts_poll_info, Before}, - Test, - TestArgs, - Fun) when is_integer(Test), - is_list(TestArgs) -> - ?line Port = open_chkio_port(), - ?line case erlang:port_control(Port, Test, TestArgs) of - "ok" -> - ?line chk_chkio_port(Port), - ?line Fun(), - ?line During = erlang:system_info(check_io), - ?line erlang:display(During), - ?line 0 = erts_debug:get_internal_state(check_io_debug), - ?line ?t:format("During test: ~p~n", [During]), - ?line chk_chkio_port(Port), - ?line case erlang:port_control(Port, ?CHKIO_STOP, "") of - Res when is_list(Res) -> - ?line chk_chkio_port(Port), - ?line ?t:format("~s", [Res]), - ?line close_chkio_port(Port), - ?line Res, - ?line case Res of - [$c,$o,$m,$m,$e,$n,$t,$:,$\ |Cmnt] -> - ?line {chkio_test_result, - {comment, Cmnt}, - Before}; - _ -> - ?line {chkio_test_result, - Res, - Before} - end; - StopErr -> - ?line chk_chkio_port(Port), - ?line ?t:fail({stop_error, StopErr}) - end; - [$s,$k,$i,$p,$:,$\ |Skip] -> - ?line chk_chkio_port(Port), - ?line close_chkio_port(Port), - {chkio_test_result, - {skipped, Skip}, - Before}; - StartErr -> - ?line chk_chkio_port(Port), - ?line ?t:fail({start_error, StartErr}) - end. + Test, + TestArgs, + Fun) when is_integer(Test), + is_list(TestArgs) -> + Port = open_chkio_port(), + case erlang:port_control(Port, Test, TestArgs) of + "ok" -> + chk_chkio_port(Port), + Fun(), + During = get_check_io_total(erlang:system_info(check_io)), + erlang:display(During), + + 0 = element(1, erts_debug:get_internal_state(check_io_debug)), + io:format("During test: ~p~n", [During]), + chk_chkio_port(Port), + case erlang:port_control(Port, ?CHKIO_STOP, "") of + Res when is_list(Res) -> + chk_chkio_port(Port), + io:format("~s", [Res]), + close_chkio_port(Port), + Res, + case Res of + [$c,$o,$m,$m,$e,$n,$t,$:,$\ |Cmnt] -> + {chkio_test_result, + {comment, Cmnt}, + Before}; + _ -> + {chkio_test_result, + Res, + Before} + end; + StopErr -> + chk_chkio_port(Port), + ct:fail({stop_error, StopErr}) + end; + [$s,$k,$i,$p,$:,$\ |Skip] -> + chk_chkio_port(Port), + close_chkio_port(Port), + {chkio_test_result, + {skipped, Skip}, + Before}; + StartErr -> + chk_chkio_port(Port), + ct:fail({start_error, StartErr}) + end. verify_chkio_state(Before, After) -> - ?line TotSetSize = lists:keysearch(total_poll_set_size, 1, Before), - ?line TotSetSize = lists:keysearch(total_poll_set_size, 1, After), - ?line case lists:keysearch(fallback, 1, Before) of - {value,{fallback,false}} -> - ?line ok; - _ -> - ?line BckupSetSize = lists:keysearch(fallback_poll_set_size, - 1, - Before), - ?line BckupSetSize = lists:keysearch(fallback_poll_set_size, - 1, - After) - end, - ?line ok. - - - -wait_until_no_pending_updates() -> - case lists:keysearch(pending_updates, 1, erlang:system_info(check_io)) of - {value, {pending_updates, 0}} -> - ok; - false -> - ok; - _ -> - receive after 10 -> ok end, - wait_until_no_pending_updates() + TotSetSize = lists:keysearch(total_poll_set_size, 1, Before), + TotSetSize = lists:keysearch(total_poll_set_size, 1, After), + case lists:keysearch(fallback, 1, Before) of + {value,{fallback,false}} -> + ok; + _ -> + BckupSetSize = lists:keysearch(fallback_poll_set_size, + 1, + Before), + BckupSetSize = lists:keysearch(fallback_poll_set_size, + 1, + After) + end, + ok. + +get_stable_check_io_info() -> + get_stable_check_io_info(10). +get_stable_check_io_info(0) -> + get_check_io_total(erlang:system_info(check_io)); +get_stable_check_io_info(N) -> + ChkIo = get_check_io_total(erlang:system_info(check_io)), + PendUpdNo = proplists:get_value(pending_updates, ChkIo, 0), + ActFds = proplists:get_value(active_fds, ChkIo), + case {PendUpdNo, ActFds} of + {0, 0} -> + ChkIo; + _ -> + receive after 100 -> ok end, + get_stable_check_io_info(N-1) end. -otp_6602(doc) -> ["Missed port lock when stealing control of fd from a " - "driver that didn't use the same lock. The lock checker " - "used to trigger on this and dump core."]; -otp_6602(suite) -> - []; +%% Merge return from erlang:system_info(check_io) +%% as if it was one big pollset. +get_check_io_total(ChkIo) -> + ct:log("ChkIo = ~p~n",[ChkIo]), + {Fallback, Rest} = get_fallback(ChkIo), + add_fallback_infos(Fallback, + lists:foldl(fun(Pollset, Acc) -> + lists:zipwith(fun(A, B) -> + add_pollset_infos(A,B) + end, + Pollset, Acc) + end, + hd(Rest), tl(Rest))). + +add_pollset_infos({Tag, A}=TA , {Tag, B}=TB) -> + case tag_type(Tag) of + sum -> + {Tag, A + B}; + const -> + case A of + B -> TA; + _ -> + ct:fail("Unexpected diff in pollsets ~p != ~p", + [TA,TB]) + end + end. + +get_fallback([MaybeFallback | ChkIo] = AllChkIo) -> + case proplists:get_value(fallback, MaybeFallback) of + true -> + {MaybeFallback, ChkIo}; + false -> + {undefined, AllChkIo} + end. + +add_fallback_infos(undefined, Acc) -> + Acc; +add_fallback_infos(Flbk, Acc) -> + lists:zipwith(fun({Tag, A}=TA, {Tag, B}=TB) -> + case tag_type(Tag) of + sum -> {Tag, A + B}; + const when Tag =:= fallback -> TA; + const -> TB + end + end, + Flbk, Acc). + +tag_type(name) -> const; +tag_type(primary) -> const; +tag_type(fallback) -> const; +tag_type(kernel_poll) -> const; +tag_type(memory_size) -> sum; +tag_type(total_poll_set_size) -> sum; +tag_type(lazy_updates) -> const; +tag_type(pending_updates) -> sum; +tag_type(batch_updates) -> const; +tag_type(concurrent_updates) -> const; +tag_type(max_fds) -> const; +tag_type(active_fds) -> sum; +tag_type(poll_threads) -> sum. + + +%% Missed port lock when stealing control of fd from a +%% driver that didn't use the same lock. The lock checker +%% used to trigger on this and dump core. otp_6602(Config) when is_list(Config) -> - ?line {ok, Node} = start_node(Config), - ?line Done = make_ref(), - ?line Parent = self(), - ?line Tester = spawn_link(Node, - fun () -> - %% Inet driver use port locking... - {ok, S} = gen_udp:open(0), - {ok, Fd} = inet:getfd(S), - {ok, Port} = inet:port(S), - %% Steal fd (lock checker used to - %% trigger here). - {ok, _S2} = gen_udp:open(Port,[{fd,Fd}]), - Parent ! Done - end), - ?line receive Done -> ok end, - ?line unlink(Tester), - ?line stop_node(Node), - ?line ok. + {ok, Node} = start_node(Config), + Done = make_ref(), + Parent = self(), + Tester = spawn_link(Node, + fun () -> + %% Inet driver use port locking... + {ok, S} = gen_udp:open(0), + {ok, Fd} = inet:getfd(S), + %% Steal fd (lock checker used to + %% trigger here). + {ok, _S2} = gen_udp:open(0,[{fd,Fd}]), + Parent ! Done + end), + receive Done -> ok end, + unlink(Tester), + stop_node(Node), + ok. -define(EXPECTED_SYSTEM_INFO_NAMES1, - ["drv_drv_vsn", - "emu_drv_vsn", - "erts_vsn", - "otp_vsn", - "thread", - "smp"]). + ["drv_drv_vsn", + "emu_drv_vsn", + "erts_vsn", + "otp_vsn", + "thread", + "smp"]). -define(EXPECTED_SYSTEM_INFO_NAMES2, - (?EXPECTED_SYSTEM_INFO_NAMES1 ++ - ["async_thrs", - "sched_thrs"])). + (?EXPECTED_SYSTEM_INFO_NAMES1 ++ + ["async_thrs", + "sched_thrs"])). + +-define(EXPECTED_SYSTEM_INFO_NAMES3, + (?EXPECTED_SYSTEM_INFO_NAMES2 ++ + ["emu_nif_vsn"])). --define(EXPECTED_SYSTEM_INFO_NAMES, ?EXPECTED_SYSTEM_INFO_NAMES2). +-define(EXPECTED_SYSTEM_INFO_NAMES4, + (?EXPECTED_SYSTEM_INFO_NAMES3 ++ + ["dirty_sched"])). + +-define(EXPECTED_SYSTEM_INFO_NAMES, ?EXPECTED_SYSTEM_INFO_NAMES4). -'driver_system_info_base_ver'(doc) -> - []; -'driver_system_info_base_ver'(suite) -> - []; 'driver_system_info_base_ver'(Config) when is_list(Config) -> - ?line driver_system_info_test(Config, sys_info_base_drv). + driver_system_info_test(Config, sys_info_base_drv). -'driver_system_info_prev_ver'(doc) -> - []; -'driver_system_info_prev_ver'(suite) -> - []; 'driver_system_info_prev_ver'(Config) when is_list(Config) -> - ?line driver_system_info_test(Config, sys_info_prev_drv). + driver_system_info_test(Config, sys_info_prev_drv). -driver_system_info_current_ver(doc) -> - []; -driver_system_info_current_ver(suite) -> - []; driver_system_info_current_ver(Config) when is_list(Config) -> - ?line driver_system_info_test(Config, sys_info_curr_drv). + driver_system_info_test(Config, sys_info_curr_drv). driver_system_info_test(Config, Name) -> - ?line Port = start_driver(Config, Name, false), - ?line case erlang:port_control(Port, 0, []) of - [$o,$k,$:,_ | Result] -> - ?line check_driver_system_info_result(Result); - [$e,$r,$r,$o,$r,$:,_ | Error] -> - ?line ?t:fail(Error); - Unexpected -> - ?line ?t:fail({unexpected_result, Unexpected}) - end, - ?line stop_driver(Port, Name), - ?line ok. + Port = start_driver(Config, Name, false), + case erlang:port_control(Port, 0, []) of + [$o,$k,$:,_ | Result] -> + check_driver_system_info_result(Result); + [$e,$r,$r,$o,$r,$:,_ | Error] -> + ct:fail(Error); + Unexpected -> + ct:fail({unexpected_result, Unexpected}) + end, + stop_driver(Port, Name), + ok. check_driver_system_info_result(Result) -> - ?line ?t:format("All names: ~p~n", [?EXPECTED_SYSTEM_INFO_NAMES]), - ?line ?t:format("Result: ~p~n", [Result]), - ?line {[], Ns, DDVSN} = chk_sis(lists:map(fun (Str) -> - string:tokens(Str, "=") - end, - string:tokens(Result, " ")), - ?EXPECTED_SYSTEM_INFO_NAMES), - ?line case {DDVSN, - drv_vsn_str2tup(erlang:system_info(driver_version))} of - {DDVSN, DDVSN} -> - ?line [] = Ns; - {{1, 0}, _} -> - ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES - -- ?EXPECTED_SYSTEM_INFO_NAMES1), - ?line ExpNs = lists:sort(Ns); - {{1, 1}, _} -> - ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES - -- ?EXPECTED_SYSTEM_INFO_NAMES2), - ?line ExpNs = lists:sort(Ns); - {{2, 0}, _} -> - ?line [] = Ns - end. + io:format("All names: ~p~n", [?EXPECTED_SYSTEM_INFO_NAMES]), + io:format("Result: ~p~n", [Result]), + {[], Ns, DDVSN} = chk_sis(lists:map(fun (Str) -> + string:lexemes(Str, "=") + end, + string:lexemes(Result, " ")), + ?EXPECTED_SYSTEM_INFO_NAMES), + case {DDVSN, + drv_vsn_str2tup(erlang:system_info(driver_version))} of + {DDVSN, DDVSN} -> + [] = Ns; + %% {{1, 0}, _} -> + %% ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES + %% -- ?EXPECTED_SYSTEM_INFO_NAMES1), + %% ExpNs = lists:sort(Ns); + %% {{1, 1}, _} -> + %% ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES + %% -- ?EXPECTED_SYSTEM_INFO_NAMES2), + %% ExpNs = lists:sort(Ns); + {{3, 0}, _} -> + ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES + -- ?EXPECTED_SYSTEM_INFO_NAMES3), + ExpNs = lists:sort(Ns) + end. chk_sis(SIs, Ns) -> chk_sis(SIs, Ns, unknown). chk_sis(SIs, [], DDVSN) -> - ?line {SIs, [], DDVSN}; + {SIs, [], DDVSN}; chk_sis([], Ns, DDVSN) -> - ?line {[], Ns, DDVSN}; + {[], Ns, DDVSN}; chk_sis([[N, _] = SI| SIs], Ns, DDVSN) -> - ?line true = lists:member(N, Ns), - ?line case check_si_res(SI) of - {driver_version, NewDDVSN} -> - ?line chk_sis(SIs, lists:delete(N, Ns), NewDDVSN); - _ -> - ?line chk_sis(SIs, lists:delete(N, Ns), DDVSN) - end. + true = lists:member(N, Ns), + case check_si_res(SI) of + {driver_version, NewDDVSN} -> + chk_sis(SIs, lists:delete(N, Ns), NewDDVSN); + _ -> + chk_sis(SIs, lists:delete(N, Ns), DDVSN) + end. %% Data in first version of driver_system_info() (driver version 1.0) check_si_res(["drv_drv_vsn", Value]) -> - ?line DDVSN = drv_vsn_str2tup(Value), - ?line {Major, DMinor} = DDVSN, - ?line {Major, EMinor} = drv_vsn_str2tup(erlang:system_info(driver_version)), - ?line true = DMinor =< EMinor, - ?line {driver_version, DDVSN}; + DDVSN = drv_vsn_str2tup(Value), + {Major, DMinor} = DDVSN, + {Major, EMinor} = drv_vsn_str2tup(erlang:system_info(driver_version)), + true = DMinor =< EMinor, + {driver_version, DDVSN}; check_si_res(["emu_drv_vsn", Value]) -> - ?line Value = erlang:system_info(driver_version); + Value = erlang:system_info(driver_version); check_si_res(["erts_vsn", Value]) -> - ?line Value = erlang:system_info(version); + Value = erlang:system_info(version); check_si_res(["otp_vsn", Value]) -> - ?line Value = erlang:system_info(otp_release); + Value = erlang:system_info(otp_release); check_si_res(["thread", "true"]) -> - ?line true = erlang:system_info(threads); + true = erlang:system_info(threads); check_si_res(["thread", "false"]) -> - ?line false = erlang:system_info(threads); + false = erlang:system_info(threads); check_si_res(["smp", "true"]) -> - ?line true = erlang:system_info(smp_support); -check_si_res(["smp", "false"]) -> - ?line false = erlang:system_info(smp_support); + true = erlang:system_info(smp_support); %% Data added in second version of driver_system_info() (driver version 1.1) check_si_res(["async_thrs", Value]) -> - ?line Value = integer_to_list(erlang:system_info(thread_pool_size)); + Value = integer_to_list(erlang:system_info(thread_pool_size)); check_si_res(["sched_thrs", Value]) -> - ?line Value = integer_to_list(erlang:system_info(schedulers)); + Value = integer_to_list(erlang:system_info(schedulers)); + +%% Data added in 3rd version of driver_system_info() (driver version 1.5) +check_si_res(["emu_nif_vsn", Value]) -> + Value = erlang:system_info(nif_version); + +%% Data added in 4th version of driver_system_info() (driver version 3.1) +check_si_res(["dirty_sched", _Value]) -> + true; check_si_res(Unexpected) -> - ?line ?t:fail({unexpected_result, Unexpected}). + ct:fail({unexpected_result, Unexpected}). -define(MON_OP_I_AM_IPID,1). -define(MON_OP_MONITOR_ME,2). @@ -1198,904 +1273,819 @@ check_si_res(Unexpected) -> -define(MON_OP_MONITOR_ME_LATER,4). -define(MON_OP_DO_DELAYED_MONITOR,5). -driver_monitor(suite) -> - []; -driver_monitor(doc) -> - ["Test monitoring of processes from drivers"]; +%% Test monitoring of processes from drivers driver_monitor(Config) when is_list(Config) -> - ?line Name = monitor_drv, - ?line Port = start_driver(Config, Name, false), - ?line "ok" = port_control(Port,?MON_OP_I_AM_IPID,[]), - ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), - ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitors, []} = erlang:port_info(Port,monitors), - - ?line "ok:"++Id1 = port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), - ?line {monitored_by, []} = process_info(self(),monitored_by), - ?line "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id1), - ?line {monitored_by, [Port]} = process_info(self(),monitored_by), - ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitored_by, []} = process_info(self(),monitored_by), - - ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), - ?line Me = self(), - ?line {Pid1,Ref1} = - spawn_monitor(fun() -> - Me ! port_control(Port,?MON_OP_MONITOR_ME,[]), - Me ! process_info(self(),monitored_by), - Me ! erlang:port_info(Port,monitors) - end), - ?line ok = receive - "ok" -> - ok - after 1000 -> - timeout - end, - ?line ok = receive - {monitored_by, L} -> - L2 = lists:sort(L), - L3 = lists:sort([Me,Port]), - case L2 of - L3 -> - ok; - _ -> - mismatch - end - after 1000 -> - timeout - end, - ?line ok = receive - {monitors, LL} -> - LL2 = lists:sort(LL), - LL3 = lists:sort([{process,Me},{process,Pid1}]), - case LL2 of - LL3 -> - ok; - _ -> - mismatch - end - after 1000 -> - timeout - end, - ?line ok = receive - {'DOWN', Ref1, process, Pid1, _} -> - ok - after 1000 -> - timeout - end, - ?line ok = receive - {monitor_fired,Port,Pid1} -> - ok - after 1000 -> - timeout - end, - ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitors,[]} = erlang:port_info(Port,monitors), - ?line {monitored_by, []} = process_info(self(),monitored_by), - - ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), - ?line {Pid2,Ref2} = - spawn_monitor(fun() -> - receive go -> ok end, - Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), - Me ! process_info(self(),monitored_by), - Me ! erlang:port_info(Port,monitors) - end), - ?line Pid2 ! go, - ?line {ok,Id2} = receive - "ok:"++II -> - {ok,II} - after 1000 -> - timeout - end, - ?line ok = receive - {monitored_by, [Me]} -> - ok - after 1000 -> - timeout - end, - ?line ok = receive - {monitors, [{process,Me}]} -> - ok - after 1000 -> - timeout - end, - ?line ok = receive - {'DOWN', Ref2, process, Pid2, _} -> - ok - after 1000 -> - timeout - end, - ?line "noproc" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2), - ?line {monitors,[{process,Me}]} = erlang:port_info(Port,monitors), - ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitors,[]} = erlang:port_info(Port,monitors), - ?line {monitored_by, []} = process_info(self(),monitored_by), - - - ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), - ?line {Pid3,Ref3} = - spawn_monitor(fun() -> - receive go -> ok end, - Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), - Me ! process_info(self(),monitored_by), - Me ! erlang:port_info(Port,monitors) , - receive die -> ok end - end), - ?line Pid3 ! go, - ?line {ok,Id3} = receive - "ok:"++III -> - {ok,III} - after 1000 -> - timeout - end, - ?line ok = receive - {monitored_by, [Me]} -> - ok - after 1000 -> - timeout - end, - ?line ok = receive - {monitors, [{process,Me}]} -> - ok - after 1000 -> - timeout - end, - ?line "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id3), - ?line LLL1 = lists:sort([{process,Me},{process,Pid3}]), - ?line {monitors,LLL2} = erlang:port_info(Port,monitors), - ?line LLL1 = lists:sort(LLL2), - ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitors,[{process,Pid3}]} = erlang:port_info(Port,monitors), - ?line Pid3 ! die, - ?line ok = receive - {'DOWN', Ref3, process, Pid3, _} -> - ok - after 1000 -> - timeout - end, - ?line "not_found" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2), - ?line {monitors,[]} = erlang:port_info(Port,monitors), - ?line "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitors,[]} = erlang:port_info(Port,monitors), - ?line {monitored_by, []} = process_info(self(),monitored_by), - - ?line stop_driver(Port, Name), - ?line ok. + Name = monitor_drv, + Port = start_driver(Config, Name, false), + "ok" = port_control(Port,?MON_OP_I_AM_IPID,[]), + "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitors, []} = erlang:port_info(Port,monitors), + + "ok:"++Id1 = port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), + {monitored_by, []} = process_info(self(),monitored_by), + "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id1), + {monitored_by, [Port]} = process_info(self(),monitored_by), + "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitored_by, []} = process_info(self(),monitored_by), + + "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + Me = self(), + {Pid1,Ref1} = + spawn_monitor(fun() -> + Me ! port_control(Port,?MON_OP_MONITOR_ME,[]), + Me ! process_info(self(),monitored_by), + Me ! erlang:port_info(Port,monitors) + end), + ok = receive + "ok" -> + ok + after 1000 -> + timeout + end, + ok = receive + {monitored_by, L} -> + L2 = lists:sort(L), + L3 = lists:sort([Me,Port]), + case L2 of + L3 -> + ok; + _ -> + mismatch + end + after 1000 -> + timeout + end, + ok = receive + {monitors, LL} -> + LL2 = lists:sort(LL), + LL3 = lists:sort([{process,Me},{process,Pid1}]), + case LL2 of + LL3 -> + ok; + _ -> + mismatch + end + after 1000 -> + timeout + end, + ok = receive + {'DOWN', Ref1, process, Pid1, _} -> + ok + after 1000 -> + timeout + end, + ok = receive + {monitor_fired,Port,Pid1} -> + ok + after 1000 -> + timeout + end, + "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitors,[]} = erlang:port_info(Port,monitors), + {monitored_by, []} = process_info(self(),monitored_by), + + "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + {Pid2,Ref2} = + spawn_monitor(fun() -> + receive go -> ok end, + Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), + Me ! process_info(self(),monitored_by), + Me ! erlang:port_info(Port,monitors) + end), + Pid2 ! go, + {ok,Id2} = receive + "ok:"++II -> + {ok,II} + after 1000 -> + timeout + end, + ok = receive + {monitored_by, [Me]} -> + ok + after 1000 -> + timeout + end, + ok = receive + {monitors, [{process,Me}]} -> + ok + after 1000 -> + timeout + end, + ok = receive + {'DOWN', Ref2, process, Pid2, _} -> + ok + after 1000 -> + timeout + end, + "noproc" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2), + {monitors,[{process,Me}]} = erlang:port_info(Port,monitors), + "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitors,[]} = erlang:port_info(Port,monitors), + {monitored_by, []} = process_info(self(),monitored_by), + + + "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + {Pid3,Ref3} = + spawn_monitor(fun() -> + receive go -> ok end, + Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), + Me ! process_info(self(),monitored_by), + Me ! erlang:port_info(Port,monitors) , + receive die -> ok end + end), + Pid3 ! go, + {ok,Id3} = receive + "ok:"++III -> + {ok,III} + after 1000 -> + timeout + end, + ok = receive + {monitored_by, [Me]} -> + ok + after 1000 -> + timeout + end, + ok = receive + {monitors, [{process,Me}]} -> + ok + after 1000 -> + timeout + end, + "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id3), + LLL1 = lists:sort([{process,Me},{process,Pid3}]), + {monitors,LLL2} = erlang:port_info(Port,monitors), + LLL1 = lists:sort(LLL2), + "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitors,[{process,Pid3}]} = erlang:port_info(Port,monitors), + Pid3 ! die, + ok = receive + {'DOWN', Ref3, process, Pid3, _} -> + ok + after 1000 -> + timeout + end, + "not_found" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2), + {monitors,[]} = erlang:port_info(Port,monitors), + "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitors,[]} = erlang:port_info(Port,monitors), + {monitored_by, []} = process_info(self(),monitored_by), + + stop_driver(Port, Name), + ok. -define(IOQ_EXIT_READY_INPUT, 1). -define(IOQ_EXIT_READY_OUTPUT, 2). -define(IOQ_EXIT_TIMEOUT, 3). -define(IOQ_EXIT_READY_ASYNC, 4). --define(IOQ_EXIT_EVENT, 5). -define(IOQ_EXIT_READY_INPUT_ASYNC, 6). -define(IOQ_EXIT_READY_OUTPUT_ASYNC, 7). -define(IOQ_EXIT_TIMEOUT_ASYNC, 8). --define(IOQ_EXIT_EVENT_ASYNC, 9). ioq_exit_test(Config, TestNo) -> - ?line Drv = ioq_exit_drv, - ?line try - begin - ?line case load_driver(?config(data_dir, Config), - Drv) of - ok -> ?line ok; - {error, permanent} -> ?line ok; - LoadError -> ?line ?t:fail({load_error, LoadError}) - end, - case open_port({spawn, Drv}, []) of - Port when is_port(Port) -> - try port_control(Port, TestNo, "") of - "ok" -> - ?line ok; - "nyiftos" -> - ?line throw({skipped, - "Not yet implemented for " - "this OS"}); - [$s,$k,$i,$p,$:,$ | Comment] -> - ?line throw({skipped, Comment}); - [$e,$r,$r,$o,$r,$:,$ | Error] -> - ?line ?t:fail(Error) - after - Port ! {self(), close}, - receive {Port, closed} -> ok end, - false = lists:member(Port, erlang:ports()), - ok - end; - Error -> - ?line ?t:fail({open_port_failed, Error}) - end - end - catch - throw:Term -> ?line Term - after - erl_ddll:unload_driver(Drv) - end. - -ioq_exit_ready_input(doc) -> []; -ioq_exit_ready_input(suite) -> []; + Drv = ioq_exit_drv, + try + begin + case load_driver(proplists:get_value(data_dir, Config), + Drv) of + ok -> ok; + {error, permanent} -> ok; + LoadError -> ct:fail({load_error, LoadError}) + end, + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + try port_control(Port, TestNo, "") of + "ok" -> + ok; + "nyiftos" -> + throw({skipped, + "Not yet implemented for " + "this OS"}); + [$s,$k,$i,$p,$:,$ | Comment] -> + throw({skipped, Comment}); + [$e,$r,$r,$o,$r,$:,$ | Error] -> + ct:fail(Error) + after + Port ! {self(), close}, + receive {Port, closed} -> ok end, + false = lists:member(Port, erlang:ports()), + ok + end; + Error -> + ct:fail({open_port_failed, Error}) + end + end + catch + throw:Term -> Term + after + erl_ddll:unload_driver(Drv) + end. + ioq_exit_ready_input(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_INPUT). -ioq_exit_ready_output(doc) -> []; -ioq_exit_ready_output(suite) -> []; ioq_exit_ready_output(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_OUTPUT). -ioq_exit_timeout(doc) -> []; -ioq_exit_timeout(suite) -> []; ioq_exit_timeout(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_TIMEOUT). -ioq_exit_ready_async(doc) -> []; -ioq_exit_ready_async(suite) -> []; ioq_exit_ready_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_ASYNC). -ioq_exit_event(doc) -> []; -ioq_exit_event(suite) -> []; -ioq_exit_event(Config) when is_list(Config) -> - ioq_exit_test(Config, ?IOQ_EXIT_EVENT). - -ioq_exit_ready_input_async(doc) -> []; -ioq_exit_ready_input_async(suite) -> []; ioq_exit_ready_input_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_INPUT_ASYNC). -ioq_exit_ready_output_async(doc) -> []; -ioq_exit_ready_output_async(suite) -> []; ioq_exit_ready_output_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_OUTPUT_ASYNC). -ioq_exit_timeout_async(doc) -> []; -ioq_exit_timeout_async(suite) -> []; ioq_exit_timeout_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_TIMEOUT_ASYNC). -ioq_exit_event_async(doc) -> []; -ioq_exit_event_async(suite) -> []; -ioq_exit_event_async(Config) when is_list(Config) -> - ioq_exit_test(Config, ?IOQ_EXIT_EVENT_ASYNC). - vsn_mismatch_test(Config, LoadResult) -> - ?line Path = ?config(data_dir, Config), - ?line DrvName = ?config(testcase, Config), - ?line LoadResult = load_driver(Path, DrvName), - ?line case LoadResult of - ok -> - ?line Port = open_port({spawn, DrvName}, []), - ?line true = is_port(Port), - ?line true = port_close(Port), - ?line ok = erl_ddll:unload_driver(DrvName); - _ -> - ?line ok - end. - -zero_extended_marker_garb_drv(doc) -> []; -zero_extended_marker_garb_drv(suite) -> []; + Path = proplists:get_value(data_dir, Config), + DrvName = proplists:get_value(testcase, Config), + LoadResult = load_driver(Path, DrvName), + case LoadResult of + ok -> + Port = open_port({spawn, DrvName}, []), + true = is_port(Port), + true = port_close(Port), + ok = erl_ddll:unload_driver(DrvName); + _ -> + ok + end. + zero_extended_marker_garb_drv(Config) when is_list(Config) -> vsn_mismatch_test(Config, {error, driver_incorrect_version}). -invalid_extended_marker_drv(doc) -> []; -invalid_extended_marker_drv(suite) -> []; invalid_extended_marker_drv(Config) when is_list(Config) -> vsn_mismatch_test(Config, {error, driver_incorrect_version}). -larger_major_vsn_drv(doc) -> []; -larger_major_vsn_drv(suite) -> []; larger_major_vsn_drv(Config) when is_list(Config) -> vsn_mismatch_test(Config, {error, driver_incorrect_version}). -larger_minor_vsn_drv(doc) -> []; -larger_minor_vsn_drv(suite) -> []; larger_minor_vsn_drv(Config) when is_list(Config) -> vsn_mismatch_test(Config, {error, driver_incorrect_version}). -smaller_major_vsn_drv(doc) -> []; -smaller_major_vsn_drv(suite) -> []; smaller_major_vsn_drv(Config) when is_list(Config) -> vsn_mismatch_test(Config, {error, driver_incorrect_version}). -smaller_minor_vsn_drv(doc) -> []; -smaller_minor_vsn_drv(suite) -> []; smaller_minor_vsn_drv(Config) when is_list(Config) -> DrvVsnStr = erlang:system_info(driver_version), case drv_vsn_str2tup(DrvVsnStr) of - {_, 0} -> - {skipped, - "Cannot perform test when minor driver version is 0. " - "Current driver version is " ++ DrvVsnStr ++ "."}; - _ -> - vsn_mismatch_test(Config, ok) + {_, 0} -> + {skipped, + "Cannot perform test when minor driver version is 0. " + "Current driver version is " ++ DrvVsnStr ++ "."}; + _ -> + vsn_mismatch_test(Config, ok) end. -define(PEEK_NONXQ_TEST, 0). -define(PEEK_NONXQ_WAIT, 1). -peek_non_existing_queue(doc) -> []; -peek_non_existing_queue(suite) -> []; peek_non_existing_queue(Config) when is_list(Config) -> - ?line OTE = process_flag(trap_exit, true), - ?line Drv = peek_non_existing_queue_drv, - ?line try - begin - ?line case load_driver(?config(data_dir, Config), - Drv) of - ok -> ?line ok; - {error, permanent} -> ?line ok; - LoadError -> ?line ?t:fail({load_error, LoadError}) - end, - case open_port({spawn, Drv}, []) of - Port1 when is_port(Port1) -> - try port_control(Port1, ?PEEK_NONXQ_TEST, "") of - "ok" -> - ?line ok; - [$s,$k,$i,$p,$p,$e,$d,$:,$ | SkipReason] -> - ?line throw({skipped, SkipReason}); - [$e,$r,$r,$o,$r,$:,$ | Error1] -> - ?line ?t:fail(Error1) - after - exit(Port1, kill), - receive {'EXIT', Port1, _} -> ok end - end; - Error1 -> - ?line ?t:fail({open_port1_failed, Error1}) - end, - case open_port({spawn, Drv}, []) of - Port2 when is_port(Port2) -> - try port_control(Port2, ?PEEK_NONXQ_WAIT, "") of - "ok" -> - ?line ok; - [$e,$r,$r,$o,$r,$:,$ | Error2] -> - ?line ?t:fail(Error2) - after - receive {Port2, test_successful} -> ok end, - Port2 ! {self(), close}, - receive {Port2, closed} -> ok end - end; - Error2 -> - ?line ?t:fail({open_port2_failed, Error2}) - end - end - catch - throw:Term -> ?line Term - after - process_flag(trap_exit, OTE), - erl_ddll:unload_driver(Drv) - end. - -otp_6879(doc) -> - []; -otp_6879(suite) -> - []; + OTE = process_flag(trap_exit, true), + Drv = peek_non_existing_queue_drv, + try + begin + case load_driver(proplists:get_value(data_dir, Config), + Drv) of + ok -> ok; + {error, permanent} -> ok; + LoadError -> ct:fail({load_error, LoadError}) + end, + case open_port({spawn, Drv}, []) of + Port1 when is_port(Port1) -> + try port_control(Port1, ?PEEK_NONXQ_TEST, "") of + "ok" -> + ok; + [$s,$k,$i,$p,$p,$e,$d,$:,$ | SkipReason] -> + throw({skipped, SkipReason}); + [$e,$r,$r,$o,$r,$:,$ | Error1] -> + ct:fail(Error1) + after + exit(Port1, kill), + receive {'EXIT', Port1, _} -> ok end + end; + Error1 -> + ct:fail({open_port1_failed, Error1}) + end, + case open_port({spawn, Drv}, []) of + Port2 when is_port(Port2) -> + try port_control(Port2, ?PEEK_NONXQ_WAIT, "") of + "ok" -> + ok; + [$e,$r,$r,$o,$r,$:,$ | Error2] -> + ct:fail(Error2) + after + receive {Port2, test_successful} -> ok end, + Port2 ! {self(), close}, + receive {Port2, closed} -> ok end + end; + Error2 -> + ct:fail({open_port2_failed, Error2}) + end + end + catch + throw:Term -> Term + after + process_flag(trap_exit, OTE), + erl_ddll:unload_driver(Drv) + end. + otp_6879(Config) when is_list(Config) -> - ?line Drv = 'otp_6879_drv', - ?line Parent = self(), - ?line ok = load_driver(?config(data_dir, Config), Drv), - ?line Procs = lists:map( - fun (No) -> - spawn_link( - fun () -> - case open_port({spawn, Drv}, []) of - Port when is_port(Port) -> - Res = otp_6879_call(Port, No, 10000), - erlang:port_close(Port), - Parent ! {self(), Res}; - _ -> - Parent ! {self(), - open_port_failed} - end - end) - end, - lists:seq(1,10)), - ?line lists:foreach(fun (P) -> - ?line receive - {P, ok} -> - ?line ok; - {P, Error} -> - ?line ?t:fail({P, Error}) - end - end, - Procs), + Drv = 'otp_6879_drv', + Parent = self(), + ok = load_driver(proplists:get_value(data_dir, Config), Drv), + Procs = lists:map( + fun (No) -> + spawn_link( + fun () -> + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + Res = otp_6879_call(Port, No, 10000), + erlang:port_close(Port), + Parent ! {self(), Res}; + _ -> + Parent ! {self(), + open_port_failed} + end + end) + end, + lists:seq(1,10)), + lists:foreach(fun (P) -> + receive + {P, ok} -> + ok; + {P, Error} -> + ct:fail({P, Error}) + end + end, + Procs), %% Also try it when input exceeds default buffer (256 bytes) - ?line Data = lists:seq(1, 1000), - ?line case open_port({spawn, Drv}, []) of - Port when is_port(Port) -> - ?line ok = otp_6879_call(Port, Data, 10), - ?line erlang:port_close(Port); - _ -> - ?line ?t:fail(open_port_failed) - end, - ?line erl_ddll:unload_driver(Drv), - ?line ok. + Data = lists:seq(1, 1000), + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + ok = otp_6879_call(Port, Data, 10), + erlang:port_close(Port); + _ -> + ct:fail(open_port_failed) + end, + erl_ddll:unload_driver(Drv), + ok. otp_6879_call(_Port, _Data, 0) -> ok; otp_6879_call(Port, Data, N) -> case catch erlang:port_call(Port, 0, Data) of - Data -> otp_6879_call(Port, Data, N-1); - BadData -> {mismatch, Data, BadData} + Data -> otp_6879_call(Port, Data, N-1); + BadData -> {mismatch, Data, BadData} end. -caller(doc) -> - []; -caller(suite) -> - []; caller(Config) when is_list(Config) -> - ?line run_caller_test(Config, false), - ?line run_caller_test(Config, true). - + run_caller_test(Config, false), + run_caller_test(Config, true). + run_caller_test(Config, Outputv) -> - ?line Drv = 'caller_drv', - ?line Cmd = case Outputv of - true -> - ?line os:putenv("CALLER_DRV_USE_OUTPUTV", - "true"), - outputv; - false -> - ?line os:putenv("CALLER_DRV_USE_OUTPUTV", - "false"), - output - end, - ?line ok = load_driver(?config(data_dir, Config), Drv), - ?line Port = open_port({spawn, Drv}, []), - ?line true = is_port(Port), - ?line chk_caller(Port, start, self()), - ?line chk_caller(Port, - Cmd, - spawn_link( - fun () -> - port_command(Port, "") - end)), - ?line Port ! {self(), {command, ""}}, - ?line chk_caller(Port, Cmd, self()), - ?line chk_caller(Port, - control, - spawn_link( - fun () -> - port_control(Port, 0, "") - end)), - ?line chk_caller(Port, - call, - spawn_link( - fun () -> - erlang:port_call(Port, 0, "") - end)), - ?line true = port_close(Port), - ?line erl_ddll:unload_driver(Drv), - ?line ok. + Drv = 'caller_drv', + Cmd = case Outputv of + true -> + os:putenv("CALLER_DRV_USE_OUTPUTV", + "true"), + outputv; + false -> + os:putenv("CALLER_DRV_USE_OUTPUTV", + "false"), + output + end, + ok = load_driver(proplists:get_value(data_dir, Config), Drv), + Port = open_port({spawn, Drv}, []), + true = is_port(Port), + chk_caller(Port, start, self()), + chk_caller(Port, + Cmd, + spawn_link( + fun () -> + port_command(Port, "") + end)), + Port ! {self(), {command, ""}}, + chk_caller(Port, Cmd, self()), + chk_caller(Port, + control, + spawn_link( + fun () -> + port_control(Port, 0, "") + end)), + chk_caller(Port, + call, + spawn_link( + fun () -> + erlang:port_call(Port, 0, "") + end)), + true = port_close(Port), + erl_ddll:unload_driver(Drv), + ok. chk_caller(Port, Callback, ExpectedCaller) -> receive - {caller, Port, Callback, Caller} -> - ExpectedCaller = Caller + {caller, Port, Callback, Caller} -> + ExpectedCaller = Caller end. -many_events(suite) -> - []; -many_events(doc) -> - ["Check that many simultaneously signalled events work (win32)"]; +%% Check that many simultaneously signalled events work (win32) many_events(Config) when is_list(Config) -> - ?line Name = 'many_events_drv', - ?line Port = start_driver(Config, Name, false), + Name = 'many_events_drv', + Port = start_driver(Config, Name, false), Number = "1000", Port ! {self(), {command, Number}}, receive - {Port, {data,Number}} -> - ?line receive %% Just to make sure the emulator does not crash - %% after this case is run (if faulty) - after 2000 -> - ok - end + {Port, {data,Number}} -> + receive %% Just to make sure the emulator does not crash + %% after this case is run (if faulty) + after 2000 -> + ok + end after 1000 -> - ?line exit(the_driver_does_not_respond) + exit(the_driver_does_not_respond) end, - ?line stop_driver(Port, Name), - ?line ok. - - -missing_callbacks(doc) -> - []; -missing_callbacks(suite) -> - []; + stop_driver(Port, Name), + ok. + + missing_callbacks(Config) when is_list(Config) -> - ?line Name = 'missing_callback_drv', - ?line Port = start_driver(Config, Name, false), + Name = 'missing_callback_drv', + Port = start_driver(Config, Name, false), - ?line Port ! {self(), {command, "tjenix"}}, - ?line true = erlang:port_command(Port, "halloj"), - ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(Port, 4711, "mors")), - ?line {'EXIT', {badarg, _}} = (catch erlang:port_call(Port, 17, "hej")), + Port ! {self(), {command, "tjenix"}}, + true = erlang:port_command(Port, "halloj"), + {'EXIT', {badarg, _}} = (catch erlang:port_control(Port, 4711, "mors")), + {'EXIT', {badarg, _}} = (catch erlang:port_call(Port, 17, "hej")), - ?line %% Give the (non-existing) ready_output(), ready_input(), event(), - ?line %% and timeout() some time to be called. - ?line receive after 1000 -> ok end, + %% Give the (non-existing) ready_output(), ready_input(), event(), + %% and timeout() some time to be called. + receive after 1000 -> ok end, - ?line stop_driver(Port, Name), - ?line ok. + stop_driver(Port, Name), + ok. -smp_select(doc) -> - ["Test concurrent calls to driver_select."]; -smp_select(suite) -> - []; +%% Test concurrent calls to driver_select. smp_select(Config) when is_list(Config) -> case os:type() of - {win32,_} -> {skipped, "Test not implemented for this OS"}; - _ -> smp_select0(Config) + {win32,_} -> {skipped, "Test not implemented for this OS"}; + _ -> rpc(Config, fun() -> smp_select0(Config) end) end. - + smp_select0(Config) -> - ?line DrvName = 'chkio_drv', - Path = ?config(data_dir, Config), + DrvName = 'chkio_drv', + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), - ?line ok = load_driver(Path, DrvName), + ok = load_driver(Path, DrvName), Master = self(), ProcFun = fun()-> io:format("Worker ~p starting\n",[self()]), - ?line Port = open_port({spawn, DrvName}, []), - smp_select_loop(Port, 100000), - sleep(1000), % wait for driver to handle pending events - ?line true = erlang:port_close(Port), - Master ! {ok,self()}, - io:format("Worker ~p finished\n",[self()]) - end, - ?line Pids = lists:map(fun(_) -> spawn_link(ProcFun) end, - lists:seq(1,4)), + Port = open_port({spawn, DrvName}, []), + smp_select_loop(Port, 100000), + sleep(1000), % wait for driver to handle pending events + true = erlang:port_close(Port), + Master ! {ok,self()}, + io:format("Worker ~p finished\n",[self()]) + end, + Pids = lists:map(fun(_) -> spawn_link(ProcFun) end, + lists:seq(1,4)), TimeoutMsg = make_ref(), {ok,TRef} = timer:send_after(5*1000, TimeoutMsg), % Limit test duration on slow machines smp_select_wait(Pids, TimeoutMsg), timer:cancel(TRef), - ?line ok = erl_ddll:unload_driver(DrvName), - ?line ok = erl_ddll:stop(), + ok = erl_ddll:unload_driver(DrvName), + ok = erl_ddll:stop(), ok. smp_select_loop(_, 0) -> ok; smp_select_loop(Port, N) -> - ?line "ok" = erlang:port_control(Port, ?CHKIO_SMP_SELECT, []), + "ok" = erlang:port_control(Port, ?CHKIO_SMP_SELECT, []), receive - stop -> - io:format("Worker ~p stopped with ~p laps left\n",[self(), N]), - ok + stop -> + io:format("Worker ~p stopped with ~p laps left\n",[self(), N]), + ok after 0 -> - smp_select_loop(Port, N-1) + smp_select_loop(Port, N-1) end. smp_select_wait([], _) -> ok; smp_select_wait(Pids, TimeoutMsg) -> receive - {ok,Pid} when is_pid(Pid) -> - smp_select_wait(lists:delete(Pid,Pids), TimeoutMsg); - TimeoutMsg -> - lists:foreach(fun(Pid)-> Pid ! stop end, - Pids), - smp_select_wait(Pids, TimeoutMsg) + {ok,Pid} when is_pid(Pid) -> + smp_select_wait(lists:delete(Pid,Pids), TimeoutMsg); + TimeoutMsg -> + lists:foreach(fun(Pid)-> Pid ! stop end, + Pids), + smp_select_wait(Pids, TimeoutMsg) end. -driver_select_use(doc) -> - ["Test driver_select() with new ERL_DRV_USE flag."]; -driver_select_use(suite) -> - []; +%% Test driver_select() with new ERL_DRV_USE flag. driver_select_use(Config) when is_list(Config) -> case os:type() of - {win32,_} -> {skipped, "Test not implemented for this OS"}; - _ -> driver_select_use0(Config) + {win32,_} -> {skipped, "Test not implemented for this OS"}; + _ -> rpc(Config, fun() -> driver_select_use0(Config) end) end. - + driver_select_use0(Config) -> - ?line DrvName = 'chkio_drv', - Path = ?config(data_dir, Config), + DrvName = 'chkio_drv', + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), - ?line ok = load_driver(Path, DrvName), - ?line Port = open_port({spawn, DrvName}, []), - ?line "ok" = erlang:port_control(Port, ?CHKIO_DRV_USE, []), - ?line {Port,{data,"TheEnd"}} = receive Msg -> Msg - after 10000 -> timeout end, - ?line true = erlang:port_close(Port), - ?line ok = erl_ddll:unload_driver(DrvName), - ?line ok = erl_ddll:stop(), + ok = load_driver(Path, DrvName), + Port = open_port({spawn, DrvName}, []), + "ok" = erlang:port_control(Port, ?CHKIO_DRV_USE, []), + {Port,{data,"TheEnd"}} = receive Msg -> Msg + after 10000 -> timeout end, + true = erlang:port_close(Port), + ok = erl_ddll:unload_driver(DrvName), + ok = erl_ddll:stop(), ok. thread_mseg_alloc_cache_clean(Config) when is_list(Config) -> case {erlang:system_info(threads), - erlang:system_info({allocator,mseg_alloc}), - driver_alloc_sbct()} of - {_, false, _} -> - ?line {skipped, "No mseg_alloc"}; - {false, _, _} -> - ?line {skipped, "No threads"}; - {_, _, false} -> - ?line {skipped, "driver_alloc() not using the alloc_util framework"}; - {_, _, SBCT} when is_integer(SBCT), SBCT > 10*1024*1024 -> - ?line {skipped, "driver_alloc() using too large single block threshold"}; - {_, _, 0} -> - ?line {skipped, "driver_alloc() using too low single block threshold"}; - {true, _MsegAllocInfo, SBCT} -> - ?line DrvName = 'thr_alloc_drv', - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, DrvName), - ?line Port = open_port({spawn, DrvName}, []), - ?line CCI = 1000, - ?line ?t:format("CCI = ~p~n", [CCI]), - ?line CCC = mseg_alloc_ccc(), - ?line ?t:format("CCC = ~p~n", [CCC]), - ?line thread_mseg_alloc_cache_clean_test(Port, - 10, - CCI, - SBCT+100), - ?line true = erlang:port_close(Port), - ?line ok = erl_ddll:unload_driver(DrvName), - ?line ok = erl_ddll:stop(), - ?line ok + erlang:system_info({allocator,mseg_alloc}), + driver_alloc_sbct()} of + {_, false, _} -> + {skipped, "No mseg_alloc"}; + {false, _, _} -> + {skipped, "No threads"}; + {_, _, false} -> + {skipped, "driver_alloc() not using the alloc_util framework"}; + {_, _, SBCT} when is_integer(SBCT), SBCT > 10*1024*1024 -> + {skipped, "driver_alloc() using too large single block threshold"}; + {_, _, 0} -> + {skipped, "driver_alloc() using too low single block threshold"}; + {true, _MsegAllocInfo, SBCT} -> + DrvName = 'thr_alloc_drv', + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, DrvName), + Port = open_port({spawn, DrvName}, []), + CCI = 1000, + io:format("CCI = ~p~n", [CCI]), + CCC = mseg_alloc_ccc(), + io:format("CCC = ~p~n", [CCC]), + thread_mseg_alloc_cache_clean_test(Port, + 10, + CCI, + SBCT+100), + true = erlang:port_close(Port), + ok = erl_ddll:unload_driver(DrvName), + ok = erl_ddll:stop(), + ok end. -mseg_alloc_cci(MsegAllocInfo) -> - ?line {value,{options, OL}} - = lists:keysearch(options, 1, MsegAllocInfo), - ?line {value,{cci,CCI}} = lists:keysearch(cci,1,OL), - ?line CCI. - mseg_alloc_ccc() -> mseg_alloc_ccc(mseg_inst_info(0)). mseg_alloc_ccc(MsegAllocInfo) -> - ?line {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo), - ?line {value,{calls, CL}} = lists:keysearch(calls, 1, MKL), - ?line {value,{mseg_check_cache, GigaCCC, CCC}} - = lists:keysearch(mseg_check_cache, 1, CL), - ?line GigaCCC*1000000000 + CCC. + {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo), + {value,{calls, CL}} = lists:keysearch(calls, 1, MKL), + {value,{mseg_check_cache, GigaCCC, CCC}} + = lists:keysearch(mseg_check_cache, 1, CL), + GigaCCC*1000000000 + CCC. mseg_alloc_cached_segments() -> mseg_alloc_cached_segments(mseg_inst_info(0)). mseg_alloc_cached_segments(MsegAllocInfo) -> - MemName = case is_halfword_vm() of - true -> "high memory"; - false -> "all memory" - end, - ?line [{memkind,DrvMem}] - = lists:filter(fun(E) -> case E of - {memkind, [{name, MemName} | _]} -> true; - _ -> false - end end, MsegAllocInfo), - ?line {value,{status, SL}} - = lists:keysearch(status, 1, DrvMem), - ?line {value,{cached_segments, CS}} - = lists:keysearch(cached_segments, 1, SL), - ?line CS. + MemName = "all memory", + [{memkind,DrvMem}] + = lists:filter(fun(E) -> case E of + {memkind, [{name, MemName} | _]} -> true; + _ -> false + end end, MsegAllocInfo), + {value,{status, SL}} + = lists:keysearch(status, 1, DrvMem), + {value,{cached_segments, CS}} + = lists:keysearch(cached_segments, 1, SL), + CS. mseg_inst_info(I) -> {value, {instance, I, Value}} - = lists:keysearch(I, - 2, - erlang:system_info({allocator,mseg_alloc})), + = lists:keysearch(I, + 2, + erlang:system_info({allocator,mseg_alloc})), Value. -is_halfword_vm() -> - case {erlang:system_info({wordsize, internal}), - erlang:system_info({wordsize, external})} of - {4, 8} -> true; - {WS, WS} -> false - end. - driver_alloc_sbct() -> {_, _, _, As} = erlang:system_info(allocator), case lists:keysearch(driver_alloc, 1, As) of - {value,{driver_alloc,DAOPTs}} -> - case lists:keysearch(sbct, 1, DAOPTs) of - {value,{sbct,SBCT}} -> - SBCT; - _ -> - false - end; - _ -> - false + {value,{driver_alloc,DAOPTs}} -> + case lists:keysearch(sbct, 1, DAOPTs) of + {value,{sbct,SBCT}} -> + SBCT; + _ -> + false + end; + _ -> + false end. thread_mseg_alloc_cache_clean_test(_Port, 0, _CCI, _Size) -> - ?line ok; + ok; thread_mseg_alloc_cache_clean_test(Port, N, CCI, Size) -> - ?line wait_until(fun () -> 0 == mseg_alloc_cached_segments() end), - ?line receive after CCI+500 -> ok end, - ?line OCCC = mseg_alloc_ccc(), - ?line "ok" = erlang:port_control(Port, 0, integer_to_list(Size)), - ?line receive after CCI+500 -> ok end, - ?line CCC = mseg_alloc_ccc(), - ?line ?t:format("CCC = ~p~n", [CCC]), - ?line true = CCC > OCCC, - ?line thread_mseg_alloc_cache_clean_test(Port, N-1, CCI, Size). + wait_until(fun () -> 0 == mseg_alloc_cached_segments() end), + receive after CCI+500 -> ok end, + OCCC = mseg_alloc_ccc(), + "ok" = erlang:port_control(Port, 0, integer_to_list(Size)), + receive after CCI+500 -> ok end, + CCC = mseg_alloc_ccc(), + io:format("CCC = ~p~n", [CCC]), + true = CCC > OCCC, + thread_mseg_alloc_cache_clean_test(Port, N-1, CCI, Size). otp_9302(Config) when is_list(Config) -> - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, otp_9302_drv), - ?line Port = open_port({spawn, otp_9302_drv}, []), - ?line true = is_port(Port), - ?line port_command(Port, ""), - ?line {msg, block} = get_port_msg(Port, infinity), - ?line {msg, job} = get_port_msg(Port, infinity), - ?line C = case erlang:system_info(thread_pool_size) of - 0 -> - ?line {msg, cancel} = get_port_msg(Port, infinity), - ?line {msg, job} = get_port_msg(Port, infinity), - ?line false; - _ -> - case get_port_msg(Port, infinity) of - {msg, cancel} -> %% Cancel always fail in Rel >= 15 - ?line {msg, job} = get_port_msg(Port, infinity), - ?line false; - {msg, job} -> - ?line ok, - ?line true - end - end, - ?line {msg, end_of_jobs} = get_port_msg(Port, infinity), - ?line no_msg = get_port_msg(Port, 2000), - ?line port_close(Port), - ?line case C of - true -> - ?line {comment, "Async job cancelled"}; - false -> - ?line {comment, "Async job not cancelled"} - end. + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, otp_9302_drv), + Port = open_port({spawn, otp_9302_drv}, []), + true = is_port(Port), + port_command(Port, ""), + {msg, block} = get_port_msg(Port, infinity), + {msg, job} = get_port_msg(Port, infinity), + C = case erlang:system_info(thread_pool_size) of + 0 -> + {msg, cancel} = get_port_msg(Port, infinity), + {msg, job} = get_port_msg(Port, infinity), + false; + _ -> + case get_port_msg(Port, infinity) of + {msg, cancel} -> %% Cancel always fail in Rel >= 15 + {msg, job} = get_port_msg(Port, infinity), + false; + {msg, job} -> + ok, + true + end + end, + {msg, end_of_jobs} = get_port_msg(Port, infinity), + no_msg = get_port_msg(Port, 2000), + port_close(Port), + case C of + true -> + {comment, "Async job cancelled"}; + false -> + {comment, "Async job not cancelled"} + end. thr_free_drv(Config) when is_list(Config) -> case erlang:system_info(threads) of - false -> - {skipped, "No thread support"}; - true -> - thr_free_drv_do(Config) + false -> + {skipped, "No thread support"}; + true -> + thr_free_drv_do(Config) end. thr_free_drv_do(Config) -> - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, thr_free_drv), - ?line MemBefore = driver_alloc_size(), -% io:format("SID=~p", [erlang:system_info(scheduler_id)]), - ?line Port = open_port({spawn, thr_free_drv}, []), - ?line MemPeek = driver_alloc_size(), - ?line true = is_port(Port), - ?line ok = thr_free_drv_control(Port, 0), - ?line port_close(Port), - ?line MemAfter = driver_alloc_size(), - ?line io:format("MemPeek=~p~n", [MemPeek]), - ?line io:format("MemBefore=~p, MemAfter=~p~n", [MemBefore, MemAfter]), - ?line MemBefore = MemAfter, - ?line case MemPeek of - undefined -> ok; - _ -> - ?line true = MemPeek > MemBefore - end, - ?line ok. + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, thr_free_drv), + MemBefore = driver_alloc_size(), + % io:format("SID=~p", [erlang:system_info(scheduler_id)]), + Port = open_port({spawn, thr_free_drv}, []), + MemPeek = driver_alloc_size(), + true = is_port(Port), + ok = thr_free_drv_control(Port, 0), + port_close(Port), + MemAfter = driver_alloc_size(), + io:format("MemPeek=~p~n", [MemPeek]), + io:format("MemBefore=~p, MemAfter=~p~n", [MemBefore, MemAfter]), + MemBefore = MemAfter, + case MemPeek of + undefined -> ok; + _ -> + true = MemPeek > MemBefore + end, + ok. thr_free_drv_control(Port, N) -> case erlang:port_control(Port, 0, "") of - "done" -> - ok; - "more" -> - erlang:yield(), -% io:format("N=~p, SID=~p", [N, erlang:system_info(scheduler_id)]), - thr_free_drv_control(Port, N+1) + "done" -> + ok; + "more" -> + erlang:yield(), + % io:format("N=~p, SID=~p", [N, erlang:system_info(scheduler_id)]), + thr_free_drv_control(Port, N+1) end. - + async_blast(Config) when is_list(Config) -> - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, async_blast_drv), - ?line SchedOnln = erlang:system_info(schedulers_online), - ?line MemBefore = driver_alloc_size(), - ?line Start = os:timestamp(), - ?line Blast = fun () -> - Port = open_port({spawn, async_blast_drv}, []), - true = is_port(Port), - port_command(Port, ""), - receive - {Port, done} -> - ok - end, - port_close(Port) - end, - ?line Ps = lists:map(fun (N) -> - spawn_opt(Blast, - [{scheduler, - (N rem SchedOnln)+ 1}, - monitor]) - end, - lists:seq(1, 100)), - ?line MemMid = driver_alloc_size(), - ?line lists:foreach(fun ({Pid, Mon}) -> - receive - {'DOWN',Mon,process,Pid,_} -> ok - end - end, Ps), - ?line End = os:timestamp(), - ?line MemAfter = driver_alloc_size(), - ?line io:format("MemBefore=~p, MemMid=~p, MemAfter=~p~n", - [MemBefore, MemMid, MemAfter]), - ?line AsyncBlastTime = timer:now_diff(End,Start)/1000000, - ?line io:format("AsyncBlastTime=~p~n", [AsyncBlastTime]), - ?line MemBefore = MemAfter, - ?line erlang:display({async_blast_time, AsyncBlastTime}), - ?line ok. + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, async_blast_drv), + SchedOnln = erlang:system_info(schedulers_online), + MemBefore = driver_alloc_size(), + Start = os:timestamp(), + Blast = fun () -> + Port = open_port({spawn, async_blast_drv}, []), + true = is_port(Port), + port_command(Port, ""), + receive + {Port, done} -> + ok + end, + port_close(Port) + end, + Ps = lists:map(fun (N) -> + spawn_opt(Blast, + [{scheduler, + (N rem SchedOnln)+ 1}, + monitor]) + end, + lists:seq(1, 100)), + MemMid = driver_alloc_size(), + lists:foreach(fun ({Pid, Mon}) -> + receive + {'DOWN',Mon,process,Pid,_} -> ok + end + end, Ps), + End = os:timestamp(), + MemAfter = driver_alloc_size(), + io:format("MemBefore=~p, MemMid=~p, MemAfter=~p~n", + [MemBefore, MemMid, MemAfter]), + AsyncBlastTime = timer:now_diff(End,Start)/1000000, + io:format("AsyncBlastTime=~p~n", [AsyncBlastTime]), + MemBefore = MemAfter, + erlang:display({async_blast_time, AsyncBlastTime}), + ok. thr_msg_blast_receiver(_Port, N, N) -> ok; thr_msg_blast_receiver(Port, N, Max) -> receive - {Port, hi} -> - thr_msg_blast_receiver(Port, N+1, Max) + {Port, hi} -> + thr_msg_blast_receiver(Port, N+1, Max) end. thr_msg_blast_receiver_proc(Port, Max, Parent, Done) -> case port_control(Port, 0, "") of - "receiver" -> - spawn(fun () -> - thr_msg_blast_receiver_proc(Port, Max+1, Parent, Done) - end), - thr_msg_blast_receiver(Port, 0, Max); - "done" -> - Parent ! Done + "receiver" -> + spawn(fun () -> + thr_msg_blast_receiver_proc(Port, Max+1, Parent, Done) + end), + thr_msg_blast_receiver(Port, 0, Max); + "done" -> + Parent ! Done end. thr_msg_blast(Config) when is_list(Config) -> - case erlang:system_info(smp_support) of - false -> - {skipped, "Non-SMP emulator; nothing to test..."}; - true -> - Path = ?config(data_dir, Config), - erl_ddll:start(), - ok = load_driver(Path, thr_msg_blast_drv), - MemBefore = driver_alloc_size(), - Start = os:timestamp(), - Port = open_port({spawn, thr_msg_blast_drv}, []), - true = is_port(Port), - Done = make_ref(), - Me = self(), - spawn(fun () -> - thr_msg_blast_receiver_proc(Port, 1, Me, Done) - end), - receive - Done -> ok - end, - ok = thr_msg_blast_receiver(Port, 0, 32*10000), - port_close(Port), - End = os:timestamp(), - receive - Garbage -> - ?t:fail({received_garbage, Port, Garbage}) - after 2000 -> - ok - end, - MemAfter = driver_alloc_size(), - io:format("MemBefore=~p, MemAfter=~p~n", - [MemBefore, MemAfter]), - ThrMsgBlastTime = timer:now_diff(End,Start)/1000000, - io:format("ThrMsgBlastTime=~p~n", [ThrMsgBlastTime]), - MemBefore = MemAfter, - Res = {thr_msg_blast_time, ThrMsgBlastTime}, - erlang:display(Res), - Res - end. + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, thr_msg_blast_drv), + MemBefore = driver_alloc_size(), + Start = os:timestamp(), + Port = open_port({spawn, thr_msg_blast_drv}, []), + true = is_port(Port), + Done = make_ref(), + Me = self(), + spawn(fun () -> + thr_msg_blast_receiver_proc(Port, 1, Me, Done) + end), + receive + Done -> ok + end, + ok = thr_msg_blast_receiver(Port, 0, 32*10000), + port_close(Port), + End = os:timestamp(), + receive + Garbage -> + ct:fail({received_garbage, Port, Garbage}) + after 2000 -> + ok + end, + MemAfter = driver_alloc_size(), + io:format("MemBefore=~p, MemAfter=~p~n", + [MemBefore, MemAfter]), + ThrMsgBlastTime = timer:now_diff(End,Start)/1000000, + io:format("ThrMsgBlastTime=~p~n", [ThrMsgBlastTime]), + MemBefore = MemAfter, + Res = {thr_msg_blast_time, ThrMsgBlastTime}, + erlang:display(Res), + Res. -define(IN_RANGE(LoW_, VaLuE_, HiGh_), - case in_range(LoW_, VaLuE_, HiGh_) of - true -> ok; - false -> - case erlang:system_info(lock_checking) of - true -> - ?t:format("~p:~p: Ignore bad sched count due to " - "lock checking~n", - [?MODULE,?LINE]); - false -> - ?t:fail({unexpected_sched_counts, VaLuE_}) - end - end). + case in_range(LoW_, VaLuE_, HiGh_) of + true -> ok; + false -> + case erlang:system_info(lock_checking) of + true -> + io:format("~p:~p: Ignore bad sched count due to " + "lock checking~n", + [?MODULE,?LINE]); + false -> + ct:fail({unexpected_sched_counts, VaLuE_}) + end + end). consume_timeslice(Config) when is_list(Config) -> @@ -2127,7 +2117,7 @@ consume_timeslice(Config) when is_list(Config) -> %% the port instead. %% - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), ok = load_driver(Path, consume_timeslice_drv), Port = open_port({spawn, consume_timeslice_drv}, [{parallelism, false}]), @@ -2137,18 +2127,18 @@ consume_timeslice(Config) when is_list(Config) -> "enabled" = port_control(Port, $E, ""), Proc1 = spawn_link(fun () -> - receive Go -> ok end, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}} - end), + receive Go -> ok end, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}} + end), receive after 100 -> ok end, count_pp_sched_start(), Proc1 ! Go, @@ -2159,18 +2149,18 @@ consume_timeslice(Config) when is_list(Config) -> "disabled" = port_control(Port, $D, ""), Proc2 = spawn_link(fun () -> - receive Go -> ok end, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}} - end), + receive Go -> ok end, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}} + end), receive after 100 -> ok end, count_pp_sched_start(), Proc2 ! Go, @@ -2181,18 +2171,18 @@ consume_timeslice(Config) when is_list(Config) -> "enabled" = port_control(Port, $E, ""), Proc3 = spawn_link(fun () -> - receive Go -> ok end, - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, "") - end), + receive Go -> ok end, + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, "") + end), count_pp_sched_start(), Proc3 ! Go, wait_command_msgs(Port, 10), @@ -2202,18 +2192,18 @@ consume_timeslice(Config) when is_list(Config) -> "disabled" = port_control(Port, $D, ""), Proc4 = spawn_link(fun () -> - receive Go -> ok end, - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, "") - end), + receive Go -> ok end, + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, "") + end), count_pp_sched_start(), Proc4 ! Go, wait_command_msgs(Port, 10), @@ -2225,43 +2215,43 @@ consume_timeslice(Config) when is_list(Config) -> %% If only one scheduler use port with parallelism set to true, %% in order to trigger scheduling of command signals Port2 = case SOnl of - 1 -> - Port ! {self(), close}, - receive {Port, closed} -> ok end, - open_port({spawn, consume_timeslice_drv}, - [{parallelism, true}]); - _ -> - process_flag(scheduler, 1), - 1 = erlang:system_info(scheduler_id), - Port - end, + 1 -> + Port ! {self(), close}, + receive {Port, closed} -> ok end, + open_port({spawn, consume_timeslice_drv}, + [{parallelism, true}]); + _ -> + process_flag(scheduler, 1), + 1 = erlang:system_info(scheduler_id), + Port + end, count_pp_sched_start(), "enabled" = port_control(Port2, $E, ""), W5 = case SOnl of - 1 -> - false; - _ -> - W1= spawn_opt(fun () -> - 2 = erlang:system_info(scheduler_id), - "sleeped" = port_control(Port2, $S, "") - end, [link,{scheduler,2}]), - receive after 100 -> ok end, - W1 - end, + 1 -> + false; + _ -> + W1= spawn_opt(fun () -> + 2 = erlang:system_info(scheduler_id), + "sleeped" = port_control(Port2, $S, "") + end, [link,{scheduler,2}]), + receive after 100 -> ok end, + W1 + end, Proc5 = spawn_opt(fun () -> - receive Go -> ok end, - 1 = erlang:system_info(scheduler_id), - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}} - end, [link,{scheduler,1}]), + receive Go -> ok end, + 1 = erlang:system_info(scheduler_id), + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}} + end, [link,{scheduler,1}]), receive after 100 -> ok end, Proc5 ! Go, wait_procs_exit([W5, Proc5]), @@ -2269,34 +2259,34 @@ consume_timeslice(Config) when is_list(Config) -> [{Port2, Sprt5}, {Proc5, Sproc5}] = count_pp_sched_stop([Port2, Proc5]), ?IN_RANGE(2, Sproc5, 3), ?IN_RANGE(6, Sprt5, 20), - + count_pp_sched_start(), "disabled" = port_control(Port2, $D, ""), W6 = case SOnl of - 1 -> - false; - _ -> - W2= spawn_opt(fun () -> - 2 = erlang:system_info(scheduler_id), - "sleeped" = port_control(Port2, $S, "") - end, [link,{scheduler,2}]), - receive after 100 -> ok end, - W2 - end, + 1 -> + false; + _ -> + W2= spawn_opt(fun () -> + 2 = erlang:system_info(scheduler_id), + "sleeped" = port_control(Port2, $S, "") + end, [link,{scheduler,2}]), + receive after 100 -> ok end, + W2 + end, Proc6 = spawn_opt(fun () -> - receive Go -> ok end, - 1 = erlang:system_info(scheduler_id), - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}} - end, [link,{scheduler,1}]), + receive Go -> ok end, + 1 = erlang:system_info(scheduler_id), + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}} + end, [link,{scheduler,1}]), receive after 100 -> ok end, Proc6 ! Go, wait_procs_exit([W6, Proc6]), @@ -2316,19 +2306,19 @@ wait_command_msgs(_, 0) -> ok; wait_command_msgs(Port, N) -> receive - {Port, command} -> - wait_command_msgs(Port, N-1) + {Port, command} -> + wait_command_msgs(Port, N-1) end. in_range(Low, Val, High) when is_integer(Low), - is_integer(Val), - is_integer(High), - Low =< Val, - Val =< High -> + is_integer(Val), + is_integer(High), + Low =< Val, + Val =< High -> true; in_range(Low, Val, High) when is_integer(Low), - is_integer(Val), - is_integer(High) -> + is_integer(Val), + is_integer(High) -> false. count_pp_sched_start() -> @@ -2341,7 +2331,7 @@ count_pp_sched_stop(Ps) -> PNs = lists:map(fun (P) -> {P, 0} end, Ps), receive {trace_delivered, all, Td} -> ok end, Res = count_proc_sched(Ps, PNs), - ?t:format("Scheduling counts: ~p~n", [Res]), + io:format("Scheduling counts: ~p~n", [Res]), erlang:display({scheduling_counts, Res}), Res. @@ -2354,26 +2344,63 @@ do_inc_pn(P, [PN|PNs]) -> inc_pn(P, PNs) -> try - do_inc_pn(P, PNs) + do_inc_pn(P, PNs) catch - throw:undefined -> PNs + throw:undefined -> PNs end. count_proc_sched(Ps, PNs) -> receive - TT when element(1, TT) == trace, element(3, TT) == in -> -% erlang:display(TT), - count_proc_sched(Ps, inc_pn(element(2, TT), PNs)); - TT when element(1, TT) == trace, element(3, TT) == out -> - count_proc_sched(Ps, PNs) + TT when element(1, TT) == trace, element(3, TT) == in -> + % erlang:display(TT), + count_proc_sched(Ps, inc_pn(element(2, TT), PNs)); + TT when element(1, TT) == trace, element(3, TT) == out -> + count_proc_sched(Ps, PNs) after 0 -> - PNs + PNs end. - + +a_test(Config) when is_list(Config) -> + rpc(Config, fun check_io_debug/0). + +z_test(Config) when is_list(Config) -> + rpc(Config, fun check_io_debug/0). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Utilities %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +check_io_debug() -> + get_stable_check_io_info(), + {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoEnifSelStructs} + = CheckIoDebug = erts_debug:get_internal_state(check_io_debug), + HasGetHost = has_gethost(), + ct:log("check_io_debug: ~p~n" + "HasGetHost: ~p",[CheckIoDebug, HasGetHost]), + 0 = NoErrorFds, + if + NoUsedFds == NoDrvSelStructs -> + ok; + HasGetHost andalso (NoUsedFds == (NoDrvSelStructs - 1)) -> + %% If the inet_gethost port is alive, we may have + %% one extra used fd that is not selected on + ok + end, + 0 = NoEnifSelStructs, + ok. + +has_gethost() -> + has_gethost(erlang:ports()). +has_gethost([P|T]) -> + case erlang:port_info(P, name) of + {name,"inet_gethost"++_} -> + true; + _ -> + has_gethost(T) + end; +has_gethost([]) -> + false. + %flush_msgs() -> % receive % M -> @@ -2388,30 +2415,30 @@ wait_procs_exit([]) -> wait_procs_exit([P|Ps]) when is_pid(P) -> Mon = erlang:monitor(process, P), receive - {'DOWN', Mon, process, P, _} -> - wait_procs_exit(Ps) + {'DOWN', Mon, process, P, _} -> + wait_procs_exit(Ps) end; wait_procs_exit([_|Ps]) -> wait_procs_exit(Ps). get_port_msg(Port, Timeout) -> receive - {Port, What} -> - {msg, What} + {Port, What} -> + {msg, What} after Timeout -> - no_msg + no_msg end. wait_until(Fun) -> case Fun() of - true -> ok; - false -> - receive after 100 -> ok end, - wait_until(Fun) + true -> ok; + false -> + receive after 100 -> ok end, + wait_until(Fun) end. drv_vsn_str2tup(Str) -> - [Major, Minor] = string:tokens(Str, "."), + [Major, Minor] = string:lexemes(Str, "."), {list_to_integer(Major), list_to_integer(Minor)}. %% Build port data from a template. @@ -2438,11 +2465,11 @@ transform_bins(_Transform, Other) -> Other. make_sub_binaries(Term) -> MakeSub = fun(Bin0) -> - Bin1 = <<243:8,0:3,Bin0/binary,31:5,19:8>>, - Sz = size(Bin0), - <<243:8,0:3,Bin:Sz/binary,31:5,19:8>> = id(Bin1), - Bin - end, + Bin1 = <<243:8,0:3,Bin0/binary,31:5,19:8>>, + Sz = size(Bin0), + <<243:8,0:3,Bin:Sz/binary,31:5,19:8>> = id(Bin1), + Bin + end, transform_bins(MakeSub, Term). id(I) -> I. @@ -2474,26 +2501,17 @@ random_char() -> uniform(256) - 1. uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = time(), - random:seed(X, Y, Z); - _ -> - ok - end, - random:uniform(N). + rand:uniform(N). -%% return millisecs from statistics source erl_millisecs() -> - {Ms, S, Us} = erlang:now(), - Ms * 1000000000 + S * 1000 + Us / 1000. + erl_millisecs(erlang:monotonic_time()). -erl_millisecs({Ms,S,Us}) -> - Ms * 1000000000 + S * 1000 + Us / 1000. +erl_millisecs(MonotonicTime) -> + (1000*MonotonicTime)/erlang:convert_time_unit(1,second,native). %% Start/stop drivers. start_driver(Config, Name, Binary) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), %% Load the driver @@ -2501,31 +2519,31 @@ start_driver(Config, Name, Binary) -> %% open port. case Binary of - true -> - open_port({spawn, Name}, [binary]); - false -> - open_port({spawn, Name}, []) + true -> + open_port({spawn, Name}, [binary]); + false -> + open_port({spawn, Name}, []) end. stop_driver(Port, Name) -> - ?line true = erlang:port_close(Port), + true = erlang:port_close(Port), receive - {Port,Message} -> - ?t:fail({strange_message_from_port,Message}) + {Port,Message} -> + ct:fail({strange_message_from_port,Message}) after 0 -> - ok + ok end, %% Unload the driver. ok = erl_ddll:unload_driver(Name), - ?line ok = erl_ddll:stop(). + ok = erl_ddll:stop(). load_driver(Dir, Driver) -> case erl_ddll:load_driver(Dir, Driver) of - ok -> ok; - {error, Error} = Res -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - Res + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res end. sleep() -> @@ -2538,55 +2556,80 @@ sleep(Ms) when is_integer(Ms), Ms >= 0 -> start_node(Config) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), - ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). + start_node(proplists:get_value(testcase, Config)); +start_node(Name) -> + start_node(Name, ""). +start_node(NodeName, Args) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(NodeName) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, Args ++ " -pa "++Pa}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). wait_deallocations() -> try - erts_debug:set_internal_state(wait, deallocations) + erts_debug:set_internal_state(wait, deallocations) catch error:undef -> - erts_debug:set_internal_state(available_internal_state, true), - wait_deallocations() + erts_debug:set_internal_state(available_internal_state, true), + wait_deallocations() end. driver_alloc_size() -> - case erlang:system_info(smp_support) of - true -> - ok; - false -> - %% driver_alloc also used by elements in lock-free queues, - %% give these some time to be deallocated... - receive after 100 -> ok end - end, wait_deallocations(), case erlang:system_info({allocator_sizes, driver_alloc}) of - false -> - undefined; - MemInfo -> - CS = lists:foldl( - fun ({instance, _, L}, Acc) -> - {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), - {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), - [MBCS,SBCS | Acc] - end, - [], - MemInfo), - lists:foldl( - fun(L, Sz0) -> - {value,{_,Sz,_,_}} = lists:keysearch(blocks_size, 1, L), - Sz0+Sz - end, 0, CS) + false -> + undefined; + MemInfo -> + CS = lists:foldl( + fun ({instance, _, L}, Acc) -> + {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), + {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), + [MBCS,SBCS | Acc] + end, + [], + MemInfo), + lists:foldl( + fun(L, Sz0) -> + {value,{_,Sz,_,_}} = lists:keysearch(blocks_size, 1, L), + Sz0+Sz + end, 0, CS) + end. + +rpc(Config, Fun) -> + case proplists:get_value(node, Config) of + undefined -> + Fun(); + Node -> + Self = self(), + Ref = make_ref(), + Pid = spawn(Node, + fun() -> + Result + = try Fun() of + Res -> Res + catch E:R -> + {'EXIT',E,R,erlang:get_stacktrace()} + end, + Self ! {Ref, Result} + end), + MRef = monitor(process, Pid), + receive + {'DOWN', MRef, _Type, _Object, Info} -> + erlang:error({died, Pid, Info}); + {Ref, {'EXIT',E,R,ST}} -> + erlang:demonitor(MRef, [flush]), + erlang:raise(E,R,ST); + {Ref, Ret} -> + erlang:demonitor(MRef, [flush]), + Ret; + Other -> + ct:fail(Other) + end end. diff --git a/erts/emulator/test/driver_SUITE_data/async_blast_drv.c b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c index 72be107168..1432bc42c1 100644 --- a/erts/emulator/test/driver_SUITE_data/async_blast_drv.c +++ b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2013. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ diff --git a/erts/emulator/test/driver_SUITE_data/caller_drv.c b/erts/emulator/test/driver_SUITE_data/caller_drv.c index 2731f9b317..3bb20d86f5 100644 --- a/erts/emulator/test/driver_SUITE_data/caller_drv.c +++ b/erts/emulator/test/driver_SUITE_data/caller_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c index faf1040276..d548c4b1dc 100644 --- a/erts/emulator/test/driver_SUITE_data/chkio_drv.c +++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -41,7 +42,6 @@ #define CHKIO_STOP 0 #define CHKIO_USE_FALLBACK_POLLSET 1 #define CHKIO_BAD_FD_IN_POLLSET 2 -#define CHKIO_DRIVER_EVENT 3 #define CHKIO_FD_CHANGE 4 #define CHKIO_STEAL 5 #define CHKIO_STEAL_AUX 6 @@ -66,15 +66,6 @@ typedef struct { } ChkioFallbackData; typedef struct { - int in_fd; - struct erl_drv_event_data in_data; - int in_ok; - int out_fd; - struct erl_drv_event_data out_data; - int out_ok; -} ChkioDriverEvent; - -typedef struct { int fds[2]; int same_fd; } ChkioFdChange; @@ -85,14 +76,10 @@ typedef struct { typedef struct { int driver_select_fds[2]; - int driver_event_fds[2]; - struct erl_drv_event_data event_data[2]; } ChkioSteal; typedef struct { int driver_select_fds[2]; - int driver_event_fds[2]; - struct erl_drv_event_data event_data[2]; } ChkioStealAux; @@ -140,7 +127,6 @@ static ErlDrvData chkio_drv_start(ErlDrvPort, char *); static void chkio_drv_stop(ErlDrvData); static void chkio_drv_ready_input(ErlDrvData, ErlDrvEvent); static void chkio_drv_ready_output(ErlDrvData, ErlDrvEvent); -static void chkio_drv_ready_event(ErlDrvData, ErlDrvEvent, ErlDrvEventData); static ErlDrvSSizeT chkio_drv_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT, char **, ErlDrvSizeT); static void chkio_drv_timeout(ErlDrvData); @@ -163,7 +149,7 @@ static ErlDrvEntry chkio_drv_entry = { NULL, /* ready_async */ NULL, /* flush */ NULL, /* call */ - chkio_drv_ready_event, + NULL, /* unused_event_callback */ ERL_DRV_EXTENDED_MARKER, ERL_DRV_EXTENDED_MAJOR_VERSION, @@ -242,25 +228,6 @@ stop_use_fallback_pollset(ChkioDrvData *cddp) } static void -stop_driver_event(ChkioDrvData *cddp) -{ - if (cddp->test_data) { - ChkioDriverEvent *cdep = cddp->test_data; - cddp->test_data = NULL; - - if (cdep->in_fd >= 0) { - driver_event(cddp->port, (ErlDrvEvent) (ErlDrvSInt) cdep->in_fd, NULL); - close(cdep->in_fd); - } - if (cdep->out_fd >= 0) { - driver_event(cddp->port, (ErlDrvEvent) (ErlDrvSInt) cdep->out_fd, NULL); - close(cdep->out_fd); - } - driver_free(cdep); - } -} - -static void stop_fd_change(ChkioDrvData *cddp) { if (cddp->test_data) { @@ -304,14 +271,6 @@ stop_steal(ChkioDrvData *cddp) (ErlDrvEvent) (ErlDrvSInt) csp->driver_select_fds[1], DO_WRITE, 0); - if (csp->driver_event_fds[0] >= 0) - driver_event(cddp->port, - (ErlDrvEvent) (ErlDrvSInt) csp->driver_event_fds[0], - NULL); - if (csp->driver_event_fds[1] >= 0) - driver_event(cddp->port, - (ErlDrvEvent) (ErlDrvSInt) csp->driver_event_fds[1], - NULL); driver_free(csp); } } @@ -326,10 +285,6 @@ stop_steal_aux(ChkioDrvData *cddp) close(csap->driver_select_fds[0]); if (csap->driver_select_fds[1] >= 0) close(csap->driver_select_fds[1]); - if (csap->driver_event_fds[0] >= 0) - close(csap->driver_event_fds[0]); - if (csap->driver_event_fds[1] >= 0) - close(csap->driver_event_fds[1]); driver_free(csap); } } @@ -353,10 +308,13 @@ static void free_smp_select(ChkioSmpSelect* pip, ErlDrvPort port) abort(); } case Selected: - driver_select(port, (ErlDrvEvent)(ErlDrvSInt)pip->read_fd, DO_READ, 0); - /*fall through*/ case Opened: - close(pip->read_fd); + TRACEF(("%T: Close pipe [%d->%d]\n", driver_mk_port(port), pip->write_fd, + pip->read_fd)); + if (pip->wasSelected) + driver_select(port, (ErlDrvEvent)(ErlDrvSInt)pip->read_fd, DO_READ|ERL_DRV_USE, 0); + else + close(pip->read_fd); close(pip->write_fd); pip->state = Closed; break; @@ -444,9 +402,6 @@ chkio_drv_stop(ErlDrvData drv_data) { case CHKIO_BAD_FD_IN_POLLSET: stop_bad_fd_in_pollset(cddp); break; - case CHKIO_DRIVER_EVENT: - stop_driver_event(cddp); - break; case CHKIO_FD_CHANGE: stop_fd_change(cddp); break; @@ -556,6 +511,9 @@ chkio_drv_ready_input(ErlDrvData drv_data, ErlDrvEvent event) driver_failure_atom(cddp->port, "input_fd_not_found"); break; } + case CHKIO_FD_CHANGE: + /* This may be triggered when an fd is closed while being selected on. */ + break; case CHKIO_STEAL: break; case CHKIO_STEAL_AUX: @@ -620,55 +578,6 @@ chkio_drv_ready_input(ErlDrvData drv_data, ErlDrvEvent event) } static void -chkio_drv_ready_event(ErlDrvData drv_data, - ErlDrvEvent event, - ErlDrvEventData event_data) -{ -#ifdef UNIX - ChkioDrvData *cddp = (ChkioDrvData *) drv_data; - switch (cddp->test) { - case CHKIO_DRIVER_EVENT: { -#ifdef HAVE_POLL_H - ChkioDriverEvent *cdep = cddp->test_data; - int fd = (int) (ErlDrvSInt) event; - if (fd == cdep->in_fd) { - if (event_data->events == POLLIN - && event_data->revents == POLLIN) { - cdep->in_ok++; - } - else { - driver_failure_atom(cddp->port, "invalid_input_fd_events"); - } - break; - } - if (fd == cdep->out_fd) { - if (event_data->events == POLLOUT - && event_data->revents == POLLOUT) { - cdep->out_ok++; - } - else { - driver_failure_atom(cddp->port, "invalid_output_fd_events"); - } - break; - } -#endif - } - case CHKIO_STEAL: -#ifdef HAVE_POLL_H - break; -#endif - case CHKIO_STEAL_AUX: -#ifdef HAVE_POLL_H - break; -#endif - default: - driver_failure_atom(cddp->port, "unexpected_ready_event"); - break; - } -#endif /* UNIX */ -} - -static void chkio_drv_timeout(ErlDrvData drv_data) { #ifdef UNIX @@ -778,25 +687,6 @@ chkio_drv_control(ErlDrvData drv_data, res_len = -1; stop_bad_fd_in_pollset(cddp); break; - case CHKIO_DRIVER_EVENT: { - ChkioDriverEvent *cdep = cddp->test_data; - if (!cdep->in_ok || !cdep->out_ok) { - if (!cdep->in_ok) - driver_failure_atom(cddp->port, "got_no_input_events"); - if (!cdep->out_ok) - driver_failure_atom(cddp->port, "got_no_output_events"); - } - else { - char *c = driver_alloc(sizeof(char)*2*30); - if (!c) - driver_failure_posix(cddp->port, ENOMEM); - *rbuf = c; - res_len = sprintf(c, "in=%d\nout=%d\n", - cdep->in_ok, cdep->out_ok); - } - stop_driver_event(cddp); - break; - } case CHKIO_FD_CHANGE: { ChkioFdChange *cfcp = cddp->test_data; if (!cfcp->same_fd) @@ -936,69 +826,6 @@ chkio_drv_control(ErlDrvData drv_data, res_len = -1; break; } - case CHKIO_DRIVER_EVENT: { -#ifndef HAVE_POLL_H - res_str = "skip: Need the poll.h header for this test, but it doesn't exist"; - res_len = -1; -#else /* HAVE_POLL_H */ - int in_fd = open("/dev/zero", O_RDONLY); - int out_fd = open("/dev/null", O_WRONLY); - - if (in_fd < 0 || out_fd < 0) { - if (in_fd >= 0) - close(in_fd); - if (out_fd >= 0) - close(out_fd); - driver_failure_posix(cddp->port, errno); - } - else { - ChkioDriverEvent *cdep = driver_alloc(sizeof(ChkioDriverEvent)); - if (!cdep) - driver_failure_posix(cddp->port, ENOMEM); - else { - int res; - cddp->test_data = cdep; - - cdep->in_fd = in_fd; - cdep->in_data.events = POLLIN; - cdep->in_data.revents = 0; - cdep->in_ok = 0; - - res = driver_event(cddp->port, - (ErlDrvEvent) (ErlDrvSInt) in_fd, - &cdep->in_data); - if (res < 0) { - res_str = "skip: driver_event() not supported"; - res_len = -1; - close(in_fd); - close(out_fd); - cdep->in_fd = -1; - cdep->out_fd = -1; - } - else { - res_str = "ok"; - res_len = -1; - - cdep->out_fd = out_fd; - cdep->out_data.events = POLLOUT; - cdep->out_data.revents = 0; - cdep->out_ok = 0; - - res = driver_event(cddp->port, - (ErlDrvEvent) (ErlDrvSInt) out_fd, - &cdep->out_data); - if (res < 0) { - close(out_fd); - cdep->out_fd = -1; - driver_failure_atom(cddp->port, "driver_event_failed"); - } - } - - } - } -#endif /* HAVE_POLL_H */ - break; - } case CHKIO_FD_CHANGE: { ChkioFdChange *cfcp = driver_alloc(sizeof(ChkioFdChange)); if (!cfcp) @@ -1027,58 +854,19 @@ chkio_drv_control(ErlDrvData drv_data, res_len = -1; } else { - int driver_event_fds[2]; int driver_select_fds[2]; cddp->test_data = csp; memcpy(c, buf, len); c[len] = '\0'; if (sscanf(c, - "fds:%d:%d:%d:%d", + "fds:%d:%d", &driver_select_fds[0], - &driver_select_fds[1], - &driver_event_fds[0], - &driver_event_fds[1]) != 4) - driver_failure_atom(cddp->port, "bad_input"); + &driver_select_fds[1]) != 2) + driver_failure_atom(cddp->port, "bad_input"); else { int res = 0; - if (driver_event_fds[0] < 0) { /* Have no working driver_event() ... */ - csp->driver_select_fds[0] = driver_select_fds[0]; /* In */ - csp->driver_select_fds[1] = driver_select_fds[1]; /* Out */ - csp->driver_event_fds[0] = -1; - csp->driver_event_fds[1] = -1; - } - else { /* Have working driver_event() ... */ -#ifndef HAVE_POLL_H - driver_failure_atom(cddp->port, "unexpected_result"); - res = -1; -#else - csp->driver_select_fds[0] = driver_select_fds[0]; /* In */ - csp->driver_event_fds[1] = driver_select_fds[1]; /* Out */ - csp->driver_event_fds[0] = driver_event_fds[0]; /* In */ - csp->driver_select_fds[1] = driver_event_fds[1]; /* Out */ - - /* Steal with driver_event() */ - - csp->event_data[0].events = POLLIN; - csp->event_data[0].revents = 0; - res = driver_event(cddp->port, - (ErlDrvEvent) (ErlDrvSInt) csp->driver_event_fds[0], - &csp->event_data[0]); - if (res < 0) - driver_failure_atom(cddp->port, - "driver_event_failed_to_steal"); - if (res >= 0) { - csp->event_data[1].events = POLLOUT; - csp->event_data[1].revents = 0; - res = driver_event(cddp->port, - (ErlDrvEvent) (ErlDrvSInt) csp->driver_event_fds[1], - &csp->event_data[1]); - if (res < 0) - driver_failure_atom(cddp->port, - "driver_event_failed_to_steal"); - } -#endif - } + csp->driver_select_fds[0] = driver_select_fds[0]; /* In */ + csp->driver_select_fds[1] = driver_select_fds[1]; /* Out */ /* Steal with driver_select() */ if (res >= 0) { @@ -1108,37 +896,17 @@ chkio_drv_control(ErlDrvData drv_data, break; } case CHKIO_STEAL_AUX: { - int read_fds[2]; - int write_fds[2]; - - read_fds[0] = open("/dev/zero", O_RDONLY); - write_fds[0] = open("/dev/null", O_WRONLY); + int read_fd; + int write_fd; -#ifdef HAVE_POLL_H - read_fds[1] = open("/dev/zero", O_RDONLY); - write_fds[1] = open("/dev/null", O_WRONLY); -#else - read_fds[1] = -1; - write_fds[1] = -1; -#endif + read_fd = open("/dev/zero", O_RDONLY); + write_fd = open("/dev/null", O_WRONLY); - if (read_fds[0] < 0 - || write_fds[0] < 0 -#ifdef HAVE_POLL_H - || read_fds[1] < 0 - || write_fds[1] < 0 -#endif - ) { - if (read_fds[0] < 0) - close(read_fds[0]); - if (write_fds[0] < 0) - close(write_fds[0]); -#ifdef HAVE_POLL_H - if (read_fds[1] < 0) - close(read_fds[1]); - if (write_fds[1] < 0) - close(write_fds[1]); -#endif + if (read_fd < 0 || write_fd < 0) { + if (read_fd < 0) + close(read_fd); + if (write_fd < 0) + close(write_fd); driver_failure_posix(cddp->port, errno); } else { @@ -1152,11 +920,8 @@ chkio_drv_control(ErlDrvData drv_data, int res; cddp->test_data = csap; - csap->driver_select_fds[0] = read_fds[0]; - csap->driver_select_fds[1] = write_fds[0]; - - csap->driver_event_fds[0] = read_fds[1]; - csap->driver_event_fds[1] = write_fds[1]; + csap->driver_select_fds[0] = read_fd; + csap->driver_select_fds[1] = write_fd; res = driver_select(cddp->port, (ErlDrvEvent) (ErlDrvSInt) csap->driver_select_fds[0], @@ -1172,32 +937,6 @@ chkio_drv_control(ErlDrvData drv_data, if (res < 0) driver_failure_atom(cddp->port, "driver_select_failed"); } -#ifdef HAVE_POLL_H - if (res >= 0) { - csap->event_data[0].events = POLLIN; - csap->event_data[0].revents = 0; - res = driver_event(cddp->port, - (ErlDrvEvent) (ErlDrvSInt) csap->driver_event_fds[0], - &csap->event_data[0]); - if (res < 0) { - close(csap->driver_event_fds[0]); - csap->driver_event_fds[0] = -1; - close(csap->driver_event_fds[1]); - csap->driver_event_fds[1] = -1; - res = 0; - } - else { - csap->event_data[1].events = POLLOUT; - csap->event_data[1].revents = 0; - res = driver_event(cddp->port, - (ErlDrvEvent) (ErlDrvSInt) csap->driver_event_fds[1], - &csap->event_data[1]); - if (res < 0) - driver_failure_atom(cddp->port, - "driver_event_failed"); - } - } -#endif if (res < 0) { res_str = "error"; res_len = -1; @@ -1212,11 +951,9 @@ chkio_drv_control(ErlDrvData drv_data, else { *rbuf = c; res_len = sprintf(c, - "fds:%d:%d:%d:%d", + "fds:%d:%d", csap->driver_select_fds[0], - csap->driver_select_fds[1], - csap->driver_event_fds[0], - csap->driver_event_fds[1]); + csap->driver_select_fds[1]); } } } @@ -1256,7 +993,7 @@ chkio_drv_control(ErlDrvData drv_data, } TRACEF(("%T: Created pipe [%d->%d]\n", cddp->id, fds[1], fds[0])); pip->read_fd = fds[0]; - pip->write_fd = fds[1]; + pip->write_fd = fds[1]; pip->state = Opened; pip->wasSelected = 0; pip->next_write = pip->next_read = rand_r(&pip->rand_state) % 1024; @@ -1266,7 +1003,8 @@ chkio_drv_control(ErlDrvData drv_data, }/*fall through*/ case Opened: { if (op & 1) { - TRACEF(("%T: Write %d to opened pipe [%d->%d]\n", cddp->id, pip->next_write, pip->write_fd, pip->read_fd)); + TRACEF(("%T: Write %d to opened pipe [%d->%d]\n", cddp->id, + pip->next_write, pip->write_fd, pip->read_fd)); if (write(pip->write_fd, &pip->next_write, sizeof(int)) != sizeof(int)) { fprintf(stderr, "Failed to write to pipe fd=%d, errno=%d\n", pip->write_fd, errno); abort(); @@ -1275,8 +1013,12 @@ chkio_drv_control(ErlDrvData drv_data, } op >>= 1; if (pip->wasSelected && (op & 1)) { - TRACEF(("%T: Close pipe [%d->%d]\n", cddp->id, pip->write_fd, pip->read_fd)); - if (close(pip->read_fd) || close(pip->write_fd)) { + TRACEF(("%T: Close pipe [%d->%d]\n", cddp->id, pip->write_fd, + pip->read_fd)); + drv_use_singleton.fd_stop_select = -2; /* disable stop_select asserts */ + if (driver_select(cddp->port, (ErlDrvEvent)(ErlDrvSInt)pip->read_fd, + DO_READ|ERL_DRV_USE, 0) + || close(pip->write_fd)) { fprintf(stderr, "Failed to close pipe, errno=%d\n", errno); abort(); } @@ -1284,8 +1026,10 @@ chkio_drv_control(ErlDrvData drv_data, break; } else { - TRACEF(("%T: Select on pipe [%d->%d]\n", cddp->id, pip->write_fd, pip->read_fd)); - if (driver_select(cddp->port, (ErlDrvEvent)(ErlDrvSInt)pip->read_fd, DO_READ, 1)) { + TRACEF(("%T: Select on pipe [%d->%d]\n", cddp->id, + pip->write_fd, pip->read_fd)); + if (driver_select(cddp->port, (ErlDrvEvent)(ErlDrvSInt)pip->read_fd, + DO_READ|ERL_DRV_USE, 1)) { fprintf(stderr, "driver_select failed for fd=%d\n", pip->read_fd); abort(); } @@ -1293,13 +1037,13 @@ chkio_drv_control(ErlDrvData drv_data, pip->wasSelected = 1; op >>= 1; if (pip->next_write != pip->next_read) { /* pipe not empty */ - if (op & 1) { + if (op & 1) { pip->state = Waiting; /* Wait for reader */ break; } op >>= 1; } - } + } }/*fall through*/ case Selected: if (op & 1) { @@ -1328,7 +1072,7 @@ chkio_drv_control(ErlDrvData drv_data, fprintf(stderr, "Failed to write to pipe fd=%d, errno=%d\n", pip->write_fd, errno); abort(); } - pip->next_write++; + pip->next_write++; } break; case Waiting: @@ -1396,10 +1140,18 @@ static void assert_print(char* str, int line) static void assert_failed(ErlDrvPort port, char* str, int line) { char buf[30]; + size_t bufsz = sizeof(buf); + assert_print(str,line); - snprintf(buf,sizeof(buf),"failed_at_line_%d",line); - driver_failure_atom(port,buf); - /*abort();*/ + + if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + && (strcmp("true", buf) == 0 || strcmp("yes", buf) == 0)) { + abort(); + } + else { + snprintf(buf,sizeof(buf),"failed_at_line_%d",line); + driver_failure_atom(port,buf); + } } #define my_driver_select(PORT,FD,MODE,ON) \ @@ -1574,7 +1326,12 @@ static void chkio_drv_stop_select(ErlDrvEvent e, void* null) if (!(drv_use_singleton.fd_stop_select < 0)) { assert_print("fd_stop_select<0", __LINE__); abort(); } - drv_use_singleton.fd_stop_select = (int)(long)e; + /* fd_stop_select counting is disabled if this is set to -2 */ + if (drv_use_singleton.fd_stop_select == -2) { + TRACEF(("closing %d\n", (int)(long)e)); + close((int)(long)e); + } else + drv_use_singleton.fd_stop_select = (int)(long)e; /* Can't call chkio_drv_use directly here. That could even be recursive. * Next timeout will detect it instead. */ diff --git a/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c index 578a210ab2..142ae46247 100644 --- a/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c +++ b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2013. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ diff --git a/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c b/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c index 59145447f8..4bc5b85338 100644 --- a/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c +++ b/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 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 1e107309df..11ccd2574e 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 @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 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 e2b338f801..fa58e9d5ec 100644 --- a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c +++ b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2013. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ @@ -24,8 +25,7 @@ * - ready_input(), * - ready_output(), * - timeout(), - * - driver_async() -> read_async(), and - * - event() + * - driver_async() -> read_async() */ #ifndef UNIX @@ -64,11 +64,9 @@ typedef enum { IOQ_EXIT_READY_OUTPUT = 2, IOQ_EXIT_TIMEOUT = 3, IOQ_EXIT_READY_ASYNC = 4, - IOQ_EXIT_EVENT = 5, IOQ_EXIT_READY_INPUT_ASYNC = 6, IOQ_EXIT_READY_OUTPUT_ASYNC = 7, IOQ_EXIT_TIMEOUT_ASYNC = 8, - IOQ_EXIT_EVENT_ASYNC = 9 } IOQExitTest; typedef struct { @@ -79,9 +77,6 @@ typedef struct { int outstanding_async_task; long async_task; ErlDrvPDL pdl; -#ifdef HAVE_POLL_H - struct erl_drv_event_data event_data; -#endif } IOQExitDrvData; #define EV2FD(EV) ((int) ((long) (EV))) @@ -96,8 +91,6 @@ static ErlDrvSSizeT control(ErlDrvData, unsigned int, static void timeout(ErlDrvData drv_data); static void ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data); static void flush(ErlDrvData drv_data); -static void event(ErlDrvData drv_data, ErlDrvEvent event, - ErlDrvEventData event_data); static void async_invoke(void*); static void do_driver_async(IOQExitDrvData *); @@ -117,7 +110,7 @@ static ErlDrvEntry ioq_exit_drv_entry = { ready_async, flush, NULL /* call */, - event, + NULL /* unused_event_callback*/, ERL_DRV_EXTENDED_MARKER, ERL_DRV_EXTENDED_MAJOR_VERSION, ERL_DRV_EXTENDED_MINOR_VERSION, @@ -148,10 +141,6 @@ start(ErlDrvPort port, char *command) ddp->outstanding_async_task = 0; ddp->async_task = -1; ddp->pdl = driver_pdl_create(port); -#ifdef HAVE_POLL_H - ddp->event_data.events = (short) 0; - ddp->event_data.revents = (short) 0; -#endif return (ErlDrvData) ddp; } @@ -191,27 +180,6 @@ static ErlDrvSSizeT control(ErlDrvData drv_data, #else goto done; #endif - case IOQ_EXIT_EVENT: - case IOQ_EXIT_EVENT_ASYNC: -#ifdef UNIX -#ifdef HAVE_POLL_H - ddp->ofd = open("/dev/null", O_WRONLY); - if (ddp->ofd < 0) { - driver_failure_posix(ddp->port, errno); - return 0; - } - else if (driver_event(ddp->port, FD2EV(ddp->ofd), NULL) != 0) { - res_str = "skip: driver_event() not supported"; - goto done; - } -#else - res_str = "skip: No poll.h found which is needed for this test"; - goto done; -#endif - break; -#else /* UNIX */ - goto done; -#endif case IOQ_EXIT_TIMEOUT: case IOQ_EXIT_TIMEOUT_ASYNC: break; @@ -265,13 +233,6 @@ static void stop(ErlDrvData drv_data) close(ddp->ofd); } break; - case IOQ_EXIT_EVENT: - case IOQ_EXIT_EVENT_ASYNC: - if (ddp->ofd >= 0) { - driver_event(ddp->port, FD2EV(ddp->ofd), NULL); - close(ddp->ofd); - } - break; #endif case IOQ_EXIT_TIMEOUT: case IOQ_EXIT_TIMEOUT_ASYNC: @@ -301,13 +262,6 @@ static void flush(ErlDrvData drv_data) case IOQ_EXIT_READY_OUTPUT_ASYNC: driver_select(ddp->port, FD2EV(ddp->ofd), DO_WRITE, 1); break; - case IOQ_EXIT_EVENT: - case IOQ_EXIT_EVENT_ASYNC: -#ifdef HAVE_POLL_H - ddp->event_data.events |= POLLOUT; - driver_event(ddp->port, FD2EV(ddp->ofd), &ddp->event_data); -#endif - break; #endif case IOQ_EXIT_TIMEOUT: case IOQ_EXIT_TIMEOUT_ASYNC: @@ -394,30 +348,6 @@ static void ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data) } } -static void event(ErlDrvData drv_data, - ErlDrvEvent event, - ErlDrvEventData event_data) -{ - IOQExitDrvData *ddp = (IOQExitDrvData *) drv_data; - - PRINTF(("event(%p, %d, %p) called\r\n", drv_data, EV2FD(event), event_data)); - -#if defined(UNIX) && defined(HAVE_POLL_H) - if (ddp->ofd == EV2FD(event)) { - driver_event(ddp->port, FD2EV(ddp->ofd), NULL); - close(ddp->ofd); - ddp->ofd = -1; - if (ddp->test == IOQ_EXIT_EVENT_ASYNC) - do_driver_async(ddp); - else { - driver_pdl_lock(ddp->pdl); - driver_deq(ddp->port, 1); - driver_pdl_unlock(ddp->pdl); - } - } -#endif -} - static void async_invoke(void *arg) { PRINTF(("async_invoke(%p) called\r\n", arg)); diff --git a/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c index 4eb0e6fa57..3e46d89288 100644 --- a/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c +++ b/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c index 396deb9bef..d7336ed59b 100644 --- a/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c +++ b/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 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 851f2c745b..14838f0377 100644 --- a/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c +++ b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson AB. Portions * created by Ericsson are Copyright 2008, Ericsson Utvecklings AB. All @@ -40,10 +41,6 @@ typedef struct { int ofd; int ifd; - int efd; -#ifdef HAVE_POLL_H - struct erl_drv_event_data edata; -#endif } mcd_data_t; static ErlDrvData start(ErlDrvPort port, char *command); @@ -89,7 +86,6 @@ start(ErlDrvPort port, char *command) mcd->ofd = -1; mcd->ifd = -1; - mcd->efd = -1; #ifdef UNIX @@ -104,15 +100,6 @@ start(ErlDrvPort port, char *command) goto error; if (driver_select(port, (ErlDrvEvent) (long) mcd->ifd, DO_READ, 1) != 0) goto error; - -#ifdef HAVE_POLL_H - mcd->efd = open("/dev/null", O_WRONLY); - if (mcd->efd < 0) - goto error; - mcd->edata.events = POLLOUT; - mcd->edata.revents = 0; - driver_event(port, (ErlDrvEvent) (long) mcd->efd, &mcd->edata); -#endif #endif driver_set_timer(port, 0); @@ -134,10 +121,6 @@ stop(ErlDrvData data) close(mcd->ofd); if (mcd->ifd >= 0) close(mcd->ifd); -#ifdef HAVE_POLL_H - if (mcd->efd >= 0) - close(mcd->efd); -#endif #endif driver_free(mcd); } diff --git a/erts/emulator/test/driver_SUITE_data/monitor_drv.c b/erts/emulator/test/driver_SUITE_data/monitor_drv.c index 81dfb65191..1418250484 100644 --- a/erts/emulator/test/driver_SUITE_data/monitor_drv.c +++ b/erts/emulator/test/driver_SUITE_data/monitor_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c b/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c index ff44145ca7..594a996ab9 100644 --- a/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c +++ b/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c b/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c index ad29d17f06..37cb93fb3a 100644 --- a/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c +++ b/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2014. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ 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 cbee1c3dce..685cda3e07 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 @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c index 6b9d4745ba..d50546b919 100644 --- a/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c +++ b/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c index 42b1d2a187..082694de82 100644 --- a/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c +++ b/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c index e44c7dbd5e..c69961928e 100644 --- a/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c +++ b/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c @@ -1,13 +1,14 @@ -/* ``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/. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -41,7 +42,9 @@ "thread=%s " \ "smp=%s " \ "async_thrs=%d " \ - "sched_thrs=%d" + "sched_thrs=%d " \ + "emu_nif_vsn=%d.%d" + static size_t sys_info_drv_max_res_len(ErlDrvSysInfo *sip) @@ -55,6 +58,7 @@ sys_info_drv_max_res_len(ErlDrvSysInfo *sip) slen += 5; /* smp */ slen += 20; /* async_thrs */ slen += 20; /* sched_thrs */ + slen += 2*20; /* emu_nif_vsn */ return slen; } @@ -72,7 +76,9 @@ sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str) sip->thread_support ? "true" : "false", sip->smp_support ? "true" : "false", sip->async_threads, - sip->scheduler_threads); + sip->scheduler_threads, + sip->nif_major_version, + sip->nif_minor_version); } #include "sys_info_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c index 5bbc966932..a847dbb6ad 100644 --- a/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c +++ b/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -40,7 +41,9 @@ "thread=%s " \ "smp=%s " \ "async_thrs=%d " \ - "sched_thrs=%d" + "sched_thrs=%d " \ + "emu_nif_vsn=%d.%d " \ + "dirty_sched=%s" static size_t sys_info_drv_max_res_len(ErlDrvSysInfo *sip) @@ -54,6 +57,8 @@ sys_info_drv_max_res_len(ErlDrvSysInfo *sip) slen += 5; /* smp */ slen += 20; /* async_thrs */ slen += 20; /* sched_thrs */ + slen += 2*20; /* emu_nif_vsn */ + slen += 5; /* dirty_sched */ return slen; } @@ -71,7 +76,10 @@ sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str) sip->thread_support ? "true" : "false", sip->smp_support ? "true" : "false", sip->async_threads, - sip->scheduler_threads); + sip->scheduler_threads, + sip->nif_major_version, + sip->nif_minor_version, + sip->dirty_scheduler_support ? "true" : "false"); } #include "sys_info_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c index c6c70a2075..7c22e2c365 100644 --- a/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c +++ b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h index 5a6ddb15cf..35e60c0d86 100644 --- a/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h +++ b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c index 63c69f751c..33a4794fba 100644 --- a/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c +++ b/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c @@ -1,13 +1,14 @@ -/* ``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/. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -41,7 +42,9 @@ "thread=%s " \ "smp=%s " \ "async_thrs=%d " \ - "sched_thrs=%d" + "sched_thrs=%d " \ + "emu_nif_vsn=%d.%d" + static size_t sys_info_drv_max_res_len(ErlDrvSysInfo *sip) @@ -55,6 +58,7 @@ sys_info_drv_max_res_len(ErlDrvSysInfo *sip) slen += 5; /* smp */ slen += 20; /* async_thrs */ slen += 20; /* sched_thrs */ + slen += 2*20; /* emu_nif_vsn */ return slen; } @@ -72,7 +76,9 @@ sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str) sip->thread_support ? "true" : "false", sip->smp_support ? "true" : "false", sip->async_threads, - sip->scheduler_threads); + sip->scheduler_threads, + sip->nif_major_version, + sip->nif_minor_version); } #include "sys_info_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c b/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c index 500725a7cd..f1f2b438f0 100644 --- a/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c +++ b/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c index 439fe6a184..48fe5fa435 100644 --- a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c +++ b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ diff --git a/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c b/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c index 5a9112afa3..56183c9484 100644 --- a/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c +++ b/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ diff --git a/erts/emulator/test/driver_SUITE_data/timer_drv.c b/erts/emulator/test/driver_SUITE_data/timer_drv.c index 57538e0d57..c3ce3b6e49 100644 --- a/erts/emulator/test/driver_SUITE_data/timer_drv.c +++ b/erts/emulator/test/driver_SUITE_data/timer_drv.c @@ -1,5 +1,13 @@ #include <stdio.h> #include "erl_driver.h" +#ifdef __WIN32__ +# include <windows.h> +#else +# include <sys/time.h> +# include <sys/types.h> +# include <sys/select.h> +# include <unistd.h> +#endif #define get_int32(s) ((((unsigned char*) (s))[0] << 24) | \ (((unsigned char*) (s))[1] << 16) | \ @@ -17,6 +25,7 @@ static ErlDrvData timer_start(ErlDrvPort, char*); static void timer_stop(ErlDrvData); static void timer_read(ErlDrvData, char*, ErlDrvSizeT); static void timer(ErlDrvData); +static void ms_sleep(int ms); static ErlDrvEntry timer_driver_entry = { @@ -75,9 +84,7 @@ static void timer_read(ErlDrvData p, char *buf, ErlDrvSizeT len) reply[0] = CANCELLED; driver_output(port, reply, 1); } else if (buf[0] == DELAY_START_TIMER) { -#ifndef __WIN32__ - sleep(1); -#endif + ms_sleep(1000); driver_set_timer(port, get_int32(buf + 1)); } } @@ -95,3 +102,34 @@ static void timer(ErlDrvData port) reply[0] = TIMER; driver_output((ErlDrvPort)port, reply, 1); } + +static void +ms_sleep(int ms) +{ + /* Important that we do not return too early... */ + ErlDrvTime time, timeout_time; + + time = erl_drv_monotonic_time(ERL_DRV_USEC); + + timeout_time = time + ((ErlDrvTime) ms)*1000; + + while (time < timeout_time) { + ErlDrvTime timeout = timeout_time - time; + +#ifdef __WIN32__ + Sleep((DWORD) (timeout / 1000)); +#else + { + struct timeval tv; + + tv.tv_sec = (long) timeout / (1000*1000); + tv.tv_usec = (long) timeout % (1000*1000); + + select(0, NULL, NULL, NULL, &tv); + } +#endif + + time = erl_drv_monotonic_time(ERL_DRV_USEC); + } + +} diff --git a/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c b/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c index 53b0a029ce..6750b8a78b 100644 --- a/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c +++ b/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c b/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c index ed705e565f..e7f4edde08 100644 --- a/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c +++ b/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/dump_SUITE.erl b/erts/emulator/test/dump_SUITE.erl new file mode 100644 index 0000000000..38fa198ea6 --- /dev/null +++ b/erts/emulator/test/dump_SUITE.erl @@ -0,0 +1,125 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(dump_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). + +-export([signal_abort/1]). + +-export([load/0]). + +-include_lib("kernel/include/file.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. + +all() -> + [signal_abort]. + +init_per_testcase(signal_abort, Config) -> + SO = erlang:system_info(schedulers_online), + erts_debug:set_internal_state(available_internal_state, true), + Dump = erts_debug:get_internal_state(scheduler_dump), + erts_debug:set_internal_state(available_internal_state, false), + if SO < 3 -> + {skip, "not enough schedulers"}; + not Dump -> + {skip, "the platform does not support scheduler dump"}; + Dump -> + Config + end. + +end_per_testcase(_, Config) -> + Config. + +%%% +%%% The test cases ------------------------------------------------------------- +%%% + +%% Test that a snapshot is taken of other schedulers using a signal +%% when a crash dump is generated. +signal_abort(Config) -> + + Dump = filename:join(proplists:get_value(priv_dir, Config),"signal_abort.dump"), + + {ok, Node} = start_node(Config), + + _P1 = spawn(Node, ?MODULE, load, []), + _P2 = spawn(Node, ?MODULE, load, []), + _P3 = spawn(Node, ?MODULE, load, []), + _P4 = spawn(Node, ?MODULE, load, []), + _P5 = spawn(Node, ?MODULE, load, []), + _P6 = spawn(Node, ?MODULE, load, []), + + timer:sleep(500), + + true = rpc:call(Node, os, putenv, ["ERL_CRASH_DUMP",Dump]), + rpc:call(Node, erlang, halt, ["dump"]), + + {ok, Bin} = get_dump_when_done(Dump), + + ct:log("~s",[Bin]), + + {match, Matches} = re:run(Bin,"Current Process: <",[global]), + + ct:log("Found ~p",[Matches]), + + true = length(Matches) > 1, + + file:delete(Dump), + + ok. + +get_dump_when_done(Dump) -> + case file:read_file_info(Dump) of + {ok, #file_info{ size = Sz }} -> + get_dump_when_done(Dump, Sz); + {error, enoent} -> + timer:sleep(100), + get_dump_when_done(Dump) + end. + +get_dump_when_done(Dump, Sz) -> + timer:sleep(100), + case file:read_file_info(Dump) of + {ok, #file_info{ size = Sz }} -> + file:read_file(Dump); + {ok, #file_info{ size = NewSz }} -> + get_dump_when_done(Dump, NewSz) + end. + +load() -> + lists:seq(1,10000), + load(). + +start_node(Config) when is_list(Config) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa}]). diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl index f79bb761d1..08d5597d78 100644 --- a/erts/emulator/test/efile_SUITE.erl +++ b/erts/emulator/test/efile_SUITE.erl @@ -1,49 +1,38 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% -module(efile_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). --export([iter_max_files/1, async_dist/1]). +-export([all/0, suite/0]). +-export([async_dist/1, + iter_max_files/1, + proc_zero_sized_files/1 + ]). -export([do_iter_max_files/2, do_async_dist/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). +-include_lib("stdlib/include/assert.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [iter_max_files, async_dist]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. + [iter_max_files, async_dist, proc_zero_sized_files]. do_async_dist(Dir) -> X = 100, @@ -69,59 +58,57 @@ file_keys(Dir,Num,FdList,FnList) -> Name = "dummy"++integer_to_list(Num), FN = filename:join([Dir,Name]), case file:open(FN,[write,raw]) of - {ok,FD} -> - {file_descriptor,prim_file,{Port,_}} = FD, - <<X:32/integer-big>> = - iolist_to_binary(erlang:port_control(Port,$K,[])), - [X | file_keys(Dir,Num-1,[FD|FdList],[FN|FnList])]; - {error,_} -> - % Try freeing up FD's if there are any - case FdList of - [] -> - exit({cannot_open_file,FN}); - _ -> - [ file:close(FD) || FD <- FdList ], - [ file:delete(F) || F <- FnList ], - file_keys(Dir,Num,[],[]) - end + {ok,FD} -> + {file_descriptor,prim_file,{Port,_}} = FD, + <<X:32/integer-big>> = + iolist_to_binary(erlang:port_control(Port,$K,[])), + [X | file_keys(Dir,Num-1,[FD|FdList],[FN|FnList])]; + {error,_} -> + % Try freeing up FD's if there are any + case FdList of + [] -> + exit({cannot_open_file,FN}); + _ -> + [ file:close(FD) || FD <- FdList ], + [ file:delete(F) || F <- FnList ], + file_keys(Dir,Num,[],[]) + end end. -async_dist(doc) -> - "Check that the distribution of files over async threads is fair"; +%% Check that the distribution of files over async threads is fair async_dist(Config) when is_list(Config) -> - DataDir = ?config(data_dir,Config), - TestFile = filename:join(DataDir, "existing_file"), + DataDir = proplists:get_value(data_dir,Config), Dir = filename:dirname(code:which(?MODULE)), AsyncSizes = [7,10,100,255,256,64,63,65], Max = 0.5, lists:foreach(fun(Size) -> - {ok,Node} = - test_server:start_node - (test_iter_max_files,slave, - [{args, - "+A "++integer_to_list(Size)++ - " -pa " ++ Dir}]), - {Distr,SD} = rpc:call(Node,?MODULE,do_async_dist, - [DataDir]), - test_server:stop_node(Node), - if - SD > Max -> - io:format("Bad async queue distribution for " - "~p async threads:~n" - " Standard deviation is ~p~n" - " Key distribution:~n ~lp~n", - [Size,SD,Distr]), - exit({bad_async_dist,Size,SD,Distr}); - true -> - io:format("OK async queue distribution for " - "~p async threads:~n" - " Standard deviation is ~p~n" - " Key distribution:~n ~lp~n", - [Size,SD,Distr]), - ok - end - end, AsyncSizes), + {ok,Node} = + test_server:start_node + (test_iter_max_files,slave, + [{args, + "+A "++integer_to_list(Size)++ + " -pa " ++ Dir}]), + {Distr,SD} = rpc:call(Node,?MODULE,do_async_dist, + [DataDir]), + test_server:stop_node(Node), + if + SD > Max -> + io:format("Bad async queue distribution for " + "~p async threads:~n" + " Standard deviation is ~p~n" + " Key distribution:~n ~lp~n", + [Size,SD,Distr]), + exit({bad_async_dist,Size,SD,Distr}); + true -> + io:format("OK async queue distribution for " + "~p async threads:~n" + " Standard deviation is ~p~n" + " Key distribution:~n ~lp~n", + [Size,SD,Distr]), + ok + end + end, AsyncSizes), ok. %% @@ -129,54 +116,94 @@ async_dist(Config) when is_list(Config) -> %% that we get the same number of files every time. %% -iter_max_files(suite) -> []; iter_max_files(Config) when is_list(Config) -> - DataDir = ?config(data_dir,Config), + DataDir = proplists:get_value(data_dir,Config), TestFile = filename:join(DataDir, "existing_file"), N = 10, %% Run on a different node in order to set the max ports Dir = filename:dirname(code:which(?MODULE)), {ok,Node} = test_server:start_node(test_iter_max_files,slave, - [{args,"+Q 1524 -pa " ++ Dir}]), + [{args,"+Q 1524 -pa " ++ Dir}]), L = rpc:call(Node,?MODULE,do_iter_max_files,[N, TestFile]), test_server:stop_node(Node), io:format("Number of files opened in each test:~n~w\n", [L]), all_equal(L), Head = hd(L), if Head >= 2 -> ok; - true -> ?line test_server:fail(too_few_files) + true -> ct:fail(too_few_files) end, {comment, "Max files: " ++ integer_to_list(hd(L))}. do_iter_max_files(N, Name) when N > 0 -> - ?line [max_files(Name)| do_iter_max_files(N-1, Name)]; + [max_files(Name)| do_iter_max_files(N-1, Name)]; do_iter_max_files(_, _) -> []. all_equal([E, E| T]) -> - ?line all_equal([E| T]); + all_equal([E| T]); all_equal([_]) -> ok; all_equal([]) -> ok. - + max_files(Name) -> - ?line Fds = open_files(Name), - ?line N = length(Fds), - ?line close_files(Fds), + Fds = open_files(Name), + N = length(Fds), + close_files(Fds), N. close_files([Fd| Fds]) -> - ?line file:close(Fd), - ?line close_files(Fds); + file:close(Fd), + close_files(Fds); close_files([]) -> ok. open_files(Name) -> - ?line case file:open(Name, [read,raw]) of - {ok, Fd} -> - [Fd| open_files(Name)]; - {error, _Reason} -> -% io:format("Error reason: ~p", [_Reason]), - [] - end. + case file:open(Name, [read,raw]) of + {ok, Fd} -> + [Fd| open_files(Name)]; + {error, _Reason} -> + % io:format("Error reason: ~p", [_Reason]), + [] + end. + +%% @doc If /proc filesystem exists (no way to know if it is real proc or just +%% a /proc directory), let's read some zero sized files 500 times each, while +%% ensuring that response isn't empty << >> +proc_zero_sized_files(Config) when is_list(Config) -> + {Type, Flavor} = os:type(), + %% Some files which exist on Linux but might be missing on other systems + Inputs = ["/proc/cpuinfo", + "/proc/meminfo", + "/proc/partitions", + "/proc/swaps", + "/proc/version", + "/proc/uptime", + %% curproc is present on freebsd + "/proc/curproc/cmdline"], + case filelib:is_dir("/proc") of + false -> {skip, "/proc not found"}; % skip the test if no /proc + _ when Type =:= unix andalso Flavor =:= sunos -> + %% SunOS has a /proc, but no zero sized special files + {skip, "sunos does not have any zero sized special files"}; + true -> + %% Take away files which do not exist in proc + Inputs1 = lists:filter(fun filelib:is_file/1, Inputs), + + %% Fail if none of mentioned files exist in /proc, did we just get + %% a normal /proc directory without any special files? + ?assertNotEqual([], Inputs1), + + %% For 6 inputs and 500 attempts each this do run anywhere + %% between 500 and 3000 function calls. + lists:foreach( + fun(Filename) -> do_proc_zero_sized(Filename, 500) end, + Inputs1) + end. + +%% @doc Test one file N times to also trigger possible leaking fds and memory +do_proc_zero_sized(_Filename, 0) -> ok; +do_proc_zero_sized(Filename, N) -> + Data = file:read_file(Filename), + ?assertNotEqual(<<>>, Data), + do_proc_zero_sized(Filename, N-1). diff --git a/erts/emulator/test/emulator.spec.ose b/erts/emulator/test/emulator.spec.ose deleted file mode 100644 index 9f494609d9..0000000000 --- a/erts/emulator/test/emulator.spec.ose +++ /dev/null @@ -1,2 +0,0 @@ -{topcase, {dir, "../emulator_test"}}. -{skip, {obsolete_SUITE, "Not on ose"}}. diff --git a/erts/emulator/test/emulator_node_container_SUITE.spec b/erts/emulator/test/emulator_node_container_SUITE.spec new file mode 100644 index 0000000000..77c28ba7ae --- /dev/null +++ b/erts/emulator/test/emulator_node_container_SUITE.spec @@ -0,0 +1,2 @@ +{enable_builtin_hooks, false}. +{suites,"../emulator_test",node_container_SUITE}. diff --git a/erts/emulator/test/emulator_smoke.spec b/erts/emulator/test/emulator_smoke.spec index 3219aeb823..fc98ba6823 100644 --- a/erts/emulator/test/emulator_smoke.spec +++ b/erts/emulator/test/emulator_smoke.spec @@ -1,3 +1,10 @@ -{suites,"../emulator_test",[smoke_test_SUITE,time_SUITE]}. -{cases,"../emulator_test",crypto_SUITE,[t_md5]}. -{cases,"../emulator_test",float_SUITE,[fpe,cmp_integer]}.
\ No newline at end of file +{define,'Dir',"../emulator_test"}. +{suites,'Dir',[smoke_test_SUITE]}. +{suites,'Dir',[time_SUITE]}. +{skip_cases,'Dir',time_SUITE, + [univ_to_local,local_to_univ],"Depends on CET timezone"}. +{skip_cases,'Dir',time_SUITE, + [consistency],"Not reliable in October and March"}. +{cases,'Dir',crypto_SUITE,[t_md5]}. +{cases,'Dir',float_SUITE,[fpe,cmp_integer]}. +{cases,'Dir',erts_debug_SUITE,[df]}. diff --git a/erts/emulator/test/erl_drv_thread_SUITE.erl b/erts/emulator/test/erl_drv_thread_SUITE.erl index 84a82cced0..f99c151936 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE.erl +++ b/erts/emulator/test/erl_drv_thread_SUITE.erl @@ -1,30 +1,30 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(erl_drv_thread_SUITE). -author('[email protected]'). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0]). -export([basic/1, rwlock/1, tsd/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(DEFAULT_TIMETRAP_SECS, 240). @@ -33,38 +33,17 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, rwlock, tsd]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% %% Testcases %% %% %% -basic(suite) -> []; -basic(doc) -> []; -basic(Cfg) -> ?line drv_case(Cfg, basic). +basic(Cfg) -> drv_case(Cfg, basic). -rwlock(suite) -> []; -rwlock(doc) -> []; -rwlock(Cfg) -> ?line drv_case(Cfg, rwlock). +rwlock(Cfg) -> drv_case(Cfg, rwlock). -tsd(suite) -> []; -tsd(doc) -> []; -tsd(Cfg) -> ?line drv_case(Cfg, tsd). +tsd(Cfg) -> drv_case(Cfg, tsd). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% @@ -80,58 +59,54 @@ drv_case(Config, CaseName, Command) when is_list(Command) -> drv_case(Config, CaseName, Command, ?DEFAULT_TIMETRAP_SECS). drv_case(Config, CaseName, TimeTrap, Command) when is_list(Command), - is_integer(TimeTrap) -> + is_integer(TimeTrap) -> drv_case(Config, CaseName, Command, TimeTrap); drv_case(Config, CaseName, Command, TimeTrap) when is_list(Config), - is_atom(CaseName), - is_list(Command), - is_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])])} + is_atom(CaseName), + is_list(Command), + is_integer(TimeTrap) -> + case os:type() of + {Family, _} when Family == unix; Family == win32 -> + run_drv_case(Config, CaseName, Command, TimeTrap); + SkipOs -> + {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), + ct:timetrap({seconds, TimeTrap}), + DataDir = proplists:get_value(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() + ok -> ok; + {error, Error} -> + ct:fail(erl_ddll:format_error(Error)) 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. + Port = open_port({spawn, atom_to_list(CaseName)}, []), + true = is_port(Port), + Port ! {self(), {command, Command}}, + Result = receive_drv_result(Port, CaseName), + Port ! {self(), close}, + receive + {Port, closed} -> + ok + end, + ok = erl_ddll:unload_driver(CaseName), + 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. + receive + {print, Port, CaseName, Str} -> + io:format("~s", [Str]), + receive_drv_result(Port, CaseName); + {'EXIT', Port, Error} -> + ct:fail(Error); + {'EXIT', error, Error} -> + ct:fail(Error); + {failed, Port, CaseName, Comment} -> + ct:fail(Comment); + {skipped, Port, CaseName, Comment} -> + {skipped, Comment}; + {succeeded, Port, CaseName, ""} -> + succeeded; + {succeeded, Port, CaseName, Comment} -> + {comment, Comment} + end. diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src b/erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src index 216707e8a5..169fad9231 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src @@ -1,13 +1,14 @@ -# ``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. +# ``Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # The Initial Developer of the Original Code is Ericsson Utvecklings AB. # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c b/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c index fca2c1dbea..8ceb9eff08 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c b/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c index 064f52c16b..98d0162b55 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c index 2cd3209231..7f5faf9121 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h index 18d5229780..bffe4f9f27 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c b/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c index 3809c915e0..4c952767c2 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl index 435c0872e6..d8c5b663e3 100644 --- a/erts/emulator/test/erl_link_SUITE.erl +++ b/erts/emulator/test/erl_link_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -28,24 +29,23 @@ -author('[email protected]'). %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). % Test cases -export([links/1, - dist_links/1, - monitor_nodes/1, - process_monitors/1, - dist_process_monitors/1, - busy_dist_port_monitor/1, - busy_dist_port_link/1, - otp_5772_link/1, - otp_5772_dist_link/1, - otp_5772_monitor/1, - otp_5772_dist_monitor/1, - otp_7946/1]). + dist_links/1, + monitor_nodes/1, + process_monitors/1, + dist_process_monitors/1, + busy_dist_port_monitor/1, + busy_dist_port_link/1, + otp_5772_link/1, + otp_5772_dist_link/1, + otp_5772_monitor/1, + otp_5772_dist_monitor/1, + otp_7946/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -60,25 +60,24 @@ % These are to be kept in sync with erl_monitors.h -define(MON_ORIGIN, 1). --define(MON_TARGET, 3). +-define(MON_TARGET, 2). -record(erl_link, {type = ?LINK_UNDEF, - pid = [], - targets = []}). + pid = [], + targets = []}). % This is to be kept in sync with erl_bif_info.c (make_monitor_list) --record(erl_monitor, { - type, % MON_ORIGIN or MON_TARGET (1 or 3) - ref, - pid, % Process or nodename - name = [] % registered name or [] - }). +-record(erl_monitor, {type, % MON_ORIGIN or MON_TARGET + ref, + pid, % Process or nodename + name = []}). % registered name or [] - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [links, dist_links, monitor_nodes, process_monitors, @@ -86,8 +85,15 @@ all() -> busy_dist_port_link, otp_5772_link, otp_5772_dist_link, otp_5772_monitor, otp_5772_dist_monitor, otp_7946]. -groups() -> - []. +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + case catch erts_debug:get_internal_state(available_internal_state) of + true -> ok; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end, + Config. + +end_per_testcase(_Func, _Config) -> + ok. init_per_suite(Config) -> Config. @@ -95,419 +101,397 @@ init_per_suite(Config) -> end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false). -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -links(doc) -> ["Tests node local links"]; -links(suite) -> []; +%% Tests node local links links(Config) when is_list(Config) -> - ?line common_link_test(node(), node()), - ?line true = link(self()), - ?line [] = find_erl_link(self(), ?LINK_PID, self()), - ?line true = unlink(self()), - ?line ok. - -dist_links(doc) -> ["Tests distributed links"]; -dist_links(suite) -> []; + common_link_test(node(), node()), + true = link(self()), + [] = find_erl_link(self(), ?LINK_PID, self()), + true = unlink(self()), + ok. + +%% Tests distributed links dist_links(Config) when is_list(Config) -> - ?line [NodeName] = get_names(1, dist_link), - ?line {ok, Node} = start_node(NodeName), - ?line common_link_test(node(), Node), - ?line TP4 = spawn(?MODULE, test_proc, []), - ?line TP5 = spawn(?MODULE, test_proc, []), - ?line TP6 = spawn(Node, ?MODULE, test_proc, []), - ?line true = tp_call(TP6, fun() -> link(TP4) end), - ?line check_link(TP4, TP6), - ?line true = tp_call(TP5, - fun() -> - process_flag(trap_exit,true), - link(TP6) - end), - ?line check_link(TP5, TP6), - ?line rpc:cast(Node, erlang, halt, []), - ?line wait_until(fun () -> ?line is_proc_dead(TP4) end), - ?line check_unlink(TP4, TP6), - ?line true = tp_call(TP5, - fun() -> - receive - {'EXIT', TP6, noconnection} -> - true - end - end), - ?line check_unlink(TP5, TP6), - ?line tp_cast(TP5, fun() -> exit(normal) end), - ?line ok. + [NodeName] = get_names(1, dist_link), + {ok, Node} = start_node(NodeName), + common_link_test(node(), Node), + TP4 = spawn(?MODULE, test_proc, []), + TP5 = spawn(?MODULE, test_proc, []), + TP6 = spawn(Node, ?MODULE, test_proc, []), + true = tp_call(TP6, fun() -> link(TP4) end), + check_link(TP4, TP6), + true = tp_call(TP5, + fun() -> + process_flag(trap_exit,true), + link(TP6) + end), + check_link(TP5, TP6), + rpc:cast(Node, erlang, halt, []), + wait_until(fun () -> is_proc_dead(TP4) end), + check_unlink(TP4, TP6), + true = tp_call(TP5, + fun() -> + receive + {'EXIT', TP6, noconnection} -> + true + end + end), + check_unlink(TP5, TP6), + tp_cast(TP5, fun() -> exit(normal) end), + ok. common_link_test(NodeA, NodeB) -> - ?line TP1 = spawn(NodeA, ?MODULE, test_proc, []), - ?line check_unlink(TP1, self()), - ?line TP2 = tp_call(TP1, - fun () -> - spawn_link(NodeB, ?MODULE, test_proc, []) - end), - ?line check_link(TP1, TP2), - ?line true = tp_call(TP2, fun() -> unlink(TP1) end), - ?line check_unlink(TP1, TP2), - ?line true = tp_call(TP2, fun() -> link(TP1) end), - ?line check_link(TP1, TP2), - ?line false = tp_call(TP2, fun() -> process_flag(trap_exit, true) end), - ?line tp_cast(TP1, fun () -> exit(died) end), - ?line true = tp_call(TP2, fun() -> - receive - {'EXIT', TP1, died} -> - true - end - end), - ?line check_unlink(TP1, TP2), - ?line TP3 = tp_call(TP2, - fun () -> - spawn_link(NodeA, ?MODULE, test_proc, []) - end), - ?line check_link(TP3, TP2), - ?line tp_cast(TP2, fun() -> exit(died) end), - ?line wait_until(fun () -> ?line is_proc_dead(TP3) end), - ?line check_unlink(TP3, TP2), - ?line ok. - -monitor_nodes(doc) -> ["Tests monitor of nodes"]; -monitor_nodes(suite) -> []; + TP1 = spawn(NodeA, ?MODULE, test_proc, []), + check_unlink(TP1, self()), + TP2 = tp_call(TP1, + fun () -> + spawn_link(NodeB, ?MODULE, test_proc, []) + end), + check_link(TP1, TP2), + true = tp_call(TP2, fun() -> unlink(TP1) end), + check_unlink(TP1, TP2), + true = tp_call(TP2, fun() -> link(TP1) end), + check_link(TP1, TP2), + false = tp_call(TP2, fun() -> process_flag(trap_exit, true) end), + tp_cast(TP1, fun () -> exit(died) end), + true = tp_call(TP2, fun() -> + receive + {'EXIT', TP1, died} -> + true + end + end), + check_unlink(TP1, TP2), + TP3 = tp_call(TP2, + fun () -> + spawn_link(NodeA, ?MODULE, test_proc, []) + end), + check_link(TP3, TP2), + tp_cast(TP2, fun() -> exit(died) end), + wait_until(fun () -> is_proc_dead(TP3) end), + check_unlink(TP3, TP2), + ok. + +%% Tests monitor of nodes monitor_nodes(Config) when is_list(Config) -> - ?line [An, Bn, Cn, Dn] = get_names(4, dist_link), - ?line {ok, A} = start_node(An), - ?line {ok, B} = start_node(Bn), - ?line C = list_to_atom(lists:concat([Cn, "@", hostname()])), - ?line D = list_to_atom(lists:concat([Dn, "@", hostname()])), - ?line 0 = no_of_monitor_node(self(), A), - ?line 0 = no_of_monitor_node(self(), B), - ?line monitor_node(A, true), - ?line monitor_node(B, true), - ?line monitor_node(D, true), - ?line monitor_node(D, true), + [An, Bn, Cn, Dn] = get_names(4, dist_link), + {ok, A} = start_node(An), + {ok, B} = start_node(Bn), + C = list_to_atom(lists:concat([Cn, "@", hostname()])), + D = list_to_atom(lists:concat([Dn, "@", hostname()])), + 0 = no_of_monitor_node(self(), A), + 0 = no_of_monitor_node(self(), B), + monitor_node(A, true), + monitor_node(B, true), + monitor_node(D, true), + monitor_node(D, true), %% Has been known to crash the emulator. - ?line {memory,_} = process_info(self(), memory), - - ?line monitor_node(A, false), - ?line monitor_node(B, true), - ?line monitor_node(C, true), - ?line monitor_node(C, false), - ?line monitor_node(C, true), - ?line monitor_node(B, true), - ?line monitor_node(A, false), - ?line monitor_node(B, true), - ?line monitor_node(B, false), - ?line monitor_node(A, true), - ?line check_monitor_node(self(), A, 1), - ?line check_monitor_node(self(), B, 3), - ?line check_monitor_node(self(), C, 0), - ?line check_monitor_node(self(), D, 0), - ?line receive {nodedown, C} -> ok end, - ?line receive {nodedown, C} -> ok end, - ?line receive {nodedown, C} -> ok end, - ?line receive {nodedown, D} -> ok end, - ?line receive {nodedown, D} -> ok end, - ?line stop_node(A), - ?line receive {nodedown, A} -> ok end, - ?line check_monitor_node(self(), A, 0), - ?line check_monitor_node(self(), B, 3), - ?line stop_node(B), - ?line receive {nodedown, B} -> ok end, - ?line receive {nodedown, B} -> ok end, - ?line receive {nodedown, B} -> ok end, - ?line check_monitor_node(self(), B, 0), - ?line receive - {nodedown, X} -> - ?line ?t:fail({unexpected_nodedown, X}) - after 0 -> - ?line ok - end, - ?line ok. - - -process_monitors(doc) -> ["Tests node local process monitors"]; -process_monitors(suite) -> []; + {memory,_} = process_info(self(), memory), + + monitor_node(A, false), + monitor_node(B, true), + monitor_node(C, true), + monitor_node(C, false), + monitor_node(C, true), + monitor_node(B, true), + monitor_node(A, false), + monitor_node(B, true), + monitor_node(B, false), + monitor_node(A, true), + check_monitor_node(self(), A, 1), + check_monitor_node(self(), B, 3), + check_monitor_node(self(), C, 0), + check_monitor_node(self(), D, 0), + receive {nodedown, C} -> ok end, + receive {nodedown, C} -> ok end, + receive {nodedown, C} -> ok end, + receive {nodedown, D} -> ok end, + receive {nodedown, D} -> ok end, + stop_node(A), + receive {nodedown, A} -> ok end, + check_monitor_node(self(), A, 0), + check_monitor_node(self(), B, 3), + stop_node(B), + receive {nodedown, B} -> ok end, + receive {nodedown, B} -> ok end, + receive {nodedown, B} -> ok end, + check_monitor_node(self(), B, 0), + receive + {nodedown, X} -> + ct:fail({unexpected_nodedown, X}) + after 0 -> + ok + end, + ok. + + +%% Tests node local process monitors process_monitors(Config) when is_list(Config) -> - ?line common_process_monitors(node(), node()), - ?line Mon1 = erlang:monitor(process,self()), - ?line [] = find_erl_monitor(self(), Mon1), - ?line [Name] = get_names(1, process_monitors), - ?line true = register(Name, self()), - ?line Mon2 = erlang:monitor(process, Name), - ?line [] = find_erl_monitor(self(), Mon2), - ?line receive - {'DOWN', Mon1, _, _, _} = Msg -> - ?line ?t:fail({unexpected_down_msg, Msg}); - {'DOWN', Mon2, _, _, _} = Msg -> - ?line ?t:fail({unexpected_down_msg, Msg}) - after 500 -> - ?line true = erlang:demonitor(Mon1), - ?line true = erlang:demonitor(Mon2), - ?line ok - end. - -dist_process_monitors(doc) -> ["Tests distributed process monitors"]; -dist_process_monitors(suite) -> []; + common_process_monitors(node(), node()), + Mon1 = erlang:monitor(process,self()), + [] = find_erl_monitor(self(), Mon1), + [Name] = get_names(1, process_monitors), + true = register(Name, self()), + Mon2 = erlang:monitor(process, Name), + [] = find_erl_monitor(self(), Mon2), + receive + {'DOWN', Mon1, _, _, _} = Msg -> + ct:fail({unexpected_down_msg, Msg}); + {'DOWN', Mon2, _, _, _} = Msg -> + ct:fail({unexpected_down_msg, Msg}) + after 500 -> + true = erlang:demonitor(Mon1), + true = erlang:demonitor(Mon2), + ok + end. + +%% Tests distributed process monitors dist_process_monitors(Config) when is_list(Config) -> - ?line [Name] = get_names(1,dist_process_monitors), - ?line {ok, Node} = start_node(Name), - ?line common_process_monitors(node(), Node), - ?line TP1 = spawn(Node, ?MODULE, test_proc, []), - ?line R1 = erlang:monitor(process, TP1), - ?line TP1O = get_down_object(TP1, self()), - ?line check_process_monitor(self(), TP1, R1), - ?line tp_cast(TP1, fun () -> halt() end), - ?line receive - {'DOWN',R1,process,TP1O,noconnection} -> - ?line ok - end, - ?line check_process_demonitor(self(), TP1, R1), - ?line R2 = erlang:monitor(process, TP1), - ?line receive - {'DOWN',R2,process,TP1O,noconnection} -> - ?line ok - end, - ?line check_process_demonitor(self(), TP1, R2), - ?line ok. + [Name] = get_names(1,dist_process_monitors), + {ok, Node} = start_node(Name), + common_process_monitors(node(), Node), + TP1 = spawn(Node, ?MODULE, test_proc, []), + R1 = erlang:monitor(process, TP1), + TP1O = get_down_object(TP1, self()), + check_process_monitor(self(), TP1, R1), + tp_cast(TP1, fun () -> halt() end), + receive + {'DOWN',R1,process,TP1O,noconnection} -> + ok + end, + check_process_demonitor(self(), TP1, R1), + R2 = erlang:monitor(process, TP1), + receive + {'DOWN',R2,process,TP1O,noconnection} -> + ok + end, + check_process_demonitor(self(), TP1, R2), + ok. common_process_monitors(NodeA, NodeB) -> - ?line TP1 = spawn(NodeA, ?MODULE, test_proc, []), - ?line TP2 = spawn(NodeB, ?MODULE, test_proc, []), - ?line run_common_process_monitors(TP1, TP2), - ?line TP3 = spawn(NodeA, ?MODULE, test_proc, []), - ?line TP4 = spawn(NodeB, ?MODULE, test_proc, []), - ?line [TP4N] = get_names(1, common_process_monitors), - ?line true = tp_call(TP4, fun () -> register(TP4N,self()) end), - ?line run_common_process_monitors(TP3, - case node() == node(TP4) of - true -> TP4N; - false -> {TP4N, node(TP4)} - end), - ?line ok. + TP1 = spawn(NodeA, ?MODULE, test_proc, []), + TP2 = spawn(NodeB, ?MODULE, test_proc, []), + run_common_process_monitors(TP1, TP2), + TP3 = spawn(NodeA, ?MODULE, test_proc, []), + TP4 = spawn(NodeB, ?MODULE, test_proc, []), + [TP4N] = get_names(1, common_process_monitors), + true = tp_call(TP4, fun () -> register(TP4N,self()) end), + run_common_process_monitors(TP3, + case node() == node(TP4) of + true -> TP4N; + false -> {TP4N, node(TP4)} + end), + ok. run_common_process_monitors(TP1, TP2) -> - ?line R1 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), - ?line check_process_monitor(TP1, TP2, R1), - - ?line tp_call(TP2, fun () -> catch erlang:demonitor(R1) end), - ?line check_process_monitor(TP1, TP2, R1), - - ?line true = tp_call(TP1, fun () -> erlang:demonitor(R1) end), - ?line check_process_demonitor(TP1, TP2, R1), - - ?line R2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), - ?line TP2O = get_down_object(TP2, TP1), - ?line check_process_monitor(TP1, TP2, R2), - ?line tp_cast(TP2, fun () -> exit(bye) end), - ?line wait_until(fun () -> ?line is_proc_dead(TP2) end), - ?line ok = tp_call(TP1, fun () -> - ?line receive - {'DOWN',R2,process,TP2O,bye} -> - ?line ok - end - end), - ?line check_process_demonitor(TP1, TP2, R2), - - ?line R3 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), - ?line ok = tp_call(TP1, fun () -> - ?line receive - {'DOWN',R3,process,TP2O,noproc} -> - ?line ok - end - end), - ?line check_process_demonitor(TP1, TP2, R3), - - ?line tp_cast(TP1, fun () -> exit(normal) end), - ?line wait_until(fun () -> ?line is_proc_dead(TP1) end), - ?line ok. - - -busy_dist_port_monitor(doc) -> ["Tests distributed monitor/2, demonitor/1, " - "and 'DOWN' message over busy distribution " - "port"]; -busy_dist_port_monitor(suite) -> []; + R1 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + check_process_monitor(TP1, TP2, R1), + + tp_call(TP2, fun () -> catch erlang:demonitor(R1) end), + check_process_monitor(TP1, TP2, R1), + + true = tp_call(TP1, fun () -> erlang:demonitor(R1) end), + check_process_demonitor(TP1, TP2, R1), + + R2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + TP2O = get_down_object(TP2, TP1), + check_process_monitor(TP1, TP2, R2), + tp_cast(TP2, fun () -> exit(bye) end), + wait_until(fun () -> is_proc_dead(TP2) end), + ok = tp_call(TP1, fun () -> + receive + {'DOWN',R2,process,TP2O,bye} -> + ok + end + end), + check_process_demonitor(TP1, TP2, R2), + + R3 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + ok = tp_call(TP1, fun () -> + receive + {'DOWN',R3,process,TP2O,noproc} -> + ok + end + end), + check_process_demonitor(TP1, TP2, R3), + + tp_cast(TP1, fun () -> exit(normal) end), + wait_until(fun () -> is_proc_dead(TP1) end), + ok. + + +%% Tests distributed monitor/2, demonitor/1, and 'DOWN' message +%% over busy distribution port busy_dist_port_monitor(Config) when is_list(Config) -> - ?line Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of - "true" -> start_busy_dist_port_tracer(); - _ -> false - end, + Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, - ?line [An] = get_names(1, busy_dist_port_monitor), - ?line {ok, A} = start_node(An), - ?line TP1 = spawn(A, ?MODULE, test_proc, []), + [An] = get_names(1, busy_dist_port_monitor), + {ok, A} = start_node(An), + TP1 = spawn(A, ?MODULE, test_proc, []), %% Check monitor over busy port - ?line M1 = suspend_on_busy_test(A, - "erlang:monitor(process, TP1)", - fun () -> erlang:monitor(process, TP1) end), - ?line check_process_monitor(self(), TP1, M1), + M1 = suspend_on_busy_test(A, + "erlang:monitor(process, TP1)", + fun () -> erlang:monitor(process, TP1) end), + check_process_monitor(self(), TP1, M1), %% Check demonitor over busy port - ?line suspend_on_busy_test(A, - "erlang:demonitor(M1)", - fun () -> erlang:demonitor(M1) end), - ?line check_process_demonitor(self(), TP1, M1), + suspend_on_busy_test(A, + "erlang:demonitor(M1)", + fun () -> erlang:demonitor(M1) end), + check_process_demonitor(self(), TP1, M1), %% Check down message over busy port - ?line TP2 = spawn(?MODULE, test_proc, []), - ?line M2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), - ?line check_process_monitor(TP1, TP2, M2), - ?line Ref = make_ref(), - ?line Busy = make_busy(A, 1000), - ?line receive after 100 -> ok end, - ?line tp_cast(TP2, fun () -> exit(Ref) end), - ?line receive after 100 -> ok end, - ?line unmake_busy(Busy), - ?line Ref = tp_call(TP1, fun () -> - receive - {'DOWN', M2, process, TP2, Ref} -> - Ref - end - end), - ?line tp_cast(TP1, fun () -> exit(normal) end), - ?line stop_node(A), - ?line stop_busy_dist_port_tracer(Tracer), - ?line ok. - -busy_dist_port_link(doc) -> ["Tests distributed link/1, unlink/1, and 'EXIT'", - " message over busy distribution port"]; -busy_dist_port_link(suite) -> []; + TP2 = spawn(?MODULE, test_proc, []), + M2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + check_process_monitor(TP1, TP2, M2), + Ref = make_ref(), + Busy = make_busy(A, 1000), + receive after 100 -> ok end, + tp_cast(TP2, fun () -> exit(Ref) end), + receive after 100 -> ok end, + unmake_busy(Busy), + Ref = tp_call(TP1, fun () -> + receive + {'DOWN', M2, process, TP2, Ref} -> + Ref + end + end), + tp_cast(TP1, fun () -> exit(normal) end), + stop_node(A), + stop_busy_dist_port_tracer(Tracer), + ok. + +%% Tests distributed link/1, unlink/1, and 'EXIT' +%% message over busy distribution port busy_dist_port_link(Config) when is_list(Config) -> - ?line Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of - "true" -> start_busy_dist_port_tracer(); - _ -> false - end, - - ?line [An] = get_names(1, busy_dist_port_link), - ?line {ok, A} = start_node(An), - ?line TP1 = spawn(A, ?MODULE, test_proc, []), + Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, + + [An] = get_names(1, busy_dist_port_link), + {ok, A} = start_node(An), + TP1 = spawn(A, ?MODULE, test_proc, []), %% Check link over busy port - ?line suspend_on_busy_test(A, - "link(TP1)", - fun () -> link(TP1) end), - ?line check_link(self(), TP1), + suspend_on_busy_test(A, + "link(TP1)", + fun () -> link(TP1) end), + check_link(self(), TP1), %% Check unlink over busy port - ?line suspend_on_busy_test(A, - "unlink(TP1)", - fun () -> unlink(TP1) end), - ?line check_unlink(self(), TP1), + suspend_on_busy_test(A, + "unlink(TP1)", + fun () -> unlink(TP1) end), + check_unlink(self(), TP1), %% Check trap exit message over busy port - ?line TP2 = spawn(?MODULE, test_proc, []), - ?line ok = tp_call(TP1, fun () -> - process_flag(trap_exit, true), - link(TP2), - ok - end), - ?line check_link(TP1, TP2), - ?line Ref = make_ref(), - ?line Busy = make_busy(A, 1000), - ?line receive after 100 -> ok end, - ?line tp_cast(TP2, fun () -> exit(Ref) end), - ?line receive after 100 -> ok end, - ?line unmake_busy(Busy), - ?line Ref = tp_call(TP1, fun () -> - receive - {'EXIT', TP2, Ref} -> - Ref - end - end), - ?line tp_cast(TP1, fun () -> exit(normal) end), - ?line stop_node(A), - ?line stop_busy_dist_port_tracer(Tracer), - ?line ok. - - -otp_5772_link(doc) -> []; -otp_5772_link(suite) -> []; + TP2 = spawn(?MODULE, test_proc, []), + ok = tp_call(TP1, fun () -> + process_flag(trap_exit, true), + link(TP2), + ok + end), + check_link(TP1, TP2), + Ref = make_ref(), + Busy = make_busy(A, 1000), + receive after 100 -> ok end, + tp_cast(TP2, fun () -> exit(Ref) end), + receive after 100 -> ok end, + unmake_busy(Busy), + Ref = tp_call(TP1, fun () -> + receive + {'EXIT', TP2, Ref} -> + Ref + end + end), + tp_cast(TP1, fun () -> exit(normal) end), + stop_node(A), + stop_busy_dist_port_tracer(Tracer), + ok. + + otp_5772_link(Config) when is_list(Config) -> - ?line otp_5772_link_test(node()). + otp_5772_link_test(node()). -otp_5772_dist_link(doc) -> []; -otp_5772_dist_link(suite) -> []; otp_5772_dist_link(Config) when is_list(Config) -> - ?line [An] = get_names(1, otp_5772_dist_link), - ?line {ok, A} = start_node(An), - ?line otp_5772_link_test(A), - ?line stop_node(A). + [An] = get_names(1, otp_5772_dist_link), + {ok, A} = start_node(An), + otp_5772_link_test(A), + stop_node(A). otp_5772_link_test(Node) -> - ?line Prio = process_flag(priority, high), - ?line TE = process_flag(trap_exit, true), - ?line TP1 = spawn_opt(Node, ?MODULE, test_proc, [], - [link, {priority, low}]), + Prio = process_flag(priority, high), + TE = process_flag(trap_exit, true), + TP1 = spawn_opt(Node, ?MODULE, test_proc, [], + [link, {priority, low}]), exit(TP1, bang), unlink(TP1), - ?line receive - {'EXIT', TP1, _} -> - ?line ok - after 0 -> - ?line ok - end, - ?line receive - {'EXIT', TP1, _} = Exit -> - ?line ?t:fail({got_late_exit_message, Exit}) - after 1000 -> - ?line ok - end, - ?line process_flag(trap_exit, TE), - ?line process_flag(priority, Prio), - ?line ok. - -otp_5772_monitor(doc) -> []; -otp_5772_monitor(suite) -> []; + receive + {'EXIT', TP1, _} -> + ok + after 0 -> + ok + end, + receive + {'EXIT', TP1, _} = Exit -> + ct:fail({got_late_exit_message, Exit}) + after 1000 -> + ok + end, + process_flag(trap_exit, TE), + process_flag(priority, Prio), + ok. + otp_5772_monitor(Config) when is_list(Config) -> - ?line otp_5772_monitor_test(node()). + otp_5772_monitor_test(node()). -otp_5772_dist_monitor(doc) -> []; -otp_5772_dist_monitor(suite) -> []; otp_5772_dist_monitor(Config) when is_list(Config) -> - ?line [An] = get_names(1, otp_5772_dist_monitor), - ?line {ok, A} = start_node(An), - ?line otp_5772_monitor_test(A), - ?line stop_node(A), - ?line ok. + [An] = get_names(1, otp_5772_dist_monitor), + {ok, A} = start_node(An), + otp_5772_monitor_test(A), + stop_node(A), + ok. otp_5772_monitor_test(Node) -> - ?line Prio = process_flag(priority, high), - ?line TP1 = spawn_opt(Node, ?MODULE, test_proc, [], [{priority, low}]), - ?line M1 = erlang:monitor(process, TP1), - ?line exit(TP1, bang), - ?line erlang:demonitor(M1), - ?line receive - {'DOWN', M1, _, _, _} -> - ?line ok - after 0 -> - ?line ok - end, - ?line receive - {'DOWN', M1, _, _, _} = Down -> - ?line ?t:fail({got_late_down_message, Down}) - after 1000 -> - ?line ok - end, - ?line process_flag(priority, Prio), - ?line ok. + Prio = process_flag(priority, high), + TP1 = spawn_opt(Node, ?MODULE, test_proc, [], [{priority, low}]), + M1 = erlang:monitor(process, TP1), + exit(TP1, bang), + erlang:demonitor(M1), + receive + {'DOWN', M1, _, _, _} -> + ok + after 0 -> + ok + end, + receive + {'DOWN', M1, _, _, _} = Down -> + ct:fail({got_late_down_message, Down}) + after 1000 -> + ok + end, + process_flag(priority, Prio), + ok. otp_7946(Config) when is_list(Config) -> - ?line [NodeName] = get_names(1, otp_7946), - ?line {ok, Node} = start_node(NodeName), - ?line Proc = rpc:call(Node, erlang, whereis, [net_kernel]), - ?line Mon = erlang:monitor(process, Proc), - ?line rpc:cast(Node, erlang, halt, []), - ?line receive {'DOWN', Mon, process, Proc , _} -> ok end, - ?line {Linker, LMon} = spawn_monitor(fun () -> - link(Proc), - receive - after infinity -> ok - end - end), - ?line receive - {'DOWN', LMon, process, Linker, Reason} -> - ?line ?t:format("Reason=~p~n", [Reason]), - ?line Reason = noconnection - end. + [NodeName] = get_names(1, otp_7946), + {ok, Node} = start_node(NodeName), + Proc = rpc:call(Node, erlang, whereis, [net_kernel]), + Mon = erlang:monitor(process, Proc), + rpc:cast(Node, erlang, halt, []), + receive {'DOWN', Mon, process, Proc , _} -> ok end, + {Linker, LMon} = spawn_monitor(fun () -> + link(Proc), + receive + after infinity -> ok + end + end), + receive + {'DOWN', LMon, process, Linker, Reason} -> + io:format("Reason=~p~n", [Reason]), + Reason = noconnection + end. %% %% -- Internal utils -------------------------------------------------------- @@ -518,27 +502,27 @@ otp_7946(Config) when is_list(Config) -> busy_data() -> case get(?BUSY_DATA_KEY) of - undefined -> - set_busy_data([]); - Data -> - true = is_binary(Data), - true = size(Data) == ?BUSY_DATA_SIZE, - Data + undefined -> + set_busy_data([]); + Data -> + true = is_binary(Data), + true = size(Data) == ?BUSY_DATA_SIZE, + Data end. set_busy_data(SetData) -> case get(?BUSY_DATA_KEY) of - undefined -> - Data = case SetData of - D when is_binary(D), size(D) == ?BUSY_DATA_SIZE -> - SetData; - _ -> - list_to_binary(lists:duplicate(?BUSY_DATA_SIZE, 253)) - end, - put(?BUSY_DATA_KEY, Data), - Data; - OldData -> - OldData + undefined -> + Data = case SetData of + D when is_binary(D), size(D) == ?BUSY_DATA_SIZE -> + SetData; + _ -> + list_to_binary(lists:duplicate(?BUSY_DATA_SIZE, 253)) + end, + put(?BUSY_DATA_KEY, Data), + Data; + OldData -> + OldData end. freeze_node(Node, MS) -> @@ -546,13 +530,13 @@ freeze_node(Node, MS) -> DoingIt = make_ref(), Freezer = self(), spawn_link(Node, - fun () -> - erts_debug:set_internal_state(available_internal_state, - true), - dport_send(Freezer, DoingIt), - receive after Own -> ok end, - erts_debug:set_internal_state(block, MS+Own) - end), + fun () -> + erts_debug:set_internal_state(available_internal_state, + true), + dctrl_dop_send(Freezer, DoingIt), + receive after Own -> ok end, + erts_debug:set_internal_state(block, MS+Own) + end), receive DoingIt -> ok end, receive after Own -> ok end. @@ -560,29 +544,31 @@ make_busy(Node, Time) when is_integer(Time) -> Own = 500, freeze_node(Node, Time+Own), Data = busy_data(), + DCtrl = dctrl(Node), %% first make port busy Pid = spawn_link(fun () -> - forever(fun () -> - dport_reg_send(Node, - '__noone__', - Data) - end) - end), + forever(fun () -> + dctrl_dop_reg_send(Node, + '__noone__', + Data) + end) + end), receive after Own -> ok end, wait_until(fun () -> - case process_info(Pid, status) of - {status, suspended} -> true; - _ -> false - end - end), + case {DCtrl, process_info(Pid, status)} of + {DPrt, {status, suspended}} when is_port(DPrt) -> true; + {DPid, {status, waiting}} when is_pid(DPid) -> true; + _ -> false + end + end), %% then dist entry make_busy(Node, [nosuspend], Data), Pid. make_busy(Node, Opts, Data) -> case erlang:send({'__noone__', Node}, Data, Opts) of - nosuspend -> nosuspend; - _ -> make_busy(Node, Opts, Data) + nosuspend -> nosuspend; + _ -> make_busy(Node, Opts, Data) end. unmake_busy(Pid) -> @@ -595,33 +581,33 @@ suspend_on_busy_test(Node, Doing, Fun) -> Done = make_ref(), Data = busy_data(), spawn_link(fun () -> - set_busy_data(Data), - Busy = make_busy(Node, 1000), - Tester ! DoIt, - receive after 100 -> ok end, - Info = process_info(Tester, [status, current_function]), - unmake_busy(Busy), - ?t:format("~p doing ~s: ~p~n", [Tester, Doing, Info]), - Tester ! {Done, Info} - end), + set_busy_data(Data), + Busy = make_busy(Node, 1000), + Tester ! DoIt, + receive after 100 -> ok end, + Info = process_info(Tester, [status, current_function]), + unmake_busy(Busy), + io:format("~p doing ~s: ~p~n", [Tester, Doing, Info]), + Tester ! {Done, Info} + end), receive DoIt -> ok end, Res = Fun(), receive - {Done, MyInfo} -> - %% Don't match arity; it is different in - %% debug and optimized emulator - [{status, suspended}, - {current_function, {erlang, bif_return_trap, _}}] = MyInfo, - ok + {Done, MyInfo} -> + %% Don't match arity; it is different in + %% debug and optimized emulator + [{status, suspended}, + {current_function, {erlang, bif_return_trap, _}}] = MyInfo, + ok end, Res. % get_node(Name) when is_atom(Name) -> -% ?line node(); +% node(); % get_node({Name, Node}) when is_atom(Name) -> -% ?line Node; +% Node; % get_node(NC) when is_pid(NC); is_port(NC); is_reference(NC) -> -% ?line node(NC). +% node(NC). get_down_object(Item, _) when is_pid(Item) -> Item; @@ -636,90 +622,78 @@ get_down_object(Item, Watcher) when is_atom(Item), is_atom(Watcher) -> is_proc_dead(P) -> case is_proc_alive(P) of - true -> false; - false -> true + true -> false; + false -> true end. is_proc_alive(Pid) when is_pid(Pid), node(Pid) == node() -> - ?line is_process_alive(Pid); + is_process_alive(Pid); is_proc_alive(Name) when is_atom(Name) -> - ?line case catch whereis(Name) of - Pid when is_pid(Pid) -> - ?line is_proc_alive(Pid); - _ -> - ?line false - end; + case catch whereis(Name) of + Pid when is_pid(Pid) -> + is_proc_alive(Pid); + _ -> + false + end; is_proc_alive({Name, Node}) when is_atom(Name), Node == node() -> - ?line is_proc_alive(Name); + is_proc_alive(Name); is_proc_alive(Proc) -> - ?line is_remote_proc_alive(Proc). + is_remote_proc_alive(Proc). is_remote_proc_alive({Name, Node}) when is_atom(Name), is_atom(Node) -> - ?line is_remote_proc_alive(Name, Node); + is_remote_proc_alive(Name, Node); is_remote_proc_alive(Pid) when is_pid(Pid) -> - ?line is_remote_proc_alive(Pid, node(Pid)); + is_remote_proc_alive(Pid, node(Pid)); is_remote_proc_alive(_) -> - ?line false. + false. is_remote_proc_alive(PN, Node) -> - ?line S = self(), - ?line R = make_ref(), - ?line monitor_node(Node, true), - ?line _P = spawn(Node, fun () -> S ! {R, is_proc_alive(PN)} end), - ?line receive - {R, Bool} -> - ?line monitor_node(Node, false), - ?line Bool; - {nodedown, Node} -> - ?line false - end. + S = self(), + R = make_ref(), + monitor_node(Node, true), + _P = spawn(Node, fun () -> S ! {R, is_proc_alive(PN)} end), + receive + {R, Bool} -> + monitor_node(Node, false), + Bool; + {nodedown, Node} -> + false + end. wait_until(Fun) -> - ?line case Fun() of - true -> - ?line ok; - _ -> - ?line receive - after 100 -> - ?line wait_until(Fun) - end - end. + case Fun() of + true -> + ok; + _ -> + receive + after 100 -> + wait_until(Fun) + end + end. forever(Fun) -> Fun(), forever(Fun). -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - ?line Dog = ?t:timetrap(?t:minutes(1)), - case catch erts_debug:get_internal_state(available_internal_state) of - true -> ok; - _ -> erts_debug:set_internal_state(available_internal_state, true) - end, - ?line [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - ?line Dog = ?config(watchdog, Config), - ?line ?t:timetrap_cancel(Dog). - tp_call(Tp, Fun) -> - ?line R = make_ref(), - ?line Tp ! {call, self(), R, Fun}, - ?line receive - {R, Res} -> - ?line Res - end. + R = make_ref(), + Tp ! {call, self(), R, Fun}, + receive + {R, Res} -> + Res + end. tp_cast(Tp, Fun) -> - ?line Tp ! {cast, Fun}. + Tp ! {cast, Fun}. test_proc() -> - ?line receive - {call, From, Ref, Fun} -> - ?line From ! {Ref, Fun()}; - {cast, Fun} -> - ?line Fun() - end, - ?line test_proc(). + receive + {call, From, Ref, Fun} -> + From ! {Ref, Fun()}; + {cast, Fun} -> + Fun() + end, + test_proc(). expand_link_list([#erl_link{type = ?LINK_NODE, targets = N} = Rec | T]) -> lists:duplicate(N,Rec#erl_link{targets = []}) ++ expand_link_list(T); @@ -727,7 +701,7 @@ expand_link_list([#erl_link{targets = [#erl_link{pid = Pid}]} = Rec | T]) -> [Rec#erl_link{targets = [Pid]} | expand_link_list(T)]; expand_link_list([#erl_link{targets = [#erl_link{pid = Pid}|TT]} = Rec | T]) -> [ Rec#erl_link{targets = [Pid]} | expand_link_list( - [Rec#erl_link{targets = TT} | T])]; + [Rec#erl_link{targets = TT} | T])]; expand_link_list([#erl_link{targets = []} = Rec | T]) -> [Rec | expand_link_list(T)]; expand_link_list([]) -> @@ -735,19 +709,19 @@ expand_link_list([]) -> get_local_link_list(Obj) -> case catch erts_debug:get_internal_state({link_list, Obj}) of - LL when is_list(LL) -> - expand_link_list(LL); - _ -> - [] + LL when is_list(LL) -> + expand_link_list(LL); + _ -> + [] end. get_remote_link_list(Node, Obj) -> case catch rpc:call(Node, erts_debug, get_internal_state, - [{link_list, Obj}]) of - LL when is_list(LL) -> - expand_link_list(LL); - _ -> - [] + [{link_list, Obj}]) of + LL when is_list(LL) -> + expand_link_list(LL); + _ -> + [] end. @@ -757,30 +731,30 @@ get_link_list({Node, DistEntry}) when is_atom(Node), is_atom(DistEntry) -> get_remote_link_list(Node, DistEntry); get_link_list(P) when is_pid(P); is_port(P) -> case node(P) of - Node when Node == node() -> - get_local_link_list(P); - Node -> - get_remote_link_list(Node, P) - end; + Node when Node == node() -> + get_local_link_list(P); + Node -> + get_remote_link_list(Node, P) + end; get_link_list(undefined) -> []. get_local_monitor_list(Obj) -> case catch erts_debug:get_internal_state({monitor_list, Obj}) of - LL when is_list(LL) -> - LL; - _ -> - [] - end. + LL when is_list(LL) -> + LL; + _ -> + [] + end. get_remote_monitor_list(Node, Obj) -> case catch rpc:call(Node, erts_debug, get_internal_state, - [{monitor_list, Obj}]) of - LL when is_list(LL) -> - LL; - _ -> - [] - end. + [{monitor_list, Obj}]) of + LL when is_list(LL) -> + LL; + _ -> + [] + end. get_monitor_list({Node, DistEntry}) when Node == node(), is_atom(DistEntry) -> @@ -789,242 +763,242 @@ get_monitor_list({Node, DistEntry}) when is_atom(Node), is_atom(DistEntry) -> get_remote_monitor_list(Node, DistEntry); get_monitor_list(P) when is_pid(P) -> case node(P) of - Node when Node == node() -> - get_local_monitor_list(P); - Node -> - get_remote_monitor_list(Node, P) - end; + Node when Node == node() -> + get_local_monitor_list(P); + Node -> + get_remote_monitor_list(Node, P) + end; get_monitor_list(undefined) -> []. find_erl_monitor(Pid, Ref) when is_reference(Ref) -> lists:foldl(fun (#erl_monitor{ref = R} = EL, Acc) when R == Ref -> - [EL|Acc]; - (_, Acc) -> - Acc - end, - [], - get_monitor_list(Pid)). + [EL|Acc]; + (_, Acc) -> + Acc + end, + [], + get_monitor_list(Pid)). % find_erl_link(Obj, Ref) when is_reference(Ref) -> -% ?line lists:foldl(fun (#erl_link{ref = R} = EL, Acc) when R == Ref -> -% ?line [EL|Acc]; +% lists:foldl(fun (#erl_link{ref = R} = EL, Acc) when R == Ref -> +% [EL|Acc]; % (_, Acc) -> -% ?line Acc +% Acc % end, % [], % get_link_list(Obj)). find_erl_link(Obj, Type, [Item, Data]) when is_pid(Item); - is_port(Item); - is_atom(Item) -> + is_port(Item); + is_atom(Item) -> lists:foldl(fun (#erl_link{type = T, pid = I, targets = D} = EL, - Acc) when T == Type, I == Item -> - case Data of - D -> - [EL|Acc]; - [] -> - [EL|Acc]; - _ -> - Acc - end; - (_, Acc) -> - Acc - end, - [], - get_link_list(Obj)); + Acc) when T == Type, I == Item -> + case Data of + D -> + [EL|Acc]; + [] -> + [EL|Acc]; + _ -> + Acc + end; + (_, Acc) -> + Acc + end, + [], + get_link_list(Obj)); find_erl_link(Obj, Type, Item) when is_pid(Item); is_port(Item); is_atom(Item) -> find_erl_link(Obj, Type, [Item, []]). - + check_link(A, B) -> - ?line [#erl_link{type = ?LINK_PID, - pid = B, - targets = []}] = find_erl_link(A, ?LINK_PID, B), - ?line [#erl_link{type = ?LINK_PID, - pid = A, - targets = []}] = find_erl_link(B, ?LINK_PID, A), - ?line case node(A) == node(B) of - false -> - ?line [#erl_link{type = ?LINK_PID, - pid = A, - targets = [B]}] = find_erl_link({node(A), - node(B)}, - ?LINK_PID, - [A, [B]]), - ?line [#erl_link{type = ?LINK_PID, - pid = B, - targets = [A]}] = find_erl_link({node(B), - node(A)}, - ?LINK_PID, - [B, [A]]); - true -> - ?line [] = find_erl_link({node(A), node(B)}, - ?LINK_PID, - [A, [B]]), - ?line [] = find_erl_link({node(B), node(A)}, - ?LINK_PID, - [B, [A]]) - end, - ?line ok. + [#erl_link{type = ?LINK_PID, + pid = B, + targets = []}] = find_erl_link(A, ?LINK_PID, B), + [#erl_link{type = ?LINK_PID, + pid = A, + targets = []}] = find_erl_link(B, ?LINK_PID, A), + case node(A) == node(B) of + false -> + [#erl_link{type = ?LINK_PID, + pid = A, + targets = [B]}] = find_erl_link({node(A), + node(B)}, + ?LINK_PID, + [A, [B]]), + [#erl_link{type = ?LINK_PID, + pid = B, + targets = [A]}] = find_erl_link({node(B), + node(A)}, + ?LINK_PID, + [B, [A]]); + true -> + [] = find_erl_link({node(A), node(B)}, + ?LINK_PID, + [A, [B]]), + [] = find_erl_link({node(B), node(A)}, + ?LINK_PID, + [B, [A]]) + end, + ok. check_unlink(A, B) -> - ?line [] = find_erl_link(A, ?LINK_PID, B), - ?line [] = find_erl_link(B, ?LINK_PID, A), - ?line [] = find_erl_link({node(A), node(B)}, ?LINK_PID, [A, [B]]), - ?line [] = find_erl_link({node(B), node(A)}, ?LINK_PID, [B, [A]]), - ?line ok. + [] = find_erl_link(A, ?LINK_PID, B), + [] = find_erl_link(B, ?LINK_PID, A), + [] = find_erl_link({node(A), node(B)}, ?LINK_PID, [A, [B]]), + [] = find_erl_link({node(B), node(A)}, ?LINK_PID, [B, [A]]), + ok. check_process_monitor(From, {Name, Node}, Ref) when is_pid(From), - is_atom(Name), - Node == node(From), - is_reference(Ref) -> - ?line check_process_monitor(From, Name, Ref); + is_atom(Name), + Node == node(From), + is_reference(Ref) -> + check_process_monitor(From, Name, Ref); check_process_monitor(From, {Name, Node}, Ref) when is_pid(From), - is_atom(Name), - is_atom(Node), - is_reference(Ref) -> - ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), - ?line [#erl_monitor{type = ?MON_ORIGIN, - ref = Ref, - pid = Node, - name = Name}] = find_erl_monitor(From, Ref), - ?line [#erl_monitor{type = ?MON_TARGET, - ref = Ref, - pid = From, - name = Name}] = find_erl_monitor({node(From), Node}, Ref), - ?line [#erl_monitor{type = ?MON_ORIGIN, - ref = Ref, - pid = MonitoredPid, - name = Name}] = find_erl_monitor({Node, node(From)}, Ref), - ?line [#erl_monitor{type = ?MON_TARGET, - ref = Ref, - pid = From, - name = Name}] = find_erl_monitor(MonitoredPid, Ref), - ?line ok; + is_atom(Name), + is_atom(Node), + is_reference(Ref) -> + MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), + [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = Node, + name = Name}] = find_erl_monitor(From, Ref), + [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From, + name = Name}] = find_erl_monitor({node(From), Node}, Ref), + [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = MonitoredPid, + name = Name}] = find_erl_monitor({Node, node(From)}, Ref), + [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From, + name = Name}] = find_erl_monitor(MonitoredPid, Ref), + ok; check_process_monitor(From, Name, Ref) when is_pid(From), - is_atom(Name), - undefined /= Name, - is_reference(Ref) -> - ?line MonitoredPid = rpc:call(node(From), erlang, whereis, [Name]), - - ?line [#erl_monitor{type = ?MON_ORIGIN, - ref = Ref, - pid = MonitoredPid, - name = Name}] = find_erl_monitor(From, Ref), - - - ?line [#erl_monitor{type = ?MON_TARGET, - ref = Ref, - pid = From, - name = Name}] = find_erl_monitor(MonitoredPid,Ref), + is_atom(Name), + undefined /= Name, + is_reference(Ref) -> + MonitoredPid = rpc:call(node(From), erlang, whereis, [Name]), + + [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = MonitoredPid, + name = Name}] = find_erl_monitor(From, Ref), + + + [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From, + name = Name}] = find_erl_monitor(MonitoredPid,Ref), ok; check_process_monitor(From, To, Ref) when is_pid(From), - is_pid(To), - is_reference(Ref) -> - ?line OriMon = [#erl_monitor{type = ?MON_ORIGIN, - ref = Ref, - pid = To}], - - ?line OriMon = find_erl_monitor(From, Ref), - - ?line TargMon = [#erl_monitor{type = ?MON_TARGET, - ref = Ref, - pid = From}], - ?line TargMon = find_erl_monitor(To, Ref), - - - ?line case node(From) == node(To) of - false -> - ?line TargMon = find_erl_monitor({node(From), node(To)}, Ref), - ?line OriMon = find_erl_monitor({node(To), node(From)}, Ref); - true -> - ?line [] = find_erl_monitor({node(From), node(From)}, Ref) - end, - ?line ok. + is_pid(To), + is_reference(Ref) -> + OriMon = [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = To}], + + OriMon = find_erl_monitor(From, Ref), + + TargMon = [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From}], + TargMon = find_erl_monitor(To, Ref), + + + case node(From) == node(To) of + false -> + TargMon = find_erl_monitor({node(From), node(To)}, Ref), + OriMon = find_erl_monitor({node(To), node(From)}, Ref); + true -> + [] = find_erl_monitor({node(From), node(From)}, Ref) + end, + ok. check_process_demonitor(From, {undefined, Node}, Ref) when is_pid(From), - is_reference(Ref) -> - ?line [] = find_erl_monitor(From, Ref), - ?line case node(From) == Node of - false -> - ?line [] = find_erl_monitor({node(From), Node}, Ref), - ?line [] = find_erl_monitor({Node, node(From)}, Ref); - true -> - ?line [] = find_erl_monitor({Node, Node}, Ref) - end, - ?line ok; + is_reference(Ref) -> + [] = find_erl_monitor(From, Ref), + case node(From) == Node of + false -> + [] = find_erl_monitor({node(From), Node}, Ref), + [] = find_erl_monitor({Node, node(From)}, Ref); + true -> + [] = find_erl_monitor({Node, Node}, Ref) + end, + ok; check_process_demonitor(From, {Name, Node}, Ref) when is_pid(From), - is_atom(Name), - Node == node(From), - is_reference(Ref) -> - ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), - ?line case rpc:call(Node, erlang, whereis, [Name]) of - undefined -> - ?line check_process_demonitor(From, {undefined, Node}, Ref); - MonitoredPid -> - ?line check_process_demonitor(From, MonitoredPid, Ref) - end; + is_atom(Name), + Node == node(From), + is_reference(Ref) -> + MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), + case rpc:call(Node, erlang, whereis, [Name]) of + undefined -> + check_process_demonitor(From, {undefined, Node}, Ref); + MonitoredPid -> + check_process_demonitor(From, MonitoredPid, Ref) + end; check_process_demonitor(From, {Name, Node}, Ref) when is_pid(From), - is_atom(Name), - is_atom(Node), - is_reference(Ref) -> - ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), - ?line [] = find_erl_monitor(From, Ref), - ?line [] = find_erl_monitor({node(From), Node}, Ref), - ?line [] = find_erl_monitor({Node, node(From)}, Ref), - ?line [] = find_erl_monitor(MonitoredPid, Ref), - ?line ok; + is_atom(Name), + is_atom(Node), + is_reference(Ref) -> + MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), + [] = find_erl_monitor(From, Ref), + [] = find_erl_monitor({node(From), Node}, Ref), + [] = find_erl_monitor({Node, node(From)}, Ref), + [] = find_erl_monitor(MonitoredPid, Ref), + ok; check_process_demonitor(From, undefined, Ref) when is_pid(From), - is_reference(Ref) -> - ?line [] = find_erl_monitor(From, Ref), - ?line case node(From) == node() of - false -> - ?line [] = find_erl_monitor({node(From), node()}, Ref), - ?line [] = find_erl_monitor({node(), node(From)}, Ref); - true -> - ?line [] = find_erl_monitor({node(), node()}, Ref) - end, - ?line ok; + is_reference(Ref) -> + [] = find_erl_monitor(From, Ref), + case node(From) == node() of + false -> + [] = find_erl_monitor({node(From), node()}, Ref), + [] = find_erl_monitor({node(), node(From)}, Ref); + true -> + [] = find_erl_monitor({node(), node()}, Ref) + end, + ok; check_process_demonitor(From, Name, Ref) when is_pid(From), - is_atom(Name), - undefined /= Name, - is_reference(Ref) -> - ?line check_process_demonitor(From, {Name, node()}, Ref); + is_atom(Name), + undefined /= Name, + is_reference(Ref) -> + check_process_demonitor(From, {Name, node()}, Ref); check_process_demonitor(From, To, Ref) when is_pid(From), - is_pid(To), - is_reference(Ref) -> - ?line [] = find_erl_monitor(From, Ref), - ?line [] = find_erl_monitor(To, Ref), - ?line case node(From) == node(To) of - false -> - ?line [] = find_erl_monitor({node(From), node(To)}, Ref), - ?line [] = find_erl_monitor({node(To), node(From)}, Ref); - true -> - ?line [] = find_erl_monitor({node(From), node(From)}, Ref) - end, - ?line ok. + is_pid(To), + is_reference(Ref) -> + [] = find_erl_monitor(From, Ref), + [] = find_erl_monitor(To, Ref), + case node(From) == node(To) of + false -> + [] = find_erl_monitor({node(From), node(To)}, Ref), + [] = find_erl_monitor({node(To), node(From)}, Ref); + true -> + [] = find_erl_monitor({node(From), node(From)}, Ref) + end, + ok. no_of_monitor_node(From, Node) when is_pid(From), is_atom(Node) -> - ?line length(find_erl_link(From, ?LINK_NODE, Node)). + length(find_erl_link(From, ?LINK_NODE, Node)). check_monitor_node(From, Node, No) when is_pid(From), - is_atom(Node), - is_integer(No), - No >= 0 -> - ?line LL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = Node}), - ?line DLL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = From}), - ?line LL = find_erl_link(From, ?LINK_NODE, Node), - ?line DLL = find_erl_link({node(From), Node}, ?LINK_NODE, From), - ?line ok. + is_atom(Node), + is_integer(No), + No >= 0 -> + LL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = Node}), + DLL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = From}), + LL = find_erl_link(From, ?LINK_NODE, Node), + DLL = find_erl_link({node(From), Node}, ?LINK_NODE, From), + ok. hostname() -> - ?line from($@, atom_to_list(node())). + from($@, atom_to_list(node())). from(H, [H | T]) -> T; from(H, [_ | T]) -> from(H, T); @@ -1035,31 +1009,28 @@ get_names(N, T) when is_atom(T) -> get_names(0, _, Acc) -> Acc; get_names(N, T, Acc) -> - {A, B, C} = now(), get_names(N-1, T, [list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(T) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)) | Acc]). + ++ "-" + ++ atom_to_list(T) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))) | Acc]). start_node(Name) -> - ?line start_node(Name, ""). + start_node(Name, ""). start_node(Name, Args) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line Res = ?t:start_node(Name, slave, [{args, Args ++ " -pa " ++ Pa}]), - ?line {ok, Node} = Res, - ?line rpc:call(Node, erts_debug, set_internal_state, - [available_internal_state, true]), - ?line Res. - + Pa = filename:dirname(code:which(?MODULE)), + Res = test_server:start_node(Name, slave, [{args, Args ++ " -pa " ++ Pa}]), + {ok, Node} = Res, + rpc:call(Node, erts_debug, set_internal_state, + [available_internal_state, true]), + Res. + stop_node(Node) -> - ?line ?t:stop_node(Node). + test_server:stop_node(Node). -define(COOKIE, ''). -define(DOP_LINK, 1). @@ -1079,42 +1050,45 @@ stop_node(Node) -> -define(DOP_DEMONITOR_P, 20). -define(DOP_MONITOR_P_EXIT, 21). -dport_send(To, Msg) -> - Node = node(To), - DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, - port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_SEND, - ?COOKIE, - To}), - dmsg_ext(Msg)]). - -dport_reg_send(Node, Name, Msg) -> - DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, - port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_REG_SEND, - self(), - ?COOKIE, - Name}), - dmsg_ext(Msg)]). - -dport(Node) when is_atom(Node) -> +ensure_dctrl(Node) -> + case dctrl(Node) of + undefined -> + pong = net_adm:ping(Node), + dctrl(Node); + DCtrl -> + DCtrl + end. + +dctrl_send(DPrt, Data) when is_port(DPrt) -> + port_command(DPrt, Data); +dctrl_send(DPid, Data) when is_pid(DPid) -> + Ref = make_ref(), + DPid ! {send, self(), Ref, Data}, + receive {Ref, Res} -> Res end. + +dctrl_dop_send(To, Msg) -> + dctrl_send(ensure_dctrl(node(To)), + [dmsg_hdr(), + dmsg_ext({?DOP_SEND, + ?COOKIE, + To}), + dmsg_ext(Msg)]). + +dctrl_dop_reg_send(Node, Name, Msg) -> + dctrl_send(ensure_dctrl(Node), + [dmsg_hdr(), + dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + Name}), + dmsg_ext(Msg)]). + +dctrl(Node) when is_atom(Node) -> case catch erts_debug:get_internal_state(available_internal_state) of - true -> true; - _ -> erts_debug:set_internal_state(available_internal_state, true) + true -> true; + _ -> erts_debug:set_internal_state(available_internal_state, true) end, - erts_debug:get_internal_state({dist_port, Node}). + erts_debug:get_internal_state({dist_ctrl, Node}). dmsg_hdr() -> [131, % Version Magic @@ -1138,11 +1112,7 @@ stop_busy_dist_port_tracer(_) -> busy_dist_port_tracer() -> receive - {monitor, _SuspendedProcess, busy_dist_port, _Port} = M -> - erlang:display(M), - busy_dist_port_tracer() + {monitor, _SuspendedProcess, busy_dist_port, _Port} = M -> + erlang:display(M), + busy_dist_port_tracer() end. - - - - diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index 87778dd0c2..6aa7a445b5 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -1,59 +1,37 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(erts_debug_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - test_size/1,flat_size_big/1,df/1, - instructions/1]). +-export([all/0, suite/0, + test_size/1,flat_size_big/1,df/1,term_type/1, + instructions/1, stack_check/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> - [test_size, flat_size_big, df, instructions]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(2)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). + [test_size, flat_size_big, df, instructions, term_type, + stack_check]. test_size(Config) when is_list(Config) -> ConsCell1 = id([a|b]), @@ -67,6 +45,14 @@ test_size(Config) when is_list(Config) -> 2 = do_test_size({[]}), 3 = do_test_size({a,b}), 7 = do_test_size({a,[b,c]}), + 8 = do_test_size(#{b => 2,c => 3}), + 4 = do_test_size(#{}), + 32 = do_test_size(#{b => 2,c => 3,txt => "hello world"}), + + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,256)])) >= map_size_lower_bound(256), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,4096)])) >= map_size_lower_bound(4096), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,254)])) >= map_size_lower_bound(254), + true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,239)])) >= map_size_lower_bound(239), %% Test internal consistency of sizes, but without testing %% exact sizes. @@ -89,14 +75,17 @@ test_size(Config) when is_list(Config) -> %% Test shared data structures. do_test_size([ConsCell1|ConsCell1], - 3*ConsCellSz, - 2*ConsCellSz), + 3*ConsCellSz, + 2*ConsCellSz), do_test_size(fun() -> {ConsCell1,ConsCell2} end, - FunSz2 + 2*ConsCellSz, - FunSz2 + ConsCellSz), + FunSz2 + 2*ConsCellSz, + FunSz2 + ConsCellSz), do_test_size({SimplestFun,SimplestFun}, - 2*FunSz0+do_test_size({a,b}), - FunSz0+do_test_size({a,b})), + 2*FunSz0+do_test_size({a,b}), + FunSz0+do_test_size({a,b})), + + M = id(#{ "atom" => first, i => 0}), + do_test_size([M,M#{ "atom" := other },M#{i := 42}],54,32), ok. do_test_size(Term) -> @@ -107,6 +96,13 @@ do_test_size(Term, FlatSz, Sz) -> FlatSz = erts_debug:flat_size(Term), Sz = erts_debug:size(Term). +map_size_lower_bound(N) -> + %% this est. is a bit lower that actual lower bound + %% number of internal nodes + T = (N - 1) div 15, + %% total words + 2 + 17 * T + 2 * N. + flat_size_big(Config) when is_list(Config) -> %% Build a term whose external size only fits in a big num (on 32-bit CPU). flat_size_big_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF). @@ -119,24 +115,99 @@ flat_size_big_1(Term, Size0, Limit) when Size0 < Limit -> end; flat_size_big_1(_, _, _) -> ok. + +term_type(Config) when is_list(Config) -> + Ts = [{fixnum, 1}, + {fixnum, -1}, + {bignum, 1 bsl 300}, + {bignum, -(1 bsl 300)}, + {hfloat, 0.0}, + {hfloat, 0.0/-1}, + {hfloat, 1.0/(1 bsl 302)}, + {hfloat, 1.0*(1 bsl 302)}, + {hfloat, -1.0/(1 bsl 302)}, + {hfloat, -1.0*(1 bsl 302)}, + {hfloat, 3.1416}, + {hfloat, 1.0e18}, + {hfloat, -3.1416}, + {hfloat, -1.0e18}, + + {heap_binary, <<1,2,3>>}, + {refc_binary, <<0:(8*80)>>}, + {sub_binary, <<5:7>>}, + + {flatmap, #{ a => 1}}, + {hashmap, maps:from_list([{I,I}||I <- lists:seq(1,76)])}, + + {list, [1,2,3]}, + {nil, []}, + {tuple, {1,2,3}}, + {tuple, {}}, + + {export, fun lists:sort/1}, + {'fun', fun() -> ok end}, + {pid, self()}, + {atom, atom}], + lists:foreach(fun({E,Val}) -> + R = erts_internal:term_type(Val), + io:format("expecting term type ~w, got ~w (~p)~n", [E,R,Val]), + E = R + end, Ts), + ok. + + df(Config) when is_list(Config) -> - ?line P0 = pps(), - ?line PrivDir = ?config(priv_dir, Config), - ?line ok = file:set_cwd(PrivDir), - ?line erts_debug:df(?MODULE), - ?line Beam = filename:join(PrivDir, ?MODULE_STRING++".dis"), - ?line {ok,Bin} = file:read_file(Beam), - ?line ok = io:put_chars(binary_to_list(Bin)), - ?line ok = file:delete(Beam), - ?line true = (P0 == pps()), + P0 = pps(), + PrivDir = proplists:get_value(priv_dir, Config), + ok = file:set_cwd(PrivDir), + + AllLoaded = [M || {M,_} <- code:all_loaded()], + {Pid,Ref} = spawn_monitor(fun() -> df_smoke(AllLoaded) end), + receive + {'DOWN',Ref,process,Pid,Status} -> + normal = Status + after 20*1000 -> + %% Not finished (i.e. a slow computer). Stop now. + Pid ! stop, + receive + {'DOWN',Ref,process,Pid,Status} -> + normal = Status, + io:format("...") + end + end, + io:nl(), + _ = [_ = file:delete(atom_to_list(M) ++ ".dis") || + M <- AllLoaded], + + true = (P0 == pps()), ok. +stack_check(Config) when is_list(Config) -> + erts_debug:set_internal_state(available_internal_state,true), + %% Recurses on the C stack until stacklimit is reached. That + %% is, tests that the stack limit functionality works (used + %% by PCRE). VM will crash if it doesn't work... + Size = erts_debug:get_internal_state(stack_check), + erts_debug:set_internal_state(available_internal_state,false), + {comment, "Stack size: "++integer_to_list(Size)++" bytes"}. + +df_smoke([M|Ms]) -> + io:format("~p", [M]), + erts_debug:df(M), + receive + stop -> + ok + after 0 -> + df_smoke(Ms) + end; +df_smoke([]) -> ok. + pps() -> {erlang:ports()}. instructions(Config) when is_list(Config) -> - ?line Is = erts_debug:instructions(), - ?line _ = [list_to_atom(I) || I <- Is], + Is = erts_debug:instructions(), + _ = [list_to_atom(I) || I <- Is], ok. id(I) -> diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl index 1de6d6fb56..c9c1867049 100644 --- a/erts/emulator/test/estone_SUITE.erl +++ b/erts/emulator/test/estone_SUITE.erl @@ -1,26 +1,26 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% -module(estone_SUITE). %% Test functions --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,estone/1,estone_bench/1]). --export([init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, groups/0, + estone/1, estone_bench/1, pgo/0]). %% Internal exports for EStone tests -export([lists/1, @@ -44,12 +44,9 @@ links/1,lproc/1, run_micro/3,p1/1,ppp/3,macro/2,micros/0]). - --include_lib("test_server/include/test_server.hrl"). +-ifndef(PGO). -include_lib("common_test/include/ct_event.hrl"). - -%% Test suite defines --define(default_timeout, ?t:minutes(10)). +-endif. %% EStone defines -define(TOTAL, (3000 * 1000 * 100)). %% 300 secs @@ -65,17 +62,9 @@ str}). %% Header string - - -init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [estone]. @@ -83,42 +72,41 @@ all() -> groups() -> [{estone_bench, [{repeat,50}],[estone_bench]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -estone(suite) -> - []; -estone(doc) -> - ["EStone Test"]; +%% EStone Test estone(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir,Config), - ?line Mhz=get_cpu_speed(os:type(),DataDir), - ?line L = ?MODULE:macro(?MODULE:micros(),DataDir), - ?line {Total, Stones} = sum_micros(L, 0, 0), - ?line pp(Mhz,Total,Stones,L), - ?line {comment,Mhz ++ " MHz, " ++ - integer_to_list(Stones) ++ " ESTONES"}. + DataDir = proplists:get_value(data_dir,Config), + Mhz=get_cpu_speed(os:type(),DataDir), + L = ?MODULE:macro(?MODULE:micros(),DataDir), + {Total, Stones} = sum_micros(L, 0, 0), + pp(Mhz,Total,Stones,L), + {comment,Mhz ++ " MHz, " ++ integer_to_list(Stones) ++ " ESTONES"}. estone_bench(Config) -> - DataDir = ?config(data_dir,Config), + DataDir = proplists:get_value(data_dir,Config), L = ?MODULE:macro(?MODULE:micros(),DataDir), - [ct_event:notify( - #event{name = benchmark_data, - data = [{name,proplists:get_value(title,Mark)}, - {value,proplists:get_value(estones,Mark)}]}) - || Mark <- L], + {Total, Stones} = sum_micros(L, 0, 0), + notify([[{title,"ESTONES"}, {estones, Stones}] | L]), L. +-ifndef(PGO). +notify(Marks) -> + [ct_event:notify( + #event{name = benchmark_data, + data = [{name,proplists:get_value(title, Mark)}, + {value,proplists:get_value(estones, Mark)}]}) + || Mark <- Marks]. +-else. +notify(_) -> + ok. +-endif. + +%% The benchmarks to run in order to guide PGO (profile guided optimisation) +pgo() -> + %% We run all benchmarks except the port_io as we don't want to + %% have to build a custom port. + Micros = ?MODULE:micros() -- [micro(port_io)], + ?MODULE:macro(Micros,[]). %% %% Calculate CPU speed @@ -339,7 +327,6 @@ micros() -> ]. macro(Ms,DataDir) -> - erlang:now(), %% compensate for old 4.3 firsttime clock bug :-( statistics(reductions), statistics(runtime), lists(500), %% fixup cache on first round @@ -369,10 +356,9 @@ run_micro(Top, M, DataDir) -> apply_micro(M) -> {GC0, Words0, _} = statistics(garbage_collection), statistics(reductions), - Before = erlang:now(), - + Before = monotonic_time(), Compensate = apply_micro(M#micro.function, M#micro.loops), - After = erlang:now(), + After = monotonic_time(), {GC1, Words1, _} = statistics(garbage_collection), {_, Reds} = statistics(reductions), Elapsed = subtr(Before, After), @@ -383,18 +369,19 @@ apply_micro(M) -> {weight_percentage, M#micro.weight}, {loops, M#micro.loops}, {microsecs,MicroSecs}, - {estones, (M#micro.weight * M#micro.weight * ?STONEFACTOR) div MicroSecs}, + {estones, (M#micro.weight * M#micro.weight * ?STONEFACTOR) div max(1,MicroSecs)}, {gcs, GC1 - GC0}, {kilo_word_reclaimed, (Words1 - Words0) div 1000}, {kilo_reductions, Reds div 1000}, - {gc_intensity, gci(Elapsed, GC1 - GC0, Words1 - Words0)}]. + {gc_intensity, gci(max(1,Elapsed), GC1 - GC0, Words1 - Words0)}]. +monotonic_time() -> + try erlang:monotonic_time() catch error:undef -> erlang:now() end. -subtr(Before, After) -> - (element(1,After)*1000000000000 - +element(2,After)*1000000+element(3,After)) - - (element(1,Before)*1000000000000 - +element(2,Before)*1000000+element(3,Before)). +subtr(Before, After) when is_integer(Before), is_integer(After) -> + erlang:convert_time_unit(After-Before, native, 1000000); +subtr({_,_,_}=Before, {_,_,_}=After) -> + timer:now_diff(After, Before). gci(Micros, Words, Gcs) -> ((256 * Gcs) / Micros) + (Words / Micros). @@ -633,10 +620,10 @@ tup_trav(T, P, End) -> %% Port I/O port_io(I) -> EstoneCat = get(estone_cat), - Before = erlang:now(), + Before = monotonic_time(), Pps = make_port_pids(5, I, EstoneCat), %% 5 ports send_procs(Pps, go), - After = erlang:now(), + After = monotonic_time(), wait_for_pids(Pps), subtr(Before, After). @@ -736,7 +723,7 @@ alloc(I) -> %% Time to call bif's %% Lot's of element stuff which reflects the record code which -%% is becomming more and more common +%% is becoming more and more common bif_dispatch(0) -> 0; bif_dispatch(I) -> @@ -854,10 +841,10 @@ handle_call(_From, State, [abc]) -> %% Binary handling, creating, manipulating and sending binaries binary_h(I) -> - Before = erlang:now(), + Before = monotonic_time(), P = spawn(?MODULE, echo, [self()]), B = list_to_binary(lists:duplicate(2000, 5)), - After = erlang:now(), + After = monotonic_time(), Compensate = subtr(Before, After), binary_h_2(I, P, B), Compensate. @@ -1136,4 +1123,3 @@ wait_for_pids([P|Tail]) -> send_procs([P|Tail], Msg) -> P ! Msg, send_procs(Tail, Msg); send_procs([], _) -> ok. - diff --git a/erts/emulator/test/evil_SUITE.erl b/erts/emulator/test/evil_SUITE.erl index f982b9d4ff..fc4ac037ac 100644 --- a/erts/emulator/test/evil_SUITE.erl +++ b/erts/emulator/test/evil_SUITE.erl @@ -1,40 +1,40 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% -module(evil_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - heap_frag/1, - encode_decode_ext/1, - decode_integer_ext/1, - decode_small_big_ext/1, - decode_large_big_ext/1, - decode_small_big_ext_neg/1, - decode_large_big_ext_neg/1, - decode_too_small/1, - decode_pos_neg_zero/1 - ]). +-export([all/0, suite/0, + heap_frag/1, + encode_decode_ext/1, + decode_integer_ext/1, + decode_small_big_ext/1, + decode_large_big_ext/1, + decode_small_big_ext_neg/1, + decode_large_big_ext_neg/1, + decode_too_small/1, + decode_pos_neg_zero/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [heap_frag, encode_decode_ext, decode_integer_ext, @@ -42,41 +42,16 @@ all() -> decode_small_big_ext_neg, decode_large_big_ext_neg, decode_too_small, decode_pos_neg_zero]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?t:minutes(0.5)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - heap_frag(Config) when is_list(Config) -> N = 512, Self = self(), - ?line Pid = spawn_link(fun() -> appender(Self, N) end), + Pid = spawn_link(fun() -> appender(Self, N) end), receive - {Pid,Res} -> - ?line Res = my_appender(N); - Garbage -> - io:format("Garbage: ~p\n", [Garbage]), - ?line ?t:fail(got_garbage) + {Pid,Res} -> + Res = my_appender(N); + Garbage -> + io:format("Garbage: ~p\n", [Garbage]), + ct:fail(got_garbage) end. @@ -86,29 +61,28 @@ heap_frag(Config) when is_list(Config) -> %% These test cases are not "evil" but the next test case is.... encode_decode_ext(Config) when is_list(Config) -> - ?line enc_dec( 2, 0), % SMALL_INTEGER_EXT smallest - ?line enc_dec( 2, 255), % SMALL_INTEGER_EXT largest - ?line enc_dec( 5, 256), % INTEGER_EXT smallest pos (*) - ?line enc_dec( 5, -1), % INTEGER_EXT largest neg - - ?line enc_dec( 5, 16#07ffffff), % INTEGER_EXT largest (28 bits) - ?line enc_dec( 5,-16#08000000), % INTEGER_EXT smallest - ?line enc_dec( 7, 16#08000000), % SMALL_BIG_EXT smallest pos(*) - ?line enc_dec( 7,-16#08000001), % SMALL_BIG_EXT largest neg (*) - - ?line enc_dec( 7, 16#7fffffff), % SMALL_BIG_EXT largest i32 - ?line enc_dec( 7,-16#80000000), % SMALL_BIG_EXT smallest i32 - - ?line enc_dec( 7, 16#80000000), % SMALL_BIG_EXT u32 - ?line enc_dec( 7, 16#ffffffff), % SMALL_BIG_EXT largest u32 - - ?line enc_dec( 9, 16#7fffffffffff), % largest i48 - ?line enc_dec( 9,-16#800000000000), % smallest i48 - ?line enc_dec( 9, 16#ffffffffffff), % largest u48 - ?line enc_dec(11, 16#7fffffffffffffff), % largest i64 - ?line enc_dec(11,-16#8000000000000000), % smallest i64 - ?line enc_dec(11, 16#ffffffffffffffff), % largest u64 - + enc_dec( 2, 0), % SMALL_INTEGER_EXT smallest + enc_dec( 2, 255), % SMALL_INTEGER_EXT largest + enc_dec( 5, 256), % INTEGER_EXT smallest pos (*) + enc_dec( 5, -1), % INTEGER_EXT largest neg + + enc_dec( 5, 16#07ffffff), % INTEGER_EXT largest (28 bits) + enc_dec( 5,-16#08000000), % INTEGER_EXT smallest + enc_dec( 7, 16#08000000), % SMALL_BIG_EXT smallest pos(*) + enc_dec( 7,-16#08000001), % SMALL_BIG_EXT largest neg (*) + + enc_dec( 7, 16#7fffffff), % SMALL_BIG_EXT largest i32 + enc_dec( 7,-16#80000000), % SMALL_BIG_EXT smallest i32 + + enc_dec( 7, 16#80000000), % SMALL_BIG_EXT u32 + enc_dec( 7, 16#ffffffff), % SMALL_BIG_EXT largest u32 + + enc_dec( 9, 16#7fffffffffff), % largest i48 + enc_dec( 9,-16#800000000000), % smallest i48 + enc_dec( 9, 16#ffffffffffff), % largest u48 + enc_dec(11, 16#7fffffffffffffff), % largest i64 + enc_dec(11,-16#8000000000000000), % smallest i64 + enc_dec(11, 16#ffffffffffffffff), % largest u64 ok. @@ -124,213 +98,213 @@ encode_decode_ext(Config) when is_list(Config) -> %% erl_interface, i.e. not how it is encoded in the test case below. decode_integer_ext(Config) when is_list(Config) -> - ?line decode( 0, <<131,98, 0:32>>), % SMALL_INTEGER_EXT - ?line decode( 42, <<131,98, 42:32>>), % SMALL_INTEGER_EXT - ?line decode(255, <<131,98,255:32>>), % SMALL_INTEGER_EXT - ?line decode( 16#08000000, <<131,98, 16#08000000:32>>), % SMALL_BIG_EXT - ?line decode(-16#08000001, <<131,98,-16#08000001:32>>), % SMALL_BIG_EXT - ?line decode( 16#7fffffff, <<131,98, 16#7fffffff:32>>), % SMALL_BIG_EXT - ?line decode(-16#80000000, <<131,98,-16#80000000:32>>), % SMALL_BIG_EXT + decode( 0, <<131,98, 0:32>>), % SMALL_INTEGER_EXT + decode( 42, <<131,98, 42:32>>), % SMALL_INTEGER_EXT + decode(255, <<131,98,255:32>>), % SMALL_INTEGER_EXT + decode( 16#08000000, <<131,98, 16#08000000:32>>), % SMALL_BIG_EXT + decode(-16#08000001, <<131,98,-16#08000001:32>>), % SMALL_BIG_EXT + decode( 16#7fffffff, <<131,98, 16#7fffffff:32>>), % SMALL_BIG_EXT + decode(-16#80000000, <<131,98,-16#80000000:32>>), % SMALL_BIG_EXT ok. decode_small_big_ext(Config) when is_list(Config) -> - ?line decode(256,<<131,110,2,0,0,1>>), % INTEGER_EXT - ?line decode(16#07ffffff,<<131,110,4,0,255,255,255,7>>), % INTEGER_EXT - ?line decode(16#7fffffff,<<131,110,4,0,255,255,255,127>>), % SMALL_BIG_EXT - - ?line decode(42,<<131,110,1,0,42>>), % SMALL_INTEGER_EXT - ?line decode(42,<<131,110,2,0,42,0>>), % Redundant zeros from now on - ?line decode(42,<<131,110,3,0,42,0,0>>), - ?line decode(42,<<131,110,4,0,42,0,0,0>>), - ?line decode(42,<<131,110,5,0,42,0,0,0,0>>), - ?line decode(42,<<131,110,6,0,42,0,0,0,0,0>>), - ?line decode(42,<<131,110,7,0,42,0,0,0,0,0,0>>), - ?line decode(42,<<131,110,8,0,42,0,0,0,0,0,0,0>>), + decode(256,<<131,110,2,0,0,1>>), % INTEGER_EXT + decode(16#07ffffff,<<131,110,4,0,255,255,255,7>>), % INTEGER_EXT + decode(16#7fffffff,<<131,110,4,0,255,255,255,127>>), % SMALL_BIG_EXT + + decode(42,<<131,110,1,0,42>>), % SMALL_INTEGER_EXT + decode(42,<<131,110,2,0,42,0>>), % Redundant zeros from now on + decode(42,<<131,110,3,0,42,0,0>>), + decode(42,<<131,110,4,0,42,0,0,0>>), + decode(42,<<131,110,5,0,42,0,0,0,0>>), + decode(42,<<131,110,6,0,42,0,0,0,0,0>>), + decode(42,<<131,110,7,0,42,0,0,0,0,0,0>>), + decode(42,<<131,110,8,0,42,0,0,0,0,0,0,0>>), ok. decode_large_big_ext(Config) when is_list(Config) -> - ?line decode(256,<<131,111,2:32,0,0,1>>), % INTEGER_EXT - ?line decode(16#07ffffff,<<131,111,4:32,0,255,255,255,7>>), % INTEG_EXT - ?line decode(16#7fffffff,<<131,111,4:32,0,255,255,255,127>>), % SMA_BIG - ?line decode(16#ffffffff,<<131,111,4:32,0,255,255,255,255>>), % SMA_BIG + decode(256,<<131,111,2:32,0,0,1>>), % INTEGER_EXT + decode(16#07ffffff,<<131,111,4:32,0,255,255,255,7>>), % INTEG_EXT + decode(16#7fffffff,<<131,111,4:32,0,255,255,255,127>>), % SMA_BIG + decode(16#ffffffff,<<131,111,4:32,0,255,255,255,255>>), % SMA_BIG N = largest_small_big(), - ?line decode(N,<<131,111,255:32,0,N:2040/little>>), % SMALL_BIG_EXT - - ?line decode(42,<<131,111,1:32,0,42>>), - ?line decode(42,<<131,111,2:32,0,42,0>>), % Redundant zeros from now on - ?line decode(42,<<131,111,3:32,0,42,0,0>>), - ?line decode(42,<<131,111,4:32,0,42,0,0,0>>), - ?line decode(42,<<131,111,5:32,0,42,0,0,0,0>>), - ?line decode(42,<<131,111,6:32,0,42,0,0,0,0,0>>), - ?line decode(42,<<131,111,7:32,0,42,0,0,0,0,0,0>>), - ?line decode(42,<<131,111,8:32,0,42,0,0,0,0,0,0,0>>), + decode(N,<<131,111,255:32,0,N:2040/little>>), % SMALL_BIG_EXT + + decode(42,<<131,111,1:32,0,42>>), + decode(42,<<131,111,2:32,0,42,0>>), % Redundant zeros from now on + decode(42,<<131,111,3:32,0,42,0,0>>), + decode(42,<<131,111,4:32,0,42,0,0,0>>), + decode(42,<<131,111,5:32,0,42,0,0,0,0>>), + decode(42,<<131,111,6:32,0,42,0,0,0,0,0>>), + decode(42,<<131,111,7:32,0,42,0,0,0,0,0,0>>), + decode(42,<<131,111,8:32,0,42,0,0,0,0,0,0,0>>), ok. decode_small_big_ext_neg(Config) when is_list(Config) -> - ?line decode(-1,<<131,110,1,1,1>>), % INTEGER_EXT - ?line decode(-16#08000000,<<131,110,4,1,0,0,0,8>>), % INTEGER_EXT - ?line decode(-16#80000000,<<131,110,4,1,0,0,0,128>>), % SMALL_BIG_EXT - ?line decode(-16#ffffffff,<<131,110,4,1,255,255,255,255>>), % SMALL_BIG_EXT + decode(-1,<<131,110,1,1,1>>), % INTEGER_EXT + decode(-16#08000000,<<131,110,4,1,0,0,0,8>>), % INTEGER_EXT + decode(-16#80000000,<<131,110,4,1,0,0,0,128>>), % SMALL_BIG_EXT + decode(-16#ffffffff,<<131,110,4,1,255,255,255,255>>), % SMALL_BIG_EXT N = largest_small_big(), - ?line decode(-N,<<131,111,255:32,1,N:2040/little>>), % SMALL_BIG_EXT - - ?line decode(-42,<<131,110,1,1,42>>), - ?line decode(-42,<<131,110,2,1,42,0>>), % Redundant zeros from now on - ?line decode(-42,<<131,110,3,1,42,0,0>>), - ?line decode(-42,<<131,110,4,1,42,0,0,0>>), - ?line decode(-42,<<131,110,5,1,42,0,0,0,0>>), - ?line decode(-42,<<131,110,6,1,42,0,0,0,0,0>>), - ?line decode(-42,<<131,110,7,1,42,0,0,0,0,0,0>>), - ?line decode(-42,<<131,110,8,1,42,0,0,0,0,0,0,0>>), + decode(-N,<<131,111,255:32,1,N:2040/little>>), % SMALL_BIG_EXT + + decode(-42,<<131,110,1,1,42>>), + decode(-42,<<131,110,2,1,42,0>>), % Redundant zeros from now on + decode(-42,<<131,110,3,1,42,0,0>>), + decode(-42,<<131,110,4,1,42,0,0,0>>), + decode(-42,<<131,110,5,1,42,0,0,0,0>>), + decode(-42,<<131,110,6,1,42,0,0,0,0,0>>), + decode(-42,<<131,110,7,1,42,0,0,0,0,0,0>>), + decode(-42,<<131,110,8,1,42,0,0,0,0,0,0,0>>), ok. decode_large_big_ext_neg(Config) when is_list(Config) -> - ?line decode(-1,<<131,111,1:32,1,1>>), % INTEGER_EXT - ?line decode(-16#08000000,<<131,111,4:32,1,0,0,0,8>>), % INTEGER_EXT - ?line decode(-16#80000000,<<131,111,4:32,1,0,0,0,128>>), % SMALL_BIG_EXT - - ?line decode(-42,<<131,111,1:32,1,42>>), - ?line decode(-42,<<131,111,2:32,1,42,0>>), % Redundant zeros from now on - ?line decode(-42,<<131,111,3:32,1,42,0,0>>), - ?line decode(-42,<<131,111,4:32,1,42,0,0,0>>), - ?line decode(-42,<<131,111,5:32,1,42,0,0,0,0>>), - ?line decode(-42,<<131,111,6:32,1,42,0,0,0,0,0>>), - ?line decode(-42,<<131,111,7:32,1,42,0,0,0,0,0,0>>), - ?line decode(-42,<<131,111,8:32,1,42,0,0,0,0,0,0,0>>), + decode(-1,<<131,111,1:32,1,1>>), % INTEGER_EXT + decode(-16#08000000,<<131,111,4:32,1,0,0,0,8>>), % INTEGER_EXT + decode(-16#80000000,<<131,111,4:32,1,0,0,0,128>>), % SMALL_BIG_EXT + + decode(-42,<<131,111,1:32,1,42>>), + decode(-42,<<131,111,2:32,1,42,0>>), % Redundant zeros from now on + decode(-42,<<131,111,3:32,1,42,0,0>>), + decode(-42,<<131,111,4:32,1,42,0,0,0>>), + decode(-42,<<131,111,5:32,1,42,0,0,0,0>>), + decode(-42,<<131,111,6:32,1,42,0,0,0,0,0>>), + decode(-42,<<131,111,7:32,1,42,0,0,0,0,0,0>>), + decode(-42,<<131,111,8:32,1,42,0,0,0,0,0,0,0>>), ok. decode_pos_neg_zero(Config) when is_list(Config) -> - ?line decode( 0, <<131,110,0,0>>), % SMALL_BIG_EXT (positive zero) - ?line decode( 0, <<131,110,1,0,0>>), % SMALL_BIG_EXT (positive zero) - ?line decode( 0, <<131,110,0,1>>), % SMALL_BIG_EXT (negative zero) - ?line decode( 0, <<131,110,1,1,0>>), % SMALL_BIG_EXT (negative zero) + decode( 0, <<131,110,0,0>>), % SMALL_BIG_EXT (positive zero) + decode( 0, <<131,110,1,0,0>>), % SMALL_BIG_EXT (positive zero) + decode( 0, <<131,110,0,1>>), % SMALL_BIG_EXT (negative zero) + decode( 0, <<131,110,1,1,0>>), % SMALL_BIG_EXT (negative zero) - ?line decode( 0, <<131,111,0:32,0>>), % SMALL_BIG_EXT (positive zero) - ?line decode( 0, <<131,111,1:32,0,0>>), % SMALL_BIG_EXT (positive zero) - ?line decode( 0, <<131,111,0:32,1>>), % SMALL_BIG_EXT (negative zero) - ?line decode( 0, <<131,111,1:32,1,0>>), % SMALL_BIG_EXT (negative zero) + decode( 0, <<131,111,0:32,0>>), % SMALL_BIG_EXT (positive zero) + decode( 0, <<131,111,1:32,0,0>>), % SMALL_BIG_EXT (positive zero) + decode( 0, <<131,111,0:32,1>>), % SMALL_BIG_EXT (negative zero) + decode( 0, <<131,111,1:32,1,0>>), % SMALL_BIG_EXT (negative zero) N = largest_small_big(), - ?line decode( N,<<131,110,255,0,N:2040/little>>), % largest SMALL_BIG_EXT - ?line decode(-N,<<131,110,255,1,N:2040/little>>), % largest SMALL_BIG_EXT + decode( N,<<131,110,255,0,N:2040/little>>), % largest SMALL_BIG_EXT + decode(-N,<<131,110,255,1,N:2040/little>>), % largest SMALL_BIG_EXT ok. %% Test to decode uncompleted encodings for all in "erl_ext_dist.txt" decode_too_small(Config) when is_list(Config) -> - ?line decode_badarg(<<131, 97>>), - ?line decode_badarg(<<131, 98>>), - ?line decode_badarg(<<131, 98, 0>>), - ?line decode_badarg(<<131, 98, 0, 0>>), - ?line decode_badarg(<<131, 98, 0, 0, 0>>), - ?line decode_badarg(<<131, 99>>), - ?line decode_badarg(<<131, 99, 0>>), - ?line decode_badarg(<<131, 99, 0:240>>), - - ?line decode_badarg(<<131,100>>), - ?line decode_badarg(<<131,100, 1:16/big>>), - ?line decode_badarg(<<131,100, 2:16/big>>), - ?line decode_badarg(<<131,100, 2:16/big, "A">>), + decode_badarg(<<131, 97>>), + decode_badarg(<<131, 98>>), + decode_badarg(<<131, 98, 0>>), + decode_badarg(<<131, 98, 0, 0>>), + decode_badarg(<<131, 98, 0, 0, 0>>), + decode_badarg(<<131, 99>>), + decode_badarg(<<131, 99, 0>>), + decode_badarg(<<131, 99, 0:240>>), + + decode_badarg(<<131,100>>), + decode_badarg(<<131,100, 1:16/big>>), + decode_badarg(<<131,100, 2:16/big>>), + decode_badarg(<<131,100, 2:16/big, "A">>), % FIXME node name "A" seem ok, should it be? -% ?line decode_badarg(<<131,101,100,1:16/big,"A",42:32/big,0>>), - - ?line decode_badarg(<<131,101>>), - ?line decode_badarg(<<131,101,106>>), - ?line decode_badarg(<<131,101,255>>), - ?line decode_badarg(<<131,101,106,42:8/big>>), - ?line decode_badarg(<<131,101,106,42:16/big>>), - ?line decode_badarg(<<131,101,255,42:24/big>>), - ?line decode_badarg(<<131,101,255,42:32/big,0>>), - ?line decode_badarg(<<131,101,100,1:16/big,"A">>), - ?line decode_badarg(<<131,101,100,1:16/big,"A",42:32/big>>), - - ?line decode_badarg(<<131,102>>), - ?line decode_badarg(<<131,102,106,42:32/big,0>>), - ?line decode_badarg(<<131,102,255,42:32/big,0>>), - ?line decode_badarg(<<131,102,100,1:16/big,"A">>), - ?line decode_badarg(<<131,102,100,1:16/big,"A",42:32/big>>), - - ?line decode_badarg(<<131,103>>), - ?line decode_badarg(<<131,103,106,42:32/big,0>>), - ?line decode_badarg(<<131,103,255,42:32/big,0>>), - ?line decode_badarg(<<131,103,100,1:16/big,"A">>), - ?line decode_badarg(<<131,103,100,1:16/big,"A",42:32/big>>), - ?line decode_badarg(<<131,103,100,1:16/big,"A",4:32/big,2:32/big>>), - - ?line decode_badarg(<<131,104>>), - ?line decode_badarg(<<131,104, 1>>), - ?line decode_badarg(<<131,104, 2, 106>>), - ?line decode_badarg(<<131,105, 1:32/big>>), - ?line decode_badarg(<<131,105, 2:32/big, 106>>), - - ?line decode_badarg(<<131,107>>), - ?line decode_badarg(<<131,107, 1:16/big>>), - ?line decode_badarg(<<131,107, 2:16/big>>), - ?line decode_badarg(<<131,107, 2:16/big, "A">>), - - ?line decode_badarg(<<131,108>>), - ?line decode_badarg(<<131,108, 1:32/big>>), - ?line decode_badarg(<<131,108, 2:32/big>>), - ?line decode_badarg(<<131,108, 2:32/big, 106>>), % FIXME don't use NIL - - ?line decode_badarg(<<131,109>>), - ?line decode_badarg(<<131,109, 1:32/big>>), - ?line decode_badarg(<<131,109, 2:32/big>>), - ?line decode_badarg(<<131,109, 2:32/big, 42>>), + % decode_badarg(<<131,101,100,1:16/big,"A",42:32/big,0>>), + + decode_badarg(<<131,101>>), + decode_badarg(<<131,101,106>>), + decode_badarg(<<131,101,255>>), + decode_badarg(<<131,101,106,42:8/big>>), + decode_badarg(<<131,101,106,42:16/big>>), + decode_badarg(<<131,101,255,42:24/big>>), + decode_badarg(<<131,101,255,42:32/big,0>>), + decode_badarg(<<131,101,100,1:16/big,"A">>), + decode_badarg(<<131,101,100,1:16/big,"A",42:32/big>>), + + decode_badarg(<<131,102>>), + decode_badarg(<<131,102,106,42:32/big,0>>), + decode_badarg(<<131,102,255,42:32/big,0>>), + decode_badarg(<<131,102,100,1:16/big,"A">>), + decode_badarg(<<131,102,100,1:16/big,"A",42:32/big>>), + + decode_badarg(<<131,103>>), + decode_badarg(<<131,103,106,42:32/big,0>>), + decode_badarg(<<131,103,255,42:32/big,0>>), + decode_badarg(<<131,103,100,1:16/big,"A">>), + decode_badarg(<<131,103,100,1:16/big,"A",42:32/big>>), + decode_badarg(<<131,103,100,1:16/big,"A",4:32/big,2:32/big>>), + + decode_badarg(<<131,104>>), + decode_badarg(<<131,104, 1>>), + decode_badarg(<<131,104, 2, 106>>), + decode_badarg(<<131,105, 1:32/big>>), + decode_badarg(<<131,105, 2:32/big, 106>>), + + decode_badarg(<<131,107>>), + decode_badarg(<<131,107, 1:16/big>>), + decode_badarg(<<131,107, 2:16/big>>), + decode_badarg(<<131,107, 2:16/big, "A">>), + + decode_badarg(<<131,108>>), + decode_badarg(<<131,108, 1:32/big>>), + decode_badarg(<<131,108, 2:32/big>>), + decode_badarg(<<131,108, 2:32/big, 106>>), % FIXME don't use NIL + + decode_badarg(<<131,109>>), + decode_badarg(<<131,109, 1:32/big>>), + decode_badarg(<<131,109, 2:32/big>>), + decode_badarg(<<131,109, 2:32/big, 42>>), N = largest_small_big(), - ?line decode_badarg(<<131,110>>), - ?line decode_badarg(<<131,110,1>>), - ?line decode_badarg(<<131,110,1,0>>), - ?line decode_badarg(<<131,110,1,1>>), - ?line decode_badarg(<<131,110,2,0,42>>), - ?line decode_badarg(<<131,110,2,1,42>>), - ?line decode_badarg(<<131,110,255,0,N:2032/little>>), - ?line decode_badarg(<<131,110,255,1,N:2032/little>>), - - ?line decode_badarg(<<131,111>>), - ?line decode_badarg(<<131,111, 1:32/big>>), - ?line decode_badarg(<<131,111, 1:32/big,0>>), - ?line decode_badarg(<<131,111, 1:32/big,1>>), - ?line decode_badarg(<<131,111, 2:32/big,0,42>>), - ?line decode_badarg(<<131,111, 2:32/big,1,42>>), - ?line decode_badarg(<<131,111,256:32/big,0,N:2032/little>>), - ?line decode_badarg(<<131,111,256:32/big,1,N:2032/little>>), - ?line decode_badarg(<<131,111,256:32/big,0,N:2040/little>>), - ?line decode_badarg(<<131,111,256:32/big,1,N:2040/little>>), - ?line decode_badarg(<<131,111,257:32/big,0,N:2048/little>>), - ?line decode_badarg(<<131,111,257:32/big,1,N:2048/little>>), + decode_badarg(<<131,110>>), + decode_badarg(<<131,110,1>>), + decode_badarg(<<131,110,1,0>>), + decode_badarg(<<131,110,1,1>>), + decode_badarg(<<131,110,2,0,42>>), + decode_badarg(<<131,110,2,1,42>>), + decode_badarg(<<131,110,255,0,N:2032/little>>), + decode_badarg(<<131,110,255,1,N:2032/little>>), + + decode_badarg(<<131,111>>), + decode_badarg(<<131,111, 1:32/big>>), + decode_badarg(<<131,111, 1:32/big,0>>), + decode_badarg(<<131,111, 1:32/big,1>>), + decode_badarg(<<131,111, 2:32/big,0,42>>), + decode_badarg(<<131,111, 2:32/big,1,42>>), + decode_badarg(<<131,111,256:32/big,0,N:2032/little>>), + decode_badarg(<<131,111,256:32/big,1,N:2032/little>>), + decode_badarg(<<131,111,256:32/big,0,N:2040/little>>), + decode_badarg(<<131,111,256:32/big,1,N:2040/little>>), + decode_badarg(<<131,111,257:32/big,0,N:2048/little>>), + decode_badarg(<<131,111,257:32/big,1,N:2048/little>>), % Emulator dies if trying to create large bignum.... -% ?line decode_badarg(<<131,111,16#ffffffff:32/big,0>>), -% ?line decode_badarg(<<131,111,16#ffffffff:32/big,1>>), - - ?line decode_badarg(<<131, 78>>), - ?line decode_badarg(<<131, 78, 42>>), - ?line decode_badarg(<<131, 78, 42, 1>>), - ?line decode_badarg(<<131, 78, 42, 1:16/big>>), - ?line decode_badarg(<<131, 78, 42, 2:16/big>>), - ?line decode_badarg(<<131, 78, 42, 2:16/big, "A">>), - - ?line decode_badarg(<<131, 67>>), - - ?line decode_badarg(<<131,114>>), - ?line decode_badarg(<<131,114,0>>), - ?line decode_badarg(<<131,114,1:16/big>>), - ?line decode_badarg(<<131,114,1:16/big,100>>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big>>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A">>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0>>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:8>>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:16>>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:24>>), - - ?line decode_badarg(<<131,117>>), % FIXME needs more tests + % decode_badarg(<<131,111,16#ffffffff:32/big,0>>), + % decode_badarg(<<131,111,16#ffffffff:32/big,1>>), + + decode_badarg(<<131, 78>>), + decode_badarg(<<131, 78, 42>>), + decode_badarg(<<131, 78, 42, 1>>), + decode_badarg(<<131, 78, 42, 1:16/big>>), + decode_badarg(<<131, 78, 42, 2:16/big>>), + decode_badarg(<<131, 78, 42, 2:16/big, "A">>), + + decode_badarg(<<131, 67>>), + + decode_badarg(<<131,114>>), + decode_badarg(<<131,114,0>>), + decode_badarg(<<131,114,1:16/big>>), + decode_badarg(<<131,114,1:16/big,100>>), + decode_badarg(<<131,114,1:16/big,100,1:16/big>>), + decode_badarg(<<131,114,1:16/big,100,1:16/big,"A">>), + decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0>>), + decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:8>>), + decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:16>>), + decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:24>>), + + decode_badarg(<<131,117>>), % FIXME needs more tests ok. @@ -379,12 +353,11 @@ my_appender_1(N, T0) -> U = rnd_term(), T = [U|T0], my_appender_1(N-1, T). - + seed() -> - random:seed(3172, 9815, 20129). + rand:seed(exsplus, {3172,9815,20129}). rnd_term() -> - U0 = random:uniform(), + U0 = rand:uniform(), B = <<U0/float>>, {U0,U0 * 2.5 + 3.14,[U0*2.3,B]}. - diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index 09a7a87a9a..be9b63d534 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -1,85 +1,75 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(exception_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - badmatch/1, pending_errors/1, nil_arith/1, +-export([all/0, suite/0, + badmatch/1, pending_errors/1, nil_arith/1, top_of_stacktrace/1, stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1, - exception_with_heap_frag/1, line_numbers/1]). + exception_with_heap_frag/1, line_numbers/1]). -export([bad_guy/2]). -export([crash/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [foreach/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +%% The range analysis of the HiPE compiler results in a system limit error +%% during compilation instead of at runtime, so do not perform this analysis. +-compile([{hipe, [no_icode_range]}]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> - [badmatch, pending_errors, nil_arith, stacktrace, - nested_stacktrace, raise, gunilla, per, + [badmatch, pending_errors, nil_arith, top_of_stacktrace, + stacktrace, nested_stacktrace, raise, gunilla, per, exception_with_heap_frag, line_numbers]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -define(try_match(E), - catch ?MODULE:bar(), - {'EXIT', {{badmatch, nomatch}, _}} = (catch E = id(nomatch))). + catch ?MODULE:bar(), + {'EXIT', {{badmatch, nomatch}, _}} = (catch E = id(nomatch))). %% Test that deliberately bad matches are reported correctly. badmatch(Config) when is_list(Config) -> - ?line ?try_match(a), - ?line ?try_match(42), - ?line ?try_match({a, b, c}), - ?line ?try_match([]), - ?line ?try_match(1.0), + ?try_match(a), + ?try_match(42), + ?try_match({a, b, c}), + ?try_match([]), + ?try_match(1.0), ok. %% Test various exceptions, in the presence of a previous error suppressed %% in a guard. pending_errors(Config) when is_list(Config) -> - ?line pending(e_badmatch, {badmatch, b}), - ?line pending(x, function_clause), - ?line pending(e_case, {case_clause, xxx}), - ?line pending(e_if, if_clause), - ?line pending(e_badarith, badarith), - ?line pending(e_undef, undef), - ?line pending(e_timeoutval, timeout_value), - ?line pending(e_badarg, badarg), - ?line pending(e_badarg_spawn, badarg), + pending(e_badmatch, {badmatch, b}), + pending(x, function_clause), + pending(e_case, {case_clause, xxx}), + pending(e_if, if_clause), + pending(e_badarith, badarith), + pending(e_undef, undef), + pending(e_timeoutval, timeout_value), + pending(e_badarg, badarg), + pending(e_badarg_spawn, badarg), ok. bad_guy(pe_badarith, Other) when Other+1 == 0 -> % badarith (suppressed) @@ -88,11 +78,11 @@ bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed) ok; bad_guy(_, e_case) -> case id(xxx) of - ok -> ok + ok -> ok end; % case_clause bad_guy(_, e_if) -> if - a == b -> ok + a == b -> ok end; % if_clause bad_guy(_, e_badarith) -> 1+b; % badarith @@ -100,9 +90,9 @@ bad_guy(_, e_undef) -> non_existing_module:foo(); % undef bad_guy(_, e_timeoutval) -> receive - after arne -> % timeout_value - ok - end; + after arne -> % timeout_value + ok + end; bad_guy(_, e_badarg) -> node(xxx); % badarg bad_guy(_, e_badarg_spawn) -> @@ -121,30 +111,30 @@ pending(First, Second, Expected) -> pending_catched(First, Second, Expected) -> ok = io:format("Catching bad_guy(~p, ~p)", [First, Second]), case catch bad_guy(First, Second) of - {'EXIT', Reason} -> - pending(Reason, bad_guy, [First, Second], Expected); - Other -> - test_server:fail({not_exit, Other}) + {'EXIT', Reason} -> + pending(Reason, bad_guy, [First, Second], Expected); + Other -> + ct:fail({not_exit, Other}) end. pending_exit_message(Args, Expected) -> ok = io:format("Trapping EXITs from spawn_link(~p, ~p, ~p)", - [?MODULE, bad_guy, Args]), + [?MODULE, bad_guy, Args]), process_flag(trap_exit, true), Pid = spawn_link(?MODULE, bad_guy, Args), receive - {'EXIT', Pid, Reason} -> - pending(Reason, bad_guy, Args, Expected); - Other -> - test_server:fail({unexpected_message, Other}) + {'EXIT', Pid, Reason} -> + pending(Reason, bad_guy, Args, Expected); + Other -> + ct:fail({unexpected_message, Other}) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, process_flag(trap_exit, false). pending({badarg,[{erlang,Bif,BifArgs,Loc1}, - {?MODULE,Func,Arity,Loc2}|_]}, - Func, Args, _Code) + {?MODULE,Func,Arity,Loc2}|_]}, + Func, Args, _Code) when is_atom(Bif), is_list(BifArgs), length(Args) =:= Arity, is_list(Loc1), is_list(Loc2) -> ok; @@ -158,67 +148,67 @@ pending({Code,[{?MODULE,Func,Arity,Loc}|_]}, Func, Args, Code) when length(Args) =:= Arity, is_list(Loc) -> ok; pending(Reason, _Function, _Args, _Code) -> - test_server:fail({bad_exit_reason,Reason}). + ct:fail({bad_exit_reason,Reason}). %% Test that doing arithmetics on [] gives a badarith EXIT and not a crash. nil_arith(Config) when is_list(Config) -> - ?line ba_plus_minus_times([], []), - - ?line ba_plus_minus_times([], 0), - ?line ba_plus_minus_times([], 42), - ?line ba_plus_minus_times([], 38724978123478923784), - ?line ba_plus_minus_times([], 38.72), - - ?line ba_plus_minus_times(0, []), - ?line ba_plus_minus_times(334, []), - ?line ba_plus_minus_times(387249797813478923784, []), - ?line ba_plus_minus_times(344.22, []), - - ?line ba_div_rem([], []), - - ?line ba_div_rem([], 0), - ?line ba_div_rem([], 1), - ?line ba_div_rem([], 42), - ?line ba_div_rem([], 38724978123478923784), - ?line ba_div_rem(344.22, []), - - ?line ba_div_rem(0, []), - ?line ba_div_rem(1, []), - ?line ba_div_rem(334, []), - ?line ba_div_rem(387249797813478923784, []), - ?line ba_div_rem(344.22, []), - - ?line ba_div_rem(344.22, 0.0), - ?line ba_div_rem(1, 0.0), - ?line ba_div_rem(392873498733971, 0.0), - - ?line ba_bop([], []), - ?line ba_bop(0, []), - ?line ba_bop(42, []), - ?line ba_bop(-42342742987343, []), - ?line ba_bop(238.342, []), - ?line ba_bop([], 0), - ?line ba_bop([], -243), - ?line ba_bop([], 243), - ?line ba_bop([], 2438724982478933), - ?line ba_bop([], 3987.37), - - ?line ba_bnot([]), - ?line ba_bnot(23.33), - - ?line ba_shift([], []), - ?line ba_shift([], 0), - ?line ba_shift([], 4), - ?line ba_shift([], -4), - ?line ba_shift([], 2343333333333), - ?line ba_shift([], -333333333), - ?line ba_shift([], 234.00), - ?line ba_shift(23, []), - ?line ba_shift(0, []), - ?line ba_shift(-3433443433433323, []), - ?line ba_shift(433443433433323, []), - ?line ba_shift(343.93, []), + ba_plus_minus_times([], []), + + ba_plus_minus_times([], 0), + ba_plus_minus_times([], 42), + ba_plus_minus_times([], 38724978123478923784), + ba_plus_minus_times([], 38.72), + + ba_plus_minus_times(0, []), + ba_plus_minus_times(334, []), + ba_plus_minus_times(387249797813478923784, []), + ba_plus_minus_times(344.22, []), + + ba_div_rem([], []), + + ba_div_rem([], 0), + ba_div_rem([], 1), + ba_div_rem([], 42), + ba_div_rem([], 38724978123478923784), + ba_div_rem(344.22, []), + + ba_div_rem(0, []), + ba_div_rem(1, []), + ba_div_rem(334, []), + ba_div_rem(387249797813478923784, []), + ba_div_rem(344.22, []), + + ba_div_rem(344.22, 0.0), + ba_div_rem(1, 0.0), + ba_div_rem(392873498733971, 0.0), + + ba_bop([], []), + ba_bop(0, []), + ba_bop(42, []), + ba_bop(-42342742987343, []), + ba_bop(238.342, []), + ba_bop([], 0), + ba_bop([], -243), + ba_bop([], 243), + ba_bop([], 2438724982478933), + ba_bop([], 3987.37), + + ba_bnot([]), + ba_bnot(23.33), + + ba_shift([], []), + ba_shift([], 0), + ba_shift([], 4), + ba_shift([], -4), + ba_shift([], 2343333333333), + ba_shift([], -333333333), + ba_shift([], 234.00), + ba_shift(23, []), + ba_shift(0, []), + ba_shift(-3433443433433323, []), + ba_shift(433443433433323, []), + ba_shift(343.93, []), ok. ba_plus_minus_times(A, B) -> @@ -250,47 +240,94 @@ ba_shift(A, B) -> {'EXIT', {badarith, _}} = (catch A bsl B), io:format("~p bsr ~p", [A, B]), {'EXIT', {badarith, _}} = (catch A bsr B). - + ba_bnot(A) -> io:format("bnot ~p", [A]), {'EXIT', {badarith, _}} = (catch bnot A). +%% Test that BIFs are added to the top of the stacktrace. + +top_of_stacktrace(Conf) when is_list(Conf) -> + %% Arithmetic operators + {'EXIT', {badarith, [{erlang, '+', [1, ok], _} | _]}} = (catch my_add(1, ok)), + {'EXIT', {badarith, [{erlang, '-', [1, ok], _} | _]}} = (catch my_minus(1, ok)), + {'EXIT', {badarith, [{erlang, '*', [1, ok], _} | _]}} = (catch my_times(1, ok)), + {'EXIT', {badarith, [{erlang, 'div', [1, ok], _} | _]}} = (catch my_div(1, ok)), + {'EXIT', {badarith, [{erlang, 'div', [1, 0], _} | _]}} = (catch my_div(1, 0)), + {'EXIT', {badarith, [{erlang, 'rem', [1, ok], _} | _]}} = (catch my_rem(1, ok)), + {'EXIT', {badarith, [{erlang, 'rem', [1, 0], _} | _]}} = (catch my_rem(1, 0)), + + %% Bit operators + {'EXIT', {badarith, [{erlang, 'band', [1, ok], _} | _]}} = (catch my_band(1, ok)), + {'EXIT', {badarith, [{erlang, 'bor', [1, ok], _} | _]}} = (catch my_bor(1, ok)), + {'EXIT', {badarith, [{erlang, 'bsl', [1, ok], _} | _]}} = (catch my_bsl(1, ok)), + {'EXIT', {badarith, [{erlang, 'bsr', [1, ok], _} | _]}} = (catch my_bsr(1, ok)), + {'EXIT', {badarith, [{erlang, 'bxor', [1, ok], _} | _]}} = (catch my_bxor(1, ok)), + {'EXIT', {badarith, [{erlang, 'bnot', [ok], _} | _]}} = (catch my_bnot(ok)), + + %% Tuples + {'EXIT', {badarg, [{erlang, element, [1, ok], _} | _]}} = (catch my_element(1, ok)), + {'EXIT', {badarg, [{erlang, element, [ok, {}], _} | _]}} = (catch my_element(ok, {})), + {'EXIT', {badarg, [{erlang, element, [1, {}], _} | _]}} = (catch my_element(1, {})), + {'EXIT', {badarg, [{erlang, element, [1, {}], _} | _]}} = (catch element(1, erlang:make_tuple(0, ok))), + + %% System limits + Maxbig = maxbig(), + MinusMaxbig = -Maxbig, + {'EXIT', {system_limit, [{erlang, '+', [Maxbig, 1], _} | _]}} = (catch my_add(Maxbig, 1)), + {'EXIT', {system_limit, [{erlang, '+', [Maxbig, 1], _} | _]}} = (catch my_add(maxbig_gc(), 1)), + {'EXIT', {system_limit, [{erlang, '-', [MinusMaxbig, 1], _} | _]}} = (catch my_minus(-Maxbig, 1)), + {'EXIT', {system_limit, [{erlang, '-', [MinusMaxbig, 1], _} | _]}} = (catch my_minus(-maxbig_gc(), 1)), + {'EXIT', {system_limit, [{erlang, '*', [Maxbig, 2], _} | _]}} = (catch my_times(Maxbig, 2)), + {'EXIT', {system_limit, [{erlang, '*', [Maxbig, 2], _} | _]}} = (catch my_times(maxbig_gc(), 2)), + {'EXIT', {system_limit, [{erlang, 'bnot', [Maxbig], _} | _]}} = (catch my_bnot(Maxbig)), + {'EXIT', {system_limit, [{erlang, 'bnot', [Maxbig], _} | _]}} = (catch my_bnot(maxbig_gc())), + ok. + +maxbig() -> + %% We assume that the maximum arity is (1 bsl 19) - 1. + Ws = erlang:system_info(wordsize), + (((1 bsl ((16777184 * (Ws div 4))-1)) - 1) bsl 1) + 1. +maxbig_gc() -> + Maxbig = maxbig(), + erlang:garbage_collect(), + Maxbig. stacktrace(Conf) when is_list(Conf) -> Tag = make_ref(), - ?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), - ?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, + {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), + {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, V = [make_ref()|self()], - ?line {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = - stacktrace_1({'abs',V}, error, {value,V}), - ?line St1 = erase(stacktrace1), - ?line St1 = erase(stacktrace2), - ?line St1 = erlang:get_stacktrace(), - ?line {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = - stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), - ?line [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), - ?line St2 = erase(stacktrace2), - ?line St2 = erlang:get_stacktrace(), - ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = - stacktrace_1({value,V}, error, {value,V}), - ?line St3 = erase(stacktrace1), - ?line St3 = erase(stacktrace2), - ?line St3 = erlang:get_stacktrace(), - ?line {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = - stacktrace_1({value,V}, error, {throw,V}), - ?line [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), - ?line St4 = erase(stacktrace2), - ?line St4 = erlang:get_stacktrace(), + {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = + stacktrace_1({'abs',V}, error, {value,V}), + St1 = erase(stacktrace1), + St1 = erase(stacktrace2), + St1 = erlang:get_stacktrace(), + {caught2,{error,badarith},[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]=St2} = + stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), + [{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_] = erase(stacktrace1), + St2 = erase(stacktrace2), + St2 = erlang:get_stacktrace(), + {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = + stacktrace_1({value,V}, error, {value,V}), + St3 = erase(stacktrace1), + St3 = erase(stacktrace2), + St3 = erlang:get_stacktrace(), + {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = + stacktrace_1({value,V}, error, {throw,V}), + [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), + St4 = erase(stacktrace2), + St4 = erlang:get_stacktrace(), try - ?line stacktrace_2() + stacktrace_2() catch - error:{badmatch,_} -> - [{?MODULE,stacktrace_2,0,_}, - {?MODULE,stacktrace,1,_}|_] = - erlang:get_stacktrace(), - ok + error:{badmatch,_} -> + [{?MODULE,stacktrace_2,0,_}, + {?MODULE,stacktrace,1,_}|_] = + erlang:get_stacktrace(), + ok end. stacktrace_1(X, C1, Y) -> @@ -302,7 +339,7 @@ stacktrace_1(X, C1, Y) -> C1:D1 -> {caught1,D1,erlang:get_stacktrace()} after put(stacktrace1, erlang:get_stacktrace()), - foo(Y) + foo(Y) end of V2 -> {value2,V2} catch @@ -318,21 +355,21 @@ stacktrace_2() -> nested_stacktrace(Conf) when is_list(Conf) -> V = [{make_ref()}|[self()]], - ?line value1 = - nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, - {void,void,void}), - ?line {caught1, - [{?MODULE,my_add,2,_}|_], - value2, - [{?MODULE,my_add,2,_}|_]} = - nested_stacktrace_1({{'add',{V,x1}},error,badarith}, - {{value,{V,x2}},void,{V,x2}}), - ?line {caught1, - [{?MODULE,my_add,2,_}|_], - {caught2,[{erlang,abs,[V],_}|_]}, - [{erlang,abs,[V],_}|_]} = - nested_stacktrace_1({{'add',{V,x1}},error,badarith}, - {{'abs',V},error,badarg}), + value1 = + nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, + {void,void,void}), + {caught1, + [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_], + value2, + [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_]} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{value,{V,x2}},void,{V,x2}}), + {caught1, + [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_], + {caught2,[{erlang,abs,[V],_}|_]}, + [{erlang,abs,[V],_}|_]} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{'abs',V},error,badarg}), ok. nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> @@ -340,64 +377,64 @@ nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> V1 -> value1 catch C1:V1 -> - S1 = erlang:get_stacktrace(), + S1 = erlang:get_stacktrace(), T2 = - try foo(X2) of - V2 -> value2 - catch - C2:V2 -> {caught2,erlang:get_stacktrace()} - end, + try foo(X2) of + V2 -> value2 + catch + C2:V2 -> {caught2,erlang:get_stacktrace()} + end, {caught1,S1,T2,erlang:get_stacktrace()} end. raise(Conf) when is_list(Conf) -> - ?line erase(raise), - ?line A = - try - ?line try foo({'div',{1,0}}) - catch - error:badarith -> - put(raise, A0 = erlang:get_stacktrace()), - ?line erlang:raise(error, badarith, A0) - end - catch - error:badarith -> - ?line A1 = erlang:get_stacktrace(), - ?line A1 = get(raise) - end, - ?line A = erlang:get_stacktrace(), - ?line A = get(raise), - ?line [{?MODULE,my_div,2,_}|_] = A, + erase(raise), + A = + try + try foo({'div',{1,0}}) + catch + error:badarith -> + put(raise, A0 = erlang:get_stacktrace()), + erlang:raise(error, badarith, A0) + end + catch + error:badarith -> + A1 = erlang:get_stacktrace(), + A1 = get(raise) + end, + A = erlang:get_stacktrace(), + A = get(raise), + [{erlang,'div',[1, 0], _},{?MODULE,my_div,2,_}|_] = A, %% N = 8, % Must be even - ?line N = erlang:system_flag(backtrace_depth, N), - ?line B = odd_even(N, []), - ?line try even(N) - catch error:function_clause -> ok - end, - ?line B = erlang:get_stacktrace(), + N = erlang:system_flag(backtrace_depth, N), + B = odd_even(N, []), + try even(N) + catch error:function_clause -> ok + end, + B = erlang:get_stacktrace(), %% - ?line C0 = odd_even(N+1, []), - ?line C = lists:sublist(C0, N), - ?line try odd(N+1) - catch error:function_clause -> ok - end, - ?line C = erlang:get_stacktrace(), - ?line try erlang:raise(error, function_clause, C0) - catch error:function_clause -> ok - end, - ?line C = erlang:get_stacktrace(), + C0 = odd_even(N+1, []), + C = lists:sublist(C0, N), + try odd(N+1) + catch error:function_clause -> ok + end, + C = erlang:get_stacktrace(), + try erlang:raise(error, function_clause, C0) + catch error:function_clause -> ok + end, + C = erlang:get_stacktrace(), ok. odd_even(N, R) when is_integer(N), N > 1 -> odd_even(N-1, - [if (N rem 2) == 0 -> - {?MODULE,even,1,[{file,"odd_even.erl"},{line,3}]}; - true -> - {?MODULE,odd,1,[{file,"odd_even.erl"},{line,6}]} - end|R]); + [if (N rem 2) == 0 -> + {?MODULE,even,1,[{file,"odd_even.erl"},{line,3}]}; + true -> + {?MODULE,odd,1,[{file,"odd_even.erl"},{line,6}]} + end|R]); odd_even(1, R) -> [{?MODULE,odd,[1],[{file,"odd_even.erl"},{line,5}]}|R]. @@ -418,27 +455,36 @@ foo({raise,{Class,Reason,Stacktrace}}) -> erlang:raise(Class, Reason, Stacktrace). %%foo(function_clause) -> % must not be defined! -my_div(A, B) -> - A div B. +my_add(A, B) -> A + B. +my_minus(A, B) -> A - B. +my_times(A, B) -> A * B. +my_div(A, B) -> A div B. +my_rem(A, B) -> A rem B. -my_add(A, B) -> - A + B. +my_band(A, B) -> A band B. +my_bor(A, B) -> A bor B. +my_bsl(A, B) -> A bsl B. +my_bsr(A, B) -> A bsr B. +my_bxor(A, B) -> A bxor B. +my_bnot(A) -> bnot A. + +my_element(A, B) -> element(A, B). my_abs(X) -> abs(X). gunilla(Config) when is_list(Config) -> - ?line {throw,kalle} = gunilla_1(), - ?line [] = erlang:get_stacktrace(), + {throw,kalle} = gunilla_1(), + [] = erlang:get_stacktrace(), ok. gunilla_1() -> try try arne() - after - pelle - end + after + pelle + end catch - C:R -> - {C,R} + C:R -> + {C,R} end. arne() -> @@ -447,18 +493,18 @@ arne() -> per(Config) when is_list(Config) -> try - t1(0,pad,0), - t2(0,pad,0) + t1(0,pad,0), + t2(0,pad,0) catch - error:badarith -> - ok + error:badarith -> + ok end. t1(_,X,_) -> - (1 bsl X) + 1. + (1 bsl X) + 1. t2(_,X,_) -> - (X bsl 1) + 1. + (X bsl 1) + 1. %% %% Make sure that even if a BIF builds an heap fragment, then causes an exception, @@ -470,155 +516,164 @@ exception_with_heap_frag(Config) when is_list(Config) -> %% Floats are only validated when the heap fragment has been allocated. BadFloat = <<131,99,53,46,48,$X,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,101,45,48,49,0,0,0,0,0>>, - ?line do_exception_with_heap_frag(BadFloat, Sizes), + do_exception_with_heap_frag(BadFloat, Sizes), %% {Binary,BadFloat}: When the error in float is discovered, a refc-binary %% has been allocated and the list of refc-binaries goes through the %% heap fragment. BinAndFloat = - <<131,104,2,109,0,0,1,0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, - 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45, - 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70, - 71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95, - 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115, - 116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134, - 135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153, - 154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172, - 173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191, - 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210, - 211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229, - 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248, - 249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48, - 48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>, - ?line do_exception_with_heap_frag(BinAndFloat, Sizes), + <<131,104,2,109,0,0,1,0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, + 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45, + 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70, + 71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95, + 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115, + 116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134, + 135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153, + 154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172, + 173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191, + 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210, + 211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229, + 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248, + 249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48, + 48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>, + do_exception_with_heap_frag(BinAndFloat, Sizes), %% {Fun,BadFloat} FunAndFloat = - <<131,104,2,112,0,0,0,66,0,238,239,135,138,137,216,89,57,22,111,52,126,16,84, - 71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111, - 110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48, - $Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>, - ?line do_exception_with_heap_frag(FunAndFloat, Sizes), + <<131,104,2,112,0,0,0,66,0,238,239,135,138,137,216,89,57,22,111,52,126,16,84, + 71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111, + 110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48, + $Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>, + do_exception_with_heap_frag(FunAndFloat, Sizes), %% [ExternalPid|BadFloat] ExtPidAndFloat = - <<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101, - 114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48, - 48,48,48,48,48,101,43,48,48,0,0,0,0,0>>, - ?line do_exception_with_heap_frag(ExtPidAndFloat, Sizes), - + <<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101, + 114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48, + 48,48,48,48,48,101,43,48,48,0,0,0,0,0>>, + do_exception_with_heap_frag(ExtPidAndFloat, Sizes), + ok. do_exception_with_heap_frag(Bin, [Sz|Sizes]) -> Filler = erlang:make_tuple(Sz, a), spawn(fun() -> - try - binary_to_term(Bin) - catch - _:_ -> - %% term_to_binary/1 is an easy way to traverse the - %% entire stacktrace term to make sure that every part - %% of it is OK. - term_to_binary(erlang:get_stacktrace()) - end, - id(Filler) - end), + try + binary_to_term(Bin) + catch + _:_ -> + %% term_to_binary/1 is an easy way to traverse the + %% entire stacktrace term to make sure that every part + %% of it is OK. + term_to_binary(erlang:get_stacktrace()) + end, + id(Filler) + end), do_exception_with_heap_frag(Bin, Sizes); do_exception_with_heap_frag(_, []) -> ok. line_numbers(Config) when is_list(Config) -> {'EXIT',{{case_clause,bad_tag}, - [{?MODULE,line1,2, - [{file,"fake_file.erl"},{line,3}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch line1(bad_tag, 0)), + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,3}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(bad_tag, 0)), {'EXIT',{badarith, - [{?MODULE,line1,2, - [{file,"fake_file.erl"},{line,5}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch line1(a, not_an_integer)), + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,5}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, not_an_integer)), {'EXIT',{{badmatch,{ok,1}}, - [{?MODULE,line1,2, - [{file,"fake_file.erl"},{line,7}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch line1(a, 0)), + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,7}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 0)), {'EXIT',{crash, - [{?MODULE,crash,1, - [{file,"fake_file.erl"},{line,14}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch line1(a, 41)), + [{?MODULE,crash,1, + [{file,"fake_file.erl"},{line,14}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 41)), ModFile = ?MODULE_STRING++".erl", [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, {?MODULE,call1,0,[{file,"call.erl"},{line,14}]}, {?MODULE,close_calls,1,[{file,"call.erl"},{line,5}]}, {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = - close_calls(call1), + close_calls(call1), [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, {?MODULE,call2,0,[{file,"call.erl"},{line,18}]}, {?MODULE,close_calls,1,[{file,"call.erl"},{line,6}]}, {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = - close_calls(call2), + close_calls(call2), [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, {?MODULE,call3,0,[{file,"call.erl"},{line,22}]}, {?MODULE,close_calls,1,[{file,"call.erl"},{line,7}]}, {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = - close_calls(call3), + close_calls(call3), no_crash = close_calls(other), <<0,0>> = build_binary1(16), {'EXIT',{badarg, - [{?MODULE,build_binary1,1, - [{file,"bit_syntax.erl"},{line,72503}]}, - {?MODULE,line_numbers,1, - [{file,ModFile},{line,_}]}|_]}} = - (catch build_binary1(bad_size)), + [{?MODULE,build_binary1,1, + [{file,"bit_syntax.erl"},{line,72503}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary1(bad_size)), <<7,1,2,3>> = build_binary2(8, <<1,2,3>>), {'EXIT',{badarg, - [{?MODULE,build_binary2,2, - [{file,"bit_syntax.erl"},{line,72507}]}, - {?MODULE,line_numbers,1, - [{file,ModFile},{line,_}]}|_]}} = - (catch build_binary2(bad_size, <<>>)), + [{?MODULE,build_binary2,2, + [{file,"bit_syntax.erl"},{line,72507}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(bad_size, <<>>)), {'EXIT',{badarg, - [{erlang,bit_size,[bad_binary],[]}, - {?MODULE,build_binary2,2, - [{file,"bit_syntax.erl"},{line,72507}]}, - {?MODULE,line_numbers,1, - [{file,ModFile},{line,_}]}|_]}} = - (catch build_binary2(8, bad_binary)), + [{erlang,bit_size,[bad_binary],[]}, + {?MODULE,build_binary2,2, + [{file,"bit_syntax.erl"},{line,72507}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(8, bad_binary)), <<"abc",357:16>> = build_binary3(<<"abc">>), {'EXIT',{badarg,[{?MODULE,build_binary3,1, - [{file,"bit_syntax.erl"},{line,72511}]}, - {?MODULE,line_numbers,1, - [{file,ModFile},{line,_}]}|_]}} = - (catch build_binary3(no_binary)), + [{file,"bit_syntax.erl"},{line,72511}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary3(no_binary)), {'EXIT',{function_clause, - [{?MODULE,do_call_abs,[y,y], - [{file,"gc_bif.erl"},{line,18}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch do_call_abs(y, y)), + [{?MODULE,do_call_abs,[y,y], + [{file,"gc_bif.erl"},{line,18}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(y, y)), {'EXIT',{badarg, - [{erlang,abs,[[]],[]}, - {?MODULE,do_call_abs,2, - [{file,"gc_bif.erl"},{line,19}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch do_call_abs(x, [])), + [{erlang,abs,[[]],[]}, + {?MODULE,do_call_abs,2, + [{file,"gc_bif.erl"},{line,19}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(x, [])), {'EXIT',{{badmatch,"42"}, - [{MODULE,applied_bif_1,1,[{file,"applied_bif.erl"},{line,5}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch applied_bif_1(42)), + [{MODULE,applied_bif_1,1,[{file,"applied_bif.erl"},{line,5}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch applied_bif_1(42)), {'EXIT',{{badmatch,{current_location, - {?MODULE,applied_bif_2,0, - [{file,"applied_bif.erl"},{line,9}]}}}, - [{MODULE,applied_bif_2,0,[{file,"applied_bif.erl"},{line,10}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch applied_bif_2()), + {?MODULE,applied_bif_2,0, + [{file,"applied_bif.erl"},{line,9}]}}}, + [{MODULE,applied_bif_2,0,[{file,"applied_bif.erl"},{line,10}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch applied_bif_2()), + + {'EXIT',{badarith, + [{?MODULE,increment1,1,[{file,"increment.erl"},{line,45}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch increment1(x)), + {'EXIT',{badarith, + [{?MODULE,increment2,1,[{file,"increment.erl"},{line,48}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch increment2(x)), ok. @@ -645,13 +700,13 @@ odd(N) when is_integer(N), N > 1, (N rem 2) == 1 -> -file("fake_file.erl", 1). %Line 1 line1(Tag, X) -> %Line 2 case Tag of %Line 3 - a -> - Y = X + 1, %Line 5 - Res = id({ok,Y}), %Line 6 - ?MODULE:crash({ok,42} = Res); %Line 7 - b -> - x = id(x), %Line 9 - ok %Line 10 + a -> + Y = X + 1, %Line 5 + Res = id({ok,Y}), %Line 6 + ?MODULE:crash({ok,42} = Res); %Line 7 + b -> + x = id(x), %Line 9 + ok %Line 10 end. %Line 11 crash(_) -> %Line 13 @@ -661,12 +716,12 @@ crash(_) -> %Line 13 close_calls(Where) -> %Line 2 put(where_to_crash, Where), %Line 3 try - call1(), %Line 5 - call2(), %Line 6 - call3(), %Line 7 - no_crash %Line 8 + call1(), %Line 5 + call2(), %Line 6 + call3(), %Line 7 + no_crash %Line 8 catch error:crash -> - erlang:get_stacktrace() %Line 10 + erlang:get_stacktrace() %Line 10 end. %Line 11 call1() -> %Line 13 @@ -683,10 +738,10 @@ call3() -> %Line 21 maybe_crash(Name) -> %Line 25 case get(where_to_crash) of %Line 26 - Name -> - erlang:error(crash); %Line 28 - _ -> - ok %Line 30 + Name -> + erlang:error(crash); %Line 28 + _ -> + ok %Line 30 end. -file("bit_syntax.erl", 72500). %Line 72500 @@ -720,3 +775,15 @@ applied_bif_2() -> %Line 8 R = process_info(self(), current_location), %Line 9 fail = R, %Line 10 ok. %Line 11 + +%% The increment instruction used to decrement the instruction +%% pointer, which would cause the line number in a stack trace to +%% be the previous line number. + +-file("increment.erl", 42). +increment1(Arg) -> %Line 43 + Res = id(Arg), %Line 44 + Res + 1. %Line 45 +increment2(Arg) -> %Line 46 + _ = id(Arg), %Line 47 + Arg + 1. %Line 48 diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index 4a45afa9e9..4098aa9c6a 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -1,81 +1,59 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(float_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, - bad_float_unpack/1, write/1, cmp_zero/1, cmp_integer/1, cmp_bignum/1]). +-export([all/0, suite/0, groups/0, + fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, + t_mul_add_ops/1, + bad_float_unpack/1, write/1, cmp_zero/1, cmp_integer/1, cmp_bignum/1]). -export([otp_7178/1]). -export([hidden_inf/1]). +-export([arith/1]). - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(3)), - [{watchdog, Dog},{testcase,Func}|Config]. - -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized, match, bad_float_unpack, write, {group, comparison} ,hidden_inf - ]. + ,arith, t_mul_add_ops]. groups() -> [{comparison, [parallel], [cmp_zero, cmp_integer, cmp_bignum]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - %% %% OTP-7178, list_to_float on very small numbers should give 0.0 %% instead of exception, i.e. ignore underflow. %% -otp_7178(suite) -> - []; -otp_7178(doc) -> - ["test that list_to_float on very small numbers give 0.0"]; +%% test that list_to_float on very small numbers give 0.0 otp_7178(Config) when is_list(Config) -> - ?line X = list_to_float("1.0e-325"), - ?line true = (X < 0.00000001) and (X > -0.00000001), - ?line Y = list_to_float("1.0e-325325325"), - ?line true = (Y < 0.00000001) and (Y > -0.00000001), - ?line {'EXIT', {badarg,_}} = (catch list_to_float("1.0e83291083210")), + X = list_to_float("1.0e-325"), + true = (X < 0.00000001) and (X > -0.00000001), + Y = list_to_float("1.0e-325325325"), + true = (Y < 0.00000001) and (Y > -0.00000001), + {'EXIT', {badarg,_}} = (catch list_to_float("1.0e83291083210")), ok. %% Forces floating point exceptions and tests that subsequent, legal, @@ -83,15 +61,15 @@ otp_7178(Config) when is_list(Config) -> %% Strollo. fpe(Config) when is_list(Config) -> - ?line 0.0 = math:log(1.0), - ?line {'EXIT', {badarith, _}} = (catch math:log(-1.0)), - ?line 0.0 = math:log(1.0), - ?line {'EXIT', {badarith, _}} = (catch math:log(0.0)), - ?line 0.0 = math:log(1.0), - ?line {'EXIT',{badarith,_}} = (catch 3.23e133 * id(3.57e257)), - ?line 0.0 = math:log(1.0), - ?line {'EXIT',{badarith,_}} = (catch 5.0/id(0.0)), - ?line 0.0 = math:log(1.0), + 0.0 = math:log(1.0), + {'EXIT', {badarith, _}} = (catch math:log(-1.0)), + 0.0 = math:log(1.0), + {'EXIT', {badarith, _}} = (catch math:log(0.0)), + 0.0 = math:log(1.0), + {'EXIT',{badarith,_}} = (catch 3.23e133 * id(3.57e257)), + 0.0 = math:log(1.0), + {'EXIT',{badarith,_}} = (catch 5.0/id(0.0)), + 0.0 = math:log(1.0), ok. @@ -99,70 +77,70 @@ fpe(Config) when is_list(Config) -> -define(ERTS_FP_THREAD_TEST, 1). fp_drv(Config) when is_list(Config) -> - fp_drv_test(?ERTS_FP_CONTROL_TEST, ?config(data_dir, Config)). + fp_drv_test(?ERTS_FP_CONTROL_TEST, proplists:get_value(data_dir, Config)). fp_drv_thread(Config) when is_list(Config) -> %% Run in a separate node since it used to crash the emulator... - ?line Parent = self(), - ?line DrvDir = ?config(data_dir, Config), - ?line {ok,Node} = start_node(Config), - ?line Tester = spawn_link(Node, - fun () -> - Parent ! - {self(), - fp_drv_test(?ERTS_FP_THREAD_TEST, - DrvDir)} - end), - ?line Result = receive {Tester, Res} -> Res end, - ?line stop_node(Node), - ?line Result. + Parent = self(), + DrvDir = proplists:get_value(data_dir, Config), + {ok,Node} = start_node(Config), + Tester = spawn_link(Node, + fun () -> + Parent ! + {self(), + fp_drv_test(?ERTS_FP_THREAD_TEST, + DrvDir)} + end), + Result = receive {Tester, Res} -> Res end, + stop_node(Node), + Result. fp_drv_test(Test, DrvDir) -> - ?line Drv = fp_drv, - ?line try - begin - ?line case erl_ddll:load_driver(DrvDir, Drv) of - ok -> - ok; - {error, permanent} -> - ok; - {error, LoadError} -> - exit({load_error, - erl_ddll:format_error(LoadError)}); - LoadError -> - exit({load_error, LoadError}) - end, - case open_port({spawn, Drv}, []) of - Port when is_port(Port) -> - try port_control(Port, Test, "") of - "ok" -> - 0.0 = math:log(1.0), - ok; - [$s,$k,$i,$p,$:,$ | Reason] -> - {skipped, Reason}; - Error -> - exit(Error) - after - Port ! {self(), close}, - receive {Port, closed} -> ok end, - false = lists:member(Port, erlang:ports()), - ok - end; - Error -> - exit({open_port_failed, Error}) - end - end - catch - throw:Term -> ?line Term - after - erl_ddll:unload_driver(Drv) - end. + Drv = fp_drv, + try + begin + case erl_ddll:load_driver(DrvDir, Drv) of + ok -> + ok; + {error, permanent} -> + ok; + {error, LoadError} -> + exit({load_error, + erl_ddll:format_error(LoadError)}); + LoadError -> + exit({load_error, LoadError}) + end, + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + try port_control(Port, Test, "") of + "ok" -> + 0.0 = math:log(1.0), + ok; + [$s,$k,$i,$p,$:,$ | Reason] -> + {skipped, Reason}; + Error -> + exit(Error) + after + Port ! {self(), close}, + receive {Port, closed} -> ok end, + false = lists:member(Port, erlang:ports()), + ok + end; + Error -> + exit({open_port_failed, Error}) + end + end + catch + throw:Term -> Term + after + erl_ddll:unload_driver(Drv) + end. denormalized(Config) when is_list(Config) -> - ?line Denormalized = 1.0e-307 / 1000, - ?line roundtrip(Denormalized), - ?line NegDenormalized = -1.0e-307 / 1000, - ?line roundtrip(NegDenormalized), + Denormalized = 1.0e-307 / 1000, + roundtrip(Denormalized), + NegDenormalized = -1.0e-307 / 1000, + roundtrip(NegDenormalized), ok. roundtrip(N) -> @@ -170,12 +148,12 @@ roundtrip(N) -> N = binary_to_term(term_to_binary(N, [{minor_version,1}])). match(Config) when is_list(Config) -> - ?line one = match_1(1.0), - ?line two = match_1(2.0), - ?line a_lot = match_1(1000.0), - ?line {'EXIT',_} = (catch match_1(0.5)), + one = match_1(1.0), + two = match_1(2.0), + a_lot = match_1(1000.0), + {'EXIT',_} = (catch match_1(0.5)), ok. - + match_1(1.0) -> one; match_1(2.0) -> two; match_1(1000.0) -> a_lot. @@ -183,8 +161,8 @@ match_1(1000.0) -> a_lot. %% Thanks to Per Gustafsson. bad_float_unpack(Config) when is_list(Config) -> - ?line Bin = <<-1:64>>, - ?line -1 = bad_float_unpack_match(Bin), + Bin = <<-1:64>>, + -1 = bad_float_unpack_match(Bin), ok. bad_float_unpack_match(<<F:64/float>>) -> F; @@ -230,84 +208,81 @@ span_cmp(Axis, Incr, Length) -> %% for both negative and positive numbers. %% %% Axis: The number around which to do the tests eg. (1 bsl 58) - 1.0 -%% Incr: How much to increment the test numbers inbetween each test. +%% Incr: How much to increment the test numbers in-between each test. %% Length: Length/2 is the number of Incr away from Axis to test on the %% negative and positive plane. %% Diff: How much the float and int should differ when comparing span_cmp(Axis, Incr, Length, Diff) -> [begin - cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), - cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr) + cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), + cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr) end || I <- lists:seq((Length div 2)*-1,(Length div 2))], [begin - cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr), - cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr) + cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr), + cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr) end || I <- lists:seq((Length div 2)*-1,(Length div 2))]. cmp(Big,Small) when is_float(Big) -> BigGtSmall = lists:flatten( - io_lib:format("~f > ~p",[Big,Small])), + io_lib:format("~f > ~p",[Big,Small])), BigLtSmall = lists:flatten( - io_lib:format("~f < ~p",[Big,Small])), + io_lib:format("~f < ~p",[Big,Small])), BigEqSmall = lists:flatten( - io_lib:format("~f == ~p",[Big,Small])), + io_lib:format("~f == ~p",[Big,Small])), SmallGtBig = lists:flatten( - io_lib:format("~p > ~f",[Small,Big])), + io_lib:format("~p > ~f",[Small,Big])), SmallLtBig = lists:flatten( - io_lib:format("~p < ~f",[Small,Big])), + io_lib:format("~p < ~f",[Small,Big])), SmallEqBig = lists:flatten( - io_lib:format("~p == ~f",[Small,Big])), + io_lib:format("~p == ~f",[Small,Big])), cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, - SmallEqBig,BigEqSmall); + SmallEqBig,BigEqSmall); cmp(Big,Small) when is_float(Small) -> BigGtSmall = lists:flatten( - io_lib:format("~p > ~f",[Big,Small])), + io_lib:format("~p > ~f",[Big,Small])), BigLtSmall = lists:flatten( - io_lib:format("~p < ~f",[Big,Small])), + io_lib:format("~p < ~f",[Big,Small])), BigEqSmall = lists:flatten( - io_lib:format("~p == ~f",[Big,Small])), + io_lib:format("~p == ~f",[Big,Small])), SmallGtBig = lists:flatten( - io_lib:format("~f > ~p",[Small,Big])), + io_lib:format("~f > ~p",[Small,Big])), SmallLtBig = lists:flatten( - io_lib:format("~f < ~p",[Small,Big])), + io_lib:format("~f < ~p",[Small,Big])), SmallEqBig = lists:flatten( - io_lib:format("~f == ~p",[Small,Big])), + io_lib:format("~f == ~p",[Small,Big])), cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, - SmallEqBig,BigEqSmall). + SmallEqBig,BigEqSmall). cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, SmallEqBig,BigEqSmall) -> {_,_,_,true} = {Big,Small,BigGtSmall, - Big > Small}, + Big > Small}, {_,_,_,false} = {Big,Small,BigLtSmall, - Big < Small}, + Big < Small}, {_,_,_,false} = {Big,Small,SmallGtBig, - Small > Big}, + Small > Big}, {_,_,_,true} = {Big,Small,SmallLtBig, - Small < Big}, + Small < Big}, {_,_,_,false} = {Big,Small,SmallEqBig, - Small == Big}, + Small == Big}, {_,_,_,false} = {Big,Small,BigEqSmall, - Big == Small}. + Big == Small}. id(I) -> I. - + start_node(Config) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), - ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). %% Test that operations that might hide infinite intermediate results @@ -317,8 +292,8 @@ hidden_inf(Config) when is_list(Config) -> ZeroN = id(ZeroP) * (-1), [hidden_inf_1(A, B, Z, 9.23e307) || A <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], - B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], - Z <- [ZeroP, ZeroN]], + B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], + Z <- [ZeroP, ZeroN]], ok. hidden_inf_1(A, B, Zero, Huge) -> @@ -330,3 +305,122 @@ hidden_inf_1(A, B, Zero, Huge) -> {'EXIT',{badarith,_}} = (catch (B * (Huge + Huge))), {'EXIT',{badarith,_}} = (catch (B / (-Huge - Huge))), {'EXIT',{badarith,_}} = (catch (B * (-Huge - Huge))). + +%% Improve code coverage in our different arithmetic functions +%% and make sure they yield consistent results. +arith(_Config) -> + _TAG_IMMED1_SIZE = 4, + + <<FLOAT_MAX/float>> = <<0:1, 16#7fe:11, -1:52>>, + <<FLOAT_MIN/float>> = <<0:1, 0:11, 1:52>>, + <<FloatNegZero/float>> = <<1:1, 0:11, 0:52>>, + + WORD_BITS = erlang:system_info(wordsize) * 8, + SMALL_BITS = (WORD_BITS - _TAG_IMMED1_SIZE), + SMALL_MAX = (1 bsl (SMALL_BITS-1)) - 1, + SMALL_MIN = -(1 bsl (SMALL_BITS-1)), + BIG1_MAX = (1 bsl WORD_BITS) - 1, + BIG2_MAX = (1 bsl (WORD_BITS*2)) - 1, + + fixnum = erts_internal:term_type(SMALL_MAX), + fixnum = erts_internal:term_type(SMALL_MIN), + bignum = erts_internal:term_type(SMALL_MAX + 1), + bignum = erts_internal:term_type(SMALL_MIN - 1), + + L = [0, 0.0, FloatNegZero, 1, 1.0, 17, 17.0, 0.17, + FLOAT_MIN, FLOAT_MAX, + SMALL_MAX, SMALL_MAX+1, + SMALL_MIN, SMALL_MIN-1, + BIG1_MAX, BIG1_MAX+1, + BIG2_MAX, BIG2_MAX+1, + trunc(FLOAT_MAX), trunc(FLOAT_MAX)+1, trunc(FLOAT_MAX)*2, + immed_badarg, + "list badarg", + {"boxed badarg"}], + + foreach_pair(fun(A,B) -> do_bin_ops(A,B) end, L). + +foreach_pair(F, L) -> + lists:foreach( + fun(A) -> lists:foreach(fun(B) -> F(A,B) end, L) end, + L). + +do_bin_ops(A, B) -> + Fun = fun(Op) -> + Op(A,B), + is_number(A) andalso Op(-A,B), + is_number(B) andalso Op(A,-B), + is_number(A) andalso is_number(B) andalso Op(-A,-B) + end, + lists:foreach(Fun, + [fun op_add/2, fun op_sub/2, fun op_mul/2, fun op_div/2]). + +op_add(A, B) -> + Info = [A,B], + R = unify(catch A + B, Info), + R = unify(my_apply(erlang,'+',[A,B]), Info), + case R of + _ when A + B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_sub(A, B) -> + Info = [A,B], + R = unify(catch A - B, Info), + R = unify(my_apply(erlang,'-',[A,B]), Info), + case R of + _ when A - B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_mul(A, B) -> + Info = [A,B], + R = unify(catch A * B, Info), + R = unify(my_apply(erlang,'*',[A,B]), Info), + case R of + _ when A * B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_div(A, B) -> + Info = [A,B], + R = unify(catch A / B, Info), + R = unify(my_apply(erlang,'/',[A,B]), Info), + case R of + _ when A / B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +my_apply(M, F, A) -> + catch apply(id(M), id(F), A). + +% Unify exceptions be removing stack traces. +% and add argument info to make it easer to debug failed matches. +unify({'EXIT',{Reason,_Stack}}, Info) -> + {{'EXIT', Reason}, Info}; +unify(Other, Info) -> + {Other, Info}. + + +-define(epsilon, 1.0e-20). +check_epsilon(R,Val) -> + if erlang:abs(R-Val) < ?epsilon -> ok; + true -> ct:fail({R,Val}) + end. + +t_mul_add_ops(Config) when is_list(Config) -> + check_epsilon(op_mul_add(1, 2.0, 1.0, 0.0), 1.0), + check_epsilon(op_mul_add(2, 2.0, 1.0, 0.0), 3.0), + check_epsilon(op_mul_add(3, 2.0, 1.0, 0.0), 7.0), + check_epsilon(op_mul_add(4, 2.0, 1.0, 0.0), 15.0), + check_epsilon(op_mul_add(5, 2.0, 1.0, 0.0), 31.0), + check_epsilon(op_mul_add(6, 2.0, 1.0, 0.0), 63.0), + check_epsilon(op_mul_add(6, 2.0, 1.3, 0.0), 81.9), + check_epsilon(op_mul_add(6, 2.03, 1.3, 0.0), 87.06260151458997), + ok. + + +op_mul_add(0, _, _, R) -> R; +op_mul_add(N, A, B, R) when is_float(A), is_float(B), is_float(R) -> + op_mul_add(N - 1, A, B, R * A + B). + diff --git a/erts/emulator/test/float_SUITE_data/fp_drv.c b/erts/emulator/test/float_SUITE_data/fp_drv.c index b80385c3f9..a91d622040 100644 --- a/erts/emulator/test/float_SUITE_data/fp_drv.c +++ b/erts/emulator/test/float_SUITE_data/fp_drv.c @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson AB. Portions * created by Ericsson are Copyright 2008, Ericsson AB. All Rights @@ -17,6 +18,7 @@ */ #if defined(DEBUG) || 0 +# include <stdio.h> # define PRINTF(X) printf X #else # define PRINTF(X) @@ -29,9 +31,14 @@ #if defined (__GNUC__) int _finite(double x); #endif -#ifndef finite -#define finite _finite +#ifndef isfinite +#define isfinite _finite #endif +#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE) +/* If not windows and we do not have isfinite */ +#define isfinite finite +#elif !defined(HAVE_ISFINITE) +# error "No finite function found!" #endif #include "erl_driver.h" @@ -79,21 +86,21 @@ do_test(void *unused) x = 3.23e133; y = 3.57e257; z = x*y; - if (finite(z)) + if (isfinite(z)) return "is finite (1)"; x = 5.0; y = 0.0; z = x/y; - if (finite(z)) + if (isfinite(z)) return "is finite (2)"; z = log(-1.0); - if (finite(z)) + if (isfinite(z)) return "is finite (3)"; z = log(0.0); - if (finite(z)) + if (isfinite(z)) return "is finite (4)"; return "ok"; diff --git a/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl b/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl index 31af2b2698..26837de274 100644 --- a/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl +++ b/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index 8ad5f290ed..7d29ebec52 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -1,88 +1,63 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(fun_SUITE). --compile({nowarn_deprecated_function, {erlang,hash,2}}). - --define(default_timeout, ?t:minutes(1)). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, +-export([all/0, suite/0, bad_apply/1,bad_fun_call/1,badarity/1,ext_badarity/1, + bad_arglist/1, equality/1,ordering/1, - fun_to_port/1,t_hash/1,t_phash/1,t_phash2/1,md5/1, + fun_to_port/1,t_phash/1,t_phash2/1,md5/1, refc/1,refc_ets/1,refc_dist/1, const_propagation/1,t_arity/1,t_is_function2/1, - t_fun_info/1]). + t_fun_info/1,t_fun_info_mfa/1]). -export([nothing/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. -suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [bad_apply, bad_fun_call, badarity, ext_badarity, - equality, ordering, fun_to_port, t_hash, t_phash, + bad_arglist, + equality, ordering, fun_to_port, t_phash, t_phash2, md5, refc, refc_ets, refc_dist, - const_propagation, t_arity, t_is_function2, t_fun_info]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. + const_propagation, t_arity, t_is_function2, t_fun_info, + t_fun_info_mfa]. -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - -bad_apply(doc) -> - "Test that the correct EXIT code is returned for all types of bad funs."; -bad_apply(suite) -> []; +%% Test that the correct EXIT code is returned for all types of bad funs. bad_apply(Config) when is_list(Config) -> - ?line bad_apply_fc(42, [0]), - ?line bad_apply_fc(xx, [1]), - ?line bad_apply_fc({}, [2]), - ?line bad_apply_fc({1}, [3]), - ?line bad_apply_fc({1,2,3}, [4]), - ?line bad_apply_fc({1,2,3}, [5]), - ?line bad_apply_fc({1,2,3,4}, [6]), - ?line bad_apply_fc({1,2,3,4,5,6}, [7]), - ?line bad_apply_fc({1,2,3,4,5}, [8]), - ?line bad_apply_badarg({1,2}, [9]), + bad_apply_fc(42, [0]), + bad_apply_fc(xx, [1]), + bad_apply_fc({}, [2]), + bad_apply_fc({1}, [3]), + bad_apply_fc({1,2,3}, [4]), + bad_apply_fc({1,2,3}, [5]), + bad_apply_fc({1,2,3,4}, [6]), + bad_apply_fc({1,2,3,4,5,6}, [7]), + bad_apply_fc({1,2,3,4,5}, [8]), + bad_apply_badarg({1,2}, [9]), ok. bad_apply_fc(Fun, Args) -> @@ -94,7 +69,7 @@ bad_apply_fc(Fun, Args) -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]); Other -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]), - ?t:fail({bad_result,Other}) + ct:fail({bad_result,Other}) end. bad_apply_badarg(Fun, Args) -> @@ -106,23 +81,21 @@ bad_apply_badarg(Fun, Args) -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]); Other -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]), - ?t:fail({bad_result, Other}) + ct:fail({bad_result, Other}) end. -bad_fun_call(doc) -> - "Try directly calling bad funs."; -bad_fun_call(suite) -> []; +%% Try directly calling bad funs. bad_fun_call(Config) when is_list(Config) -> - ?line bad_call_fc(42), - ?line bad_call_fc(xx), - ?line bad_call_fc({}), - ?line bad_call_fc({1}), - ?line bad_call_fc({1,2,3}), - ?line bad_call_fc({1,2,3}), - ?line bad_call_fc({1,2,3,4}), - ?line bad_call_fc({1,2,3,4,5,6}), - ?line bad_call_fc({1,2,3,4,5}), - ?line bad_call_fc({1,2}), + bad_call_fc(42), + bad_call_fc(xx), + bad_call_fc({}), + bad_call_fc({1}), + bad_call_fc({1,2,3}), + bad_call_fc({1,2,3}), + bad_call_fc({1,2,3,4}), + bad_call_fc({1,2,3,4,5,6}), + bad_call_fc({1,2,3,4,5}), + bad_call_fc({1,2}), ok. bad_call_fc(Fun) -> @@ -133,74 +106,86 @@ bad_call_fc(Fun) -> ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); Other -> ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), - ?t:fail({bad_result,Other}) + ct:fail({bad_result,Other}) end. +% Test erlang:apply with non-proper arg-list +bad_arglist(Config) when is_list(Config) -> + Fun = fun(A,B) -> A+B end, + {'EXIT', {badarg,_}} = (catch apply(Fun, 17)), + {'EXIT', {badarg,_}} = (catch apply(Fun, [17|18])), + {'EXIT', {badarg,_}} = (catch apply(Fun, [17,18|19])), + {'EXIT', {badarg,_}} = (catch apply(lists,seq, 17)), + {'EXIT', {badarg,_}} = (catch apply(lists,seq, [17|18])), + {'EXIT', {badarg,_}} = (catch apply(lists,seq, [17,18|19])), + ok. + + %% Call and apply valid funs with wrong number of arguments. badarity(Config) when is_list(Config) -> - ?line Fun = fun() -> ok end, - ?line Stupid = {stupid,arguments}, - ?line Args = [some,{stupid,arguments},here], + Fun = fun() -> ok end, + Stupid = {stupid,arguments}, + Args = [some,{stupid,arguments},here], %% Simple call. - ?line Res = (catch Fun(some, Stupid, here)), + Res = (catch Fun(some, Stupid, here)), erlang:garbage_collect(), erlang:yield(), case Res of {'EXIT',{{badarity,{Fun,Args}},_}} -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); _ -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), - ?line ?t:fail({bad_result,Res}) + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), + ct:fail({bad_result,Res}) end, %% Apply. - ?line Res2 = (catch apply(Fun, Args)), + Res2 = (catch apply(Fun, Args)), erlang:garbage_collect(), erlang:yield(), case Res2 of {'EXIT',{{badarity,{Fun,Args}},_}} -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); _ -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), - ?line ?t:fail({bad_result,Res2}) + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), + ct:fail({bad_result,Res2}) end, ok. %% Call and apply valid external funs with wrong number of arguments. ext_badarity(Config) when is_list(Config) -> - ?line Fun = fun ?MODULE:nothing/0, - ?line Stupid = {stupid,arguments}, - ?line Args = [some,{stupid,arguments},here], + Fun = fun ?MODULE:nothing/0, + Stupid = {stupid,arguments}, + Args = [some,{stupid,arguments},here], %% Simple call. - ?line Res = (catch Fun(some, Stupid, here)), + Res = (catch Fun(some, Stupid, here)), erlang:garbage_collect(), erlang:yield(), case Res of {'EXIT',{{badarity,{Fun,Args}},_}} -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); _ -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), - ?line ?t:fail({bad_result,Res}) + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), + ct:fail({bad_result,Res}) end, %% Apply. - ?line Res2 = (catch apply(Fun, Args)), + Res2 = (catch apply(Fun, Args)), erlang:garbage_collect(), erlang:yield(), case Res2 of {'EXIT',{{badarity,{Fun,Args}},_}} -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); _ -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), - ?line ?t:fail({bad_result,Res2}) + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), + ct:fail({bad_result,Res2}) end, ok. @@ -212,29 +197,29 @@ nothing() -> equality(Config) when is_list(Config) -> F0 = fun() -> 1 end, F0_copy = copy_term(F0), - ?line true = eq(F0, F0), - ?line true = eq(F0, F0_copy), + true = eq(F0, F0), + true = eq(F0, F0_copy), %% Compare different arities. F1 = fun(X) -> X + 1 end, - ?line true = eq(F1, F1), - ?line false = eq(F0, F1), - ?line false = eq(F0_copy, F1), + true = eq(F1, F1), + false = eq(F0, F1), + false = eq(F0_copy, F1), %% Compare different environments. G1 = make_fun(1), G2 = make_fun(2), - ?line true = eq(G1, G1), - ?line true = eq(G2, G2), - ?line false = eq(G1, G2), - ?line false = eq(G2, G1), + true = eq(G1, G1), + true = eq(G2, G2), + false = eq(G1, G2), + false = eq(G2, G1), G1_copy = copy_term(G1), - ?line true = eq(G1, G1_copy), + true = eq(G1, G1_copy), %% Compare fun with binaries. B = list_to_binary([7,8,9]), - ?line false = eq(B, G1), - ?line false = eq(G1, B), + false = eq(B, G1), + false = eq(G1, B), %% Compare external funs. FF0 = fun aa:blurf/0, @@ -244,23 +229,23 @@ equality(Config) when is_list(Config) -> FF3 = fun erlang:exit/2, FF4 = fun z:ff/0, - ?line true = eq(FF0, FF0), - ?line true = eq(FF0, FF0_copy), - ?line true = eq(FF1, FF1), - ?line true = eq(FF2, FF2), - ?line true = eq(FF3, FF3), - ?line true = eq(FF4, FF4), - ?line false = eq(FF0, FF1), - ?line false = eq(FF0, FF2), - ?line false = eq(FF0, FF3), - ?line false = eq(FF0, FF4), - ?line false = eq(FF1, FF0), - ?line false = eq(FF1, FF2), - ?line false = eq(FF1, FF3), - ?line false = eq(FF1, FF4), - ?line false = eq(FF2, FF3), - ?line false = eq(FF2, FF4), - ?line false = eq(FF3, FF4), + true = eq(FF0, FF0), + true = eq(FF0, FF0_copy), + true = eq(FF1, FF1), + true = eq(FF2, FF2), + true = eq(FF3, FF3), + true = eq(FF4, FF4), + false = eq(FF0, FF1), + false = eq(FF0, FF2), + false = eq(FF0, FF3), + false = eq(FF0, FF4), + false = eq(FF1, FF0), + false = eq(FF1, FF2), + false = eq(FF1, FF3), + false = eq(FF1, FF4), + false = eq(FF2, FF3), + false = eq(FF2, FF4), + false = eq(FF3, FF4), %% EEP37 H1 = fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end, @@ -283,7 +268,7 @@ copy_term(Term) -> make_fun(X) -> fun() -> X end. -ordering(doc) -> "Tests ordering of funs."; +%% Tests ordering of funs. ordering(Config) when is_list(Config) -> F1 = make_fun(1, 2), F1_copy = copy_term(F1), @@ -296,140 +281,139 @@ ordering(Config) when is_list(Config) -> FF3 = fun erlang:exit/2, FF4 = fun z:ff/0, - ?line true = FF0 < FF1, - ?line true = FF1 < FF2, - ?line true = FF2 < FF3, - ?line true = FF3 < FF4, + true = FF0 < FF1, + true = FF1 < FF2, + true = FF2 < FF3, + true = FF3 < FF4, - ?line true = FF0 > F1, - ?line true = FF0 > F2, - ?line true = FF0 > F3, - ?line true = FF4 > F1, - ?line true = FF4 > F2, - ?line true = FF4 > F3, + true = FF0 > F1, + true = FF0 > F2, + true = FF0 > F3, + true = FF4 > F1, + true = FF4 > F2, + true = FF4 > F3, - ?line true = F1 == F1, - ?line true = F1 == F1_copy, - ?line true = F1 /= F2, + true = F1 == F1, + true = F1 == F1_copy, + true = F1 /= F2, - ?line true = F1 < F2, - ?line true = F2 > F1, - ?line true = F2 < F3, - ?line true = F3 > F2, + true = F1 < F2, + true = F2 > F1, + true = F2 < F3, + true = F3 > F2, - ?line false = F1 > F2, - ?line false = F2 > F3, + false = F1 > F2, + false = F2 > F3, %% Compare with binaries. B = list_to_binary([7,8,9,10]), - ?line false = B == F1, - ?line false = F1 == B, + false = B == F1, + false = F1 == B, - ?line true = F1 < B, - ?line true = B > F2, + true = F1 < B, + true = B > F2, - ?line false = F1 > B, - ?line false = B < F2, + false = F1 > B, + false = B < F2, - ?line false = F1 >= B, - ?line false = B =< F2, + false = F1 >= B, + false = B =< F2, %% Compare module funs with binaries. - ?line false = B == FF1, - ?line false = FF1 == B, + false = B == FF1, + false = FF1 == B, - ?line true = FF1 < B, - ?line true = B > FF2, + true = FF1 < B, + true = B > FF2, - ?line false = FF1 > B, - ?line false = B < FF2, + false = FF1 > B, + false = B < FF2, - ?line false = FF1 >= B, - ?line false = B =< FF2, + false = FF1 >= B, + false = B =< FF2, %% Create a port and ref. - ?line Path = ?config(priv_dir, Config), - ?line AFile = filename:join(Path, "vanilla_file"), - ?line P = open_port(AFile, [out]), - ?line R = make_ref(), + Path = proplists:get_value(priv_dir, Config), + AFile = filename:join(Path, "vanilla_file"), + P = open_port(AFile, [out]), + R = make_ref(), %% Compare funs with ports and refs. - ?line true = R < F3, - ?line true = F3 > R, - ?line true = F3 < P, - ?line true = P > F3, + true = R < F3, + true = F3 > R, + true = F3 < P, + true = P > F3, - ?line true = R =< F3, - ?line true = F3 >= R, - ?line true = F3 =< P, - ?line true = P >= F3, + true = R =< F3, + true = F3 >= R, + true = F3 =< P, + true = P >= F3, - ?line false = R > F3, - ?line false = F3 < R, - ?line false = F3 > P, - ?line false = P < F3, + false = R > F3, + false = F3 < R, + false = F3 > P, + false = P < F3, %% Compare funs with conses and nils. - ?line true = F1 < [a], - ?line true = F1 < [], - ?line true = [a,b] > F1, - ?line true = [] > F1, + true = F1 < [a], + true = F1 < [], + true = [a,b] > F1, + true = [] > F1, - ?line false = [1] < F1, - ?line false = [] < F1, - ?line false = F1 > [2], - ?line false = F1 > [], + false = [1] < F1, + false = [] < F1, + false = F1 > [2], + false = F1 > [], - ?line false = [1] =< F1, - ?line false = [] =< F1, - ?line false = F1 >= [2], - ?line false = F1 >= [], + false = [1] =< F1, + false = [] =< F1, + false = F1 >= [2], + false = F1 >= [], %% Compare module funs with conses and nils. - ?line true = FF1 < [a], - ?line true = FF1 < [], - ?line true = [a,b] > FF1, - ?line true = [] > FF1, + true = FF1 < [a], + true = FF1 < [], + true = [a,b] > FF1, + true = [] > FF1, - ?line false = [1] < FF1, - ?line false = [] < FF1, - ?line false = FF1 > [2], - ?line false = FF1 > [], + false = [1] < FF1, + false = [] < FF1, + false = FF1 > [2], + false = FF1 > [], - ?line false = [1] =< FF1, - ?line false = [] =< FF1, - ?line false = FF1 >= [2], - ?line false = FF1 >= [], + false = [1] =< FF1, + false = [] =< FF1, + false = FF1 >= [2], + false = FF1 >= [], ok. make_fun(X, Y) -> fun(A) -> A*X+Y end. -fun_to_port(doc) -> "Try sending funs to ports (should fail)."; -fun_to_port(suite) -> []; +%% Try sending funs to ports (should fail). fun_to_port(Config) when is_list(Config) -> - ?line fun_to_port(Config, xxx), - ?line fun_to_port(Config, fun() -> 42 end), - ?line fun_to_port(Config, [fun() -> 43 end]), - ?line fun_to_port(Config, [1,fun() -> 44 end]), - ?line fun_to_port(Config, [0,1|fun() -> 45 end]), + fun_to_port(Config, xxx), + fun_to_port(Config, fun() -> 42 end), + fun_to_port(Config, [fun() -> 43 end]), + fun_to_port(Config, [1,fun() -> 44 end]), + fun_to_port(Config, [0,1|fun() -> 45 end]), B64K = build_io_list(65536), - ?line fun_to_port(Config, [B64K,fun() -> 45 end]), - ?line fun_to_port(Config, [B64K|fun() -> 45 end]), + fun_to_port(Config, [B64K,fun() -> 45 end]), + fun_to_port(Config, [B64K|fun() -> 45 end]), ok. fun_to_port(Config, IoList) -> - Path = ?config(priv_dir, Config), + Path = proplists:get_value(priv_dir, Config), AFile = filename:join(Path, "vanilla_file"), Port = open_port(AFile, [out]), case catch port_command(Port, IoList) of {'EXIT',{badarg,_}} -> ok; - Other -> ?t:fail({unexpected_retval,Other}) + Other -> ct:fail({unexpected_retval,Other}) end. build_io_list(0) -> []; @@ -441,86 +425,55 @@ build_io_list(N) -> 1 -> [7,L|L] end. -t_hash(doc) -> "Test the hash/2 BIF on funs."; -t_hash(suite) -> []; -t_hash(Config) when is_list(Config) -> - F1 = fun(_X) -> 1 end, - F2 = fun(_X) -> 2 end, - ?line true = hash(F1) /= hash(F2), - - G1 = make_fun(1, 2, 3), - G2 = make_fun(1, 2, 3), - G3 = make_fun(1, 2, 4), - ?line true = hash(G1) == hash(G2), - ?line true = hash(G2) /= hash(G3), - - FF0 = fun erlang:abs/1, - FF1 = fun erlang:exit/1, - FF2 = fun erlang:exit/2, - FF3 = fun blurf:exit/2, - ?line true = hash(FF0) =/= hash(FF1), - ?line true = hash(FF0) =/= hash(FF2), - ?line true = hash(FF0) =/= hash(FF3), - ?line true = hash(FF1) =/= hash(FF2), - ?line true = hash(FF1) =/= hash(FF3), - ?line true = hash(FF2) =/= hash(FF3), - ok. - -hash(Term) -> - erlang:hash(Term, 16#7ffffff). - -t_phash(doc) -> "Test the phash/2 BIF on funs."; -t_phash(suite) -> []; +%% Test the phash/2 BIF on funs. t_phash(Config) when is_list(Config) -> F1 = fun(_X) -> 1 end, F2 = fun(_X) -> 2 end, - ?line true = phash(F1) /= phash(F2), + true = phash(F1) /= phash(F2), G1 = make_fun(1, 2, 3), G2 = make_fun(1, 2, 3), G3 = make_fun(1, 2, 4), - ?line true = phash(G1) == phash(G2), - ?line true = phash(G2) /= phash(G3), + true = phash(G1) == phash(G2), + true = phash(G2) /= phash(G3), FF0 = fun erlang:abs/1, FF1 = fun erlang:exit/1, FF2 = fun erlang:exit/2, FF3 = fun blurf:exit/2, - ?line true = phash(FF0) =/= phash(FF1), - ?line true = phash(FF0) =/= phash(FF2), - ?line true = phash(FF0) =/= phash(FF3), - ?line true = phash(FF1) =/= phash(FF2), - ?line true = phash(FF1) =/= phash(FF3), - ?line true = phash(FF2) =/= phash(FF3), - + true = phash(FF0) =/= phash(FF1), + true = phash(FF0) =/= phash(FF2), + true = phash(FF0) =/= phash(FF3), + true = phash(FF1) =/= phash(FF2), + true = phash(FF1) =/= phash(FF3), + true = phash(FF2) =/= phash(FF3), ok. phash(Term) -> erlang:phash(Term, 16#7ffffff). -t_phash2(doc) -> "Test the phash2/2 BIF on funs."; -t_phash2(suite) -> []; +%% Test the phash2/2 BIF on funs. t_phash2(Config) when is_list(Config) -> F1 = fun(_X) -> 1 end, F2 = fun(_X) -> 2 end, - ?line true = phash2(F1) /= phash2(F2), + true = phash2(F1) /= phash2(F2), G1 = make_fun(1, 2, 3), G2 = make_fun(1, 2, 3), G3 = make_fun(1, 2, 4), - ?line true = phash2(G1) == phash2(G2), - ?line true = phash2(G2) /= phash2(G3), + true = phash2(G1) == phash2(G2), + true = phash2(G2) /= phash2(G3), FF0 = fun erlang:abs/1, FF1 = fun erlang:exit/1, FF2 = fun erlang:exit/2, FF3 = fun blurf:exit/2, - ?line true = phash2(FF0) =/= phash2(FF1), - ?line true = phash2(FF0) =/= phash2(FF2), - ?line true = phash2(FF0) =/= phash2(FF3), - ?line true = phash2(FF1) =/= phash2(FF2), - ?line true = phash2(FF1) =/= phash2(FF3), - ?line true = phash2(FF2) =/= phash2(FF3), + true = phash2(FF0) =/= phash2(FF1), + true = phash2(FF0) =/= phash2(FF2), + true = phash2(FF0) =/= phash2(FF3), + true = phash2(FF1) =/= phash2(FF2), + true = phash2(FF1) =/= phash2(FF3), + true = phash2(FF2) =/= phash2(FF3), ok. @@ -530,52 +483,51 @@ phash2(Term) -> make_fun(X, Y, Z) -> fun() -> {X,Y,Z} end. -md5(doc) -> "Test that MD5 bifs reject funs properly."; -md5(suite) -> []; +%% Test that MD5 bifs reject funs properly. md5(Config) when is_list(Config) -> _ = size(erlang:md5_init()), %% Try funs in the i/o list. - ?line bad_md5(fun(_X) -> 42 end), - ?line bad_md5([fun(_X) -> 43 end]), - ?line bad_md5([1,fun(_X) -> 44 end]), - ?line bad_md5([1|fun(_X) -> 45 end]), - ?line B64K = build_io_list(65536), - ?line bad_md5([B64K,fun(_X) -> 46 end]), - ?line bad_md5([B64K|fun(_X) -> 46 end]), + bad_md5(fun(_X) -> 42 end), + bad_md5([fun(_X) -> 43 end]), + bad_md5([1,fun(_X) -> 44 end]), + bad_md5([1|fun(_X) -> 45 end]), + B64K = build_io_list(65536), + bad_md5([B64K,fun(_X) -> 46 end]), + bad_md5([B64K|fun(_X) -> 46 end]), ok. bad_md5(Bad) -> {'EXIT',{badarg,_}} = (catch erlang:md5(Bad)). refc(Config) when is_list(Config) -> - ?line F1 = fun_factory(2), - ?line {refc,2} = erlang:fun_info(F1, refc), - ?line F2 = fun_factory(42), - ?line {refc,3} = erlang:fun_info(F1, refc), + F1 = fun_factory(2), + {refc,2} = erlang:fun_info(F1, refc), + F2 = fun_factory(42), + {refc,3} = erlang:fun_info(F1, refc), - ?line process_flag(trap_exit, true), - ?line Pid = spawn_link(fun() -> {refc,4} = erlang:fun_info(F1, refc) end), + process_flag(trap_exit, true), + Pid = spawn_link(fun() -> {refc,4} = erlang:fun_info(F1, refc) end), receive {'EXIT',Pid,normal} -> ok; - Other -> ?line ?t:fail({unexpected,Other}) + Other -> ct:fail({unexpected,Other}) end, - ?line process_flag(trap_exit, false), - ?line {refc,3} = erlang:fun_info(F1, refc), + process_flag(trap_exit, false), + {refc,3} = erlang:fun_info(F1, refc), %% Garbage collect. Only the F2 fun will be left. - ?line 7 = F1(5), - ?line true = erlang:garbage_collect(), - ?line 40 = F2(-2), - ?line {refc,2} = erlang:fun_info(F2, refc), + 7 = F1(5), + true = erlang:garbage_collect(), + 40 = F2(-2), + {refc,2} = erlang:fun_info(F2, refc), ok. fun_factory(Const) -> fun(X) -> X + Const end. refc_ets(Config) when is_list(Config) -> - ?line F = fun(X) -> X + 33 end, - ?line {refc,2} = erlang:fun_info(F, refc), + F = fun(X) -> X + 33 end, + {refc,2} = erlang:fun_info(F, refc), refc_ets_set(F, [set]), refc_ets_set(F, [ordered_set]), @@ -584,115 +536,112 @@ refc_ets(Config) when is_list(Config) -> ok. refc_ets_set(F1, Options) -> - ?line io:format("~p", [Options]), - ?line Tab = ets:new(kalle, Options), - ?line true = ets:insert(Tab, {a_key,F1}), - ?line 3 = fun_refc(F1), - ?line [{a_key,F3}] = ets:lookup(Tab, a_key), - ?line 4 = fun_refc(F1), - ?line true = ets:insert(Tab, {a_key,not_a_fun}), - ?line 3 = fun_refc(F1), - ?line true = ets:insert(Tab, {another_key,F1}), - ?line 4 = fun_refc(F1), - ?line true = ets:delete(Tab), - ?line 3 = fun_refc(F1), - ?line 10 = F3(-23), - ?line true = erlang:garbage_collect(), - ?line 2 = fun_refc(F1), + io:format("~p", [Options]), + Tab = ets:new(kalle, Options), + true = ets:insert(Tab, {a_key,F1}), + 3 = fun_refc(F1), + [{a_key,F3}] = ets:lookup(Tab, a_key), + 4 = fun_refc(F1), + true = ets:insert(Tab, {a_key,not_a_fun}), + 3 = fun_refc(F1), + true = ets:insert(Tab, {another_key,F1}), + 4 = fun_refc(F1), + true = ets:delete(Tab), + 3 = fun_refc(F1), + 10 = F3(-23), + true = erlang:garbage_collect(), + 2 = fun_refc(F1), ok. refc_ets_bag(F1, Options) -> - ?line io:format("~p", [Options]), - ?line Tab = ets:new(kalle, Options), - ?line true = ets:insert(Tab, {a_key,F1}), - ?line 3 = fun_refc(F1), - ?line [{a_key,F3}] = ets:lookup(Tab, a_key), - ?line 4 = fun_refc(F1), - ?line true = ets:insert(Tab, {a_key,not_a_fun}), - ?line 4 = fun_refc(F1), - ?line true = ets:insert(Tab, {another_key,F1}), - ?line 5 = fun_refc(F1), - ?line true = ets:delete(Tab), - ?line 3 = fun_refc(F1), - ?line 10 = F3(-23), - ?line true = erlang:garbage_collect(), - ?line 2 = fun_refc(F1), + io:format("~p", [Options]), + Tab = ets:new(kalle, Options), + true = ets:insert(Tab, {a_key,F1}), + 3 = fun_refc(F1), + [{a_key,F3}] = ets:lookup(Tab, a_key), + 4 = fun_refc(F1), + true = ets:insert(Tab, {a_key,not_a_fun}), + 4 = fun_refc(F1), + true = ets:insert(Tab, {another_key,F1}), + 5 = fun_refc(F1), + true = ets:delete(Tab), + 3 = fun_refc(F1), + 10 = F3(-23), + true = erlang:garbage_collect(), + 2 = fun_refc(F1), ok. refc_dist(Config) when is_list(Config) -> - ?line {ok,Node} = start_node(fun_SUITE_refc_dist), - ?line process_flag(trap_exit, true), - ?line Pid = spawn_link(Node, - fun() -> receive - Fun when is_function(Fun) -> - 2 = fun_refc(Fun), - exit({normal,Fun}) end - end), - ?line F = fun() -> 42 end, - ?line 2 = fun_refc(F), - ?line Pid ! F, + {ok,Node} = start_node(fun_SUITE_refc_dist), + process_flag(trap_exit, true), + Pid = spawn_link(Node, fun() -> receive + Fun when is_function(Fun) -> + 2 = fun_refc(Fun), + exit({normal,Fun}) end + end), + F = fun() -> 42 end, + 2 = fun_refc(F), + Pid ! F, F2 = receive {'EXIT',Pid,{normal,Fun}} -> Fun; - Other -> ?line ?t:fail({unexpected,Other}) + Other -> ct:fail({unexpected,Other}) end, %% dist.c:net_mess2 have a reference to Fun for a while since %% Fun is passed in an exit signal. Wait until it is gone. - ?line wait_until(fun () -> 4 =/= fun_refc(F2) end), - ?line 3 = fun_refc(F2), - ?line true = erlang:garbage_collect(), - ?line 2 = fun_refc(F), + wait_until(fun () -> 4 =/= fun_refc(F2) end), + 3 = fun_refc(F2), + true = erlang:garbage_collect(), + 2 = fun_refc(F), refc_dist_send(Node, F). refc_dist_send(Node, F) -> - ?line Pid = spawn_link(Node, - fun() -> receive - {To,Fun} when is_function(Fun) -> - wait_until(fun () -> - 2 =:= fun_refc(Fun) - end), - To ! Fun - end - end), - ?line 2 = fun_refc(F), + Pid = spawn_link(Node, fun() -> receive + {To,Fun} when is_function(Fun) -> + wait_until(fun () -> + 2 =:= fun_refc(Fun) + end), + To ! Fun + end + end), + 2 = fun_refc(F), Pid ! {self(),F}, F2 = receive Fun when is_function(Fun) -> Fun; - Other -> ?line ?t:fail({unexpected,Other}) + Other -> ct:fail({unexpected,Other}) end, receive {'EXIT',Pid,normal} -> ok end, %% No reference from dist.c:net_mess2 since Fun is passed %% in an ordinary message. - ?line 3 = fun_refc(F), - ?line 3 = fun_refc(F2), + 3 = fun_refc(F), + 3 = fun_refc(F2), refc_dist_reg_send(Node, F). refc_dist_reg_send(Node, F) -> - ?line true = erlang:garbage_collect(), - ?line 2 = fun_refc(F), - ?line Ref = make_ref(), - ?line Me = self(), - ?line Pid = spawn_link(Node, - fun() -> - true = register(my_fun_tester, self()), - Me ! Ref, - receive - {Me,Fun} when is_function(Fun) -> - 2 = fun_refc(Fun), - Me ! Fun - end - end), + true = erlang:garbage_collect(), + 2 = fun_refc(F), + Ref = make_ref(), + Me = self(), + Pid = spawn_link(Node, fun() -> + true = register(my_fun_tester, self()), + Me ! Ref, + receive + {Me,Fun} when is_function(Fun) -> + 2 = fun_refc(Fun), + Me ! Fun + end + end), erlang:yield(), - ?line 2 = fun_refc(F), + 2 = fun_refc(F), receive Ref -> ok end, {my_fun_tester,Node} ! {self(),F}, F2 = receive Fun when is_function(Fun) -> Fun; - Other -> ?line ?t:fail({unexpected,Other}) + Other -> ct:fail({unexpected,Other}) end, receive {'EXIT',Pid,normal} -> ok end, - ?line 3 = fun_refc(F), - ?line 3 = fun_refc(F2), + 3 = fun_refc(F), + 3 = fun_refc(F2), ok. fun_refc(F) -> @@ -700,67 +649,67 @@ fun_refc(F) -> Count. const_propagation(Config) when is_list(Config) -> - ?line Fun1 = fun start_node/1, - ?line 2 = fun_refc(Fun1), - ?line Fun2 = Fun1, - ?line my_cmp({Fun1,Fun2}), - - ?line Fun3 = fun() -> ok end, - ?line 2 = fun_refc(Fun3), - ?line Fun4 = Fun3, - ?line my_cmp({Fun3,Fun4}), + Fun1 = fun start_node/1, + 2 = fun_refc(Fun1), + Fun2 = Fun1, + my_cmp({Fun1,Fun2}), + + Fun3 = fun() -> ok end, + 2 = fun_refc(Fun3), + Fun4 = Fun3, + my_cmp({Fun3,Fun4}), ok. my_cmp({Fun,Fun}) -> ok; my_cmp({Fun1,Fun2}) -> io:format("Fun1: ~p", [erlang:fun_info(Fun1)]), io:format("Fun2: ~p", [erlang:fun_info(Fun2)]), - ?t:fail(). + ct:fail(no_match). t_arity(Config) when is_list(Config) -> - ?line 0 = fun_arity(fun() -> ok end), - ?line 0 = fun_arity(fun() -> Config end), - ?line 1 = fun_arity(fun(X) -> X+1 end), - ?line 1 = fun_arity(fun(X) -> Config =:= X end), + 0 = fun_arity(fun() -> ok end), + 0 = fun_arity(fun() -> Config end), + 1 = fun_arity(fun(X) -> X+1 end), + 1 = fun_arity(fun(X) -> Config =:= X end), A = id(42), %% Test that the arity is transferred properly. - ?line process_flag(trap_exit, true), - ?line {ok,Node} = start_node(fun_test_arity), - ?line hello_world = spawn_call(Node, fun() -> hello_world end), - ?line 0 = spawn_call(Node, fun(X) -> X end), - ?line 42 = spawn_call(Node, fun(_X) -> A end), - ?line 43 = spawn_call(Node, fun(X, Y) -> A+X+Y end), - ?line 1 = spawn_call(Node, fun(X, Y) -> X+Y end), - ?line 45 = spawn_call(Node, fun(X, Y, Z) -> A+X+Y+Z end), + process_flag(trap_exit, true), + {ok,Node} = start_node(fun_test_arity), + hello_world = spawn_call(Node, fun() -> hello_world end), + 0 = spawn_call(Node, fun(X) -> X end), + 42 = spawn_call(Node, fun(_X) -> A end), + 43 = spawn_call(Node, fun(X, Y) -> A+X+Y end), + 1 = spawn_call(Node, fun(X, Y) -> X+Y end), + 45 = spawn_call(Node, fun(X, Y, Z) -> A+X+Y+Z end), ok. t_is_function2(Config) when is_list(Config) -> false = is_function(id({a,b}), 0), false = is_function(id({a,b}), 234343434333433433), - ?line true = is_function(fun() -> ok end, 0), - ?line true = is_function(fun(_) -> ok end, 1), - ?line false = is_function(fun(_) -> ok end, 0), + true = is_function(fun() -> ok end, 0), + true = is_function(fun(_) -> ok end, 1), + false = is_function(fun(_) -> ok end, 0), - ?line true = is_function(fun erlang:abs/1, 1), - ?line true = is_function(fun erlang:abs/99, 99), - ?line false = is_function(fun erlang:abs/1, 0), - ?line false = is_function(fun erlang:abs/99, 0), + true = is_function(fun erlang:abs/1, 1), + true = is_function(fun erlang:abs/99, 99), + false = is_function(fun erlang:abs/1, 0), + false = is_function(fun erlang:abs/99, 0), - ?line false = is_function(id(self()), 0), - ?line false = is_function(id({a,b,c}), 0), - ?line false = is_function(id({a}), 0), - ?line false = is_function(id([a,b,c]), 0), + false = is_function(id(self()), 0), + false = is_function(id({a,b,c}), 0), + false = is_function(id({a}), 0), + false = is_function(id([a,b,c]), 0), %% Bad arity argument. - ?line bad_arity(a), - ?line bad_arity(-1), - ?line bad_arity(-9738974938734938793873498378), - ?line bad_arity([]), - ?line bad_arity(fun() -> ok end), - ?line bad_arity({}), - ?line bad_arity({a,b}), - ?line bad_arity(self()), + bad_arity(a), + bad_arity(-1), + bad_arity(-9738974938734938793873498378), + bad_arity([]), + bad_arity(fun() -> ok end), + bad_arity({}), + bad_arity({a,b}), + bad_arity(self()), ok. bad_arity(A) -> @@ -769,66 +718,81 @@ bad_arity(A) -> ok. t_fun_info(Config) when is_list(Config) -> - ?line F = fun t_fun_info/1, - ?line try F(blurf) of + F = fun t_fun_info/1, + try F(blurf) of FAny -> - io:format("should fail; returned ~p\n", [FAny]), - ?line ?t:fail() + ct:fail("should fail; returned ~p\n", [FAny]) catch error:function_clause -> ok end, - ?line {module,?MODULE} = erlang:fun_info(F, module), - ?line case erlang:fun_info(F, name) of + {module,?MODULE} = erlang:fun_info(F, module), + case erlang:fun_info(F, name) of undefined -> - ?line ?t:fail(); + ct:fail(no_fun_info); _ -> ok end, - ?line {arity,1} = erlang:fun_info(F, arity), - ?line {env,[]} = erlang:fun_info(F, env), - ?line verify_not_undef(F, index), - ?line verify_not_undef(F, uniq), - ?line verify_not_undef(F, new_index), - ?line verify_not_undef(F, new_uniq), - ?line verify_not_undef(F, refc), - ?line {'EXIT',_} = (catch erlang:fun_info(F, blurf)), + {arity,1} = erlang:fun_info(F, arity), + {env,[]} = erlang:fun_info(F, env), + verify_not_undef(F, index), + verify_not_undef(F, uniq), + verify_not_undef(F, new_index), + verify_not_undef(F, new_uniq), + verify_not_undef(F, refc), + {'EXIT',_} = (catch erlang:fun_info(F, blurf)), %% Module fun. - ?line FF = fun ?MODULE:t_fun_info/1, - ?line try FF(blurf) of + FF = fun ?MODULE:t_fun_info/1, + try FF(blurf) of FFAny -> - io:format("should fail; returned ~p\n", [FFAny]), - ?line ?t:fail() + ct:fail("should fail; returned ~p\n", [FFAny]) catch error:function_clause -> ok end, - ?line {module,?MODULE} = erlang:fun_info(FF, module), - ?line {name,t_fun_info} = erlang:fun_info(FF, name), - ?line {arity,1} = erlang:fun_info(FF, arity), - ?line {env,[]} = erlang:fun_info(FF, env), - ?line verify_undef(FF, index), - ?line verify_undef(FF, uniq), - ?line verify_undef(FF, new_index), - ?line verify_undef(FF, new_uniq), - ?line verify_undef(FF, refc), - ?line {'EXIT',_} = (catch erlang:fun_info(FF, blurf)), + {module,?MODULE} = erlang:fun_info(FF, module), + {name,t_fun_info} = erlang:fun_info(FF, name), + {arity,1} = erlang:fun_info(FF, arity), + {env,[]} = erlang:fun_info(FF, env), + verify_undef(FF, index), + verify_undef(FF, uniq), + verify_undef(FF, new_index), + verify_undef(FF, new_uniq), + verify_undef(FF, refc), + {'EXIT',_} = (catch erlang:fun_info(FF, blurf)), %% Not fun. - ?line bad_info(abc), - ?line bad_info(42), - ?line bad_info({fun erlang:list_to_integer/1}), - ?line bad_info([42]), - ?line bad_info([]), - ?line bad_info(self()), - ?line bad_info(<<>>), - ?line bad_info(<<1,2>>), + bad_info(abc), + bad_info(42), + bad_info({fun erlang:list_to_integer/1}), + bad_info([42]), + bad_info([]), + bad_info(self()), + bad_info(<<>>), + bad_info(<<1,2>>), ok. +t_fun_info_mfa(Config) when is_list(Config) -> + Fun1 = fun spawn_call/2, + {module,M1} = erlang:fun_info(Fun1, module), + {name,F1} = erlang:fun_info(Fun1, name), + {arity,A1} = erlang:fun_info(Fun1, arity), + {M1,F1,A1=2} = erlang:fun_info_mfa(Fun1), + %% Module fun. + Fun2 = fun ?MODULE:t_fun_info/1, + {module,M2} = erlang:fun_info(Fun2, module), + {name,F2} = erlang:fun_info(Fun2, name), + {arity,A2} = erlang:fun_info(Fun2, arity), + {M2,F2,A2=1} = erlang:fun_info_mfa(Fun2), + + %% Not fun. + {'EXIT',_} = (catch erlang:fun_info_mfa(id(d))), + ok. + + bad_info(Term) -> try erlang:fun_info(Term, module) of Any -> - io:format("should fail; returned ~p\n", [Any]), - ?t:fail() + ict:fail("should fail; returned ~p\n", [Any]) catch error:badarg -> ok end. @@ -839,7 +803,7 @@ verify_undef(Fun, Tag) -> verify_not_undef(Fun, Tag) -> case erlang:fun_info(Fun, Tag) of {Tag,undefined} -> - ?t:fail(); + ct:fail("tag ~w not defined in fun_info", [Tag]); {Tag,_} -> ok end. @@ -864,15 +828,15 @@ spawn_call(Node, AFun) -> Pid ! {AFun,AFun,AFun}, Res = receive {result,R} -> R; - Other -> ?t:fail({bad_message,Other}) + Other -> ct:fail({bad_message,Other}) after 10000 -> - ?t:fail(timeout_waiting_for_result) + ct:fail(timeout_waiting_for_result) end, receive {'EXIT',Pid,normal} -> ok; - Other2 -> ?t:fail({bad_message_waiting_for_exit,Other2}) + Other2 -> ct:fail({bad_message_waiting_for_exit,Other2}) after 10000 -> - ?t:fail(timeout_waiting_for_exit) + ct:fail(timeout_waiting_for_exit) end, Res. @@ -891,6 +855,3 @@ wait_until(Fun) -> true -> ok; _ -> receive after 100 -> wait_until(Fun) end end. - -% stop_node(Node) -> -% test_server:stop_node(Node). diff --git a/erts/emulator/test/fun_r13_SUITE.erl b/erts/emulator/test/fun_r13_SUITE.erl deleted file mode 100644 index 76ddf9fec9..0000000000 --- a/erts/emulator/test/fun_r13_SUITE.erl +++ /dev/null @@ -1,97 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(fun_r13_SUITE). --compile(r13). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2,dist_old_release/1]). - --define(default_timeout, ?t:minutes(1)). --include_lib("test_server/include/test_server.hrl"). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [dist_old_release]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - -dist_old_release(Config) when is_list(Config) -> - case ?t:is_release_available("r12b") of - true -> do_dist_old(Config); - false -> {skip,"No R12B found"} - end. - -do_dist_old(Config) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - Name = fun_dist_r12, - ?line {ok,Node} = ?t:start_node(Name, peer, - [{args,"-pa "++Pa}, - {erl,[{release,"r12b"}]}]), - - ?line Pid = spawn_link(Node, - fun() -> - receive - Fun when is_function(Fun) -> - R12BFun = fun(H) -> cons(H, [b,c]) end, - Fun(Fun, R12BFun) - end - end), - Self = self(), - Fun = fun(F, R12BFun) -> - {pid,Self} = erlang:fun_info(F, pid), - {module,?MODULE} = erlang:fun_info(F, module), - Self ! {ok,F,R12BFun} - end, - ?line Pid ! Fun, - ?line receive - {ok,Fun,R12BFun} -> - ?line [a,b,c] = R12BFun(a); - Other -> - ?line ?t:fail({bad_message,Other}) - end, - ok. - -cons(H, T) -> - [H|T]. diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl index 36889b6c36..f3942ef416 100644 --- a/erts/emulator/test/gc_SUITE.erl +++ b/erts/emulator/test/gc_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,45 +22,38 @@ -module(gc_SUITE). --include_lib("test_server/include/test_server.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-include_lib("common_test/include/ct.hrl"). +-include_lib("eunit/include/eunit.hrl"). --define(default_timeout, ?t:minutes(10)). +-export([all/0, suite/0]). --export([grow_heap/1, grow_stack/1, grow_stack_heap/1]). +-export([ + grow_heap/1, + grow_stack/1, + grow_stack_heap/1, + max_heap_size/1, + minor_major_gc_option_async/1, + minor_major_gc_option_self/1 +]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. all() -> - [grow_heap, grow_stack, grow_stack_heap]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. + [grow_heap, grow_stack, grow_stack_heap, max_heap_size, + minor_major_gc_option_self, + minor_major_gc_option_async]. -init_per_group(_GroupName, Config) -> - Config. -end_per_group(_GroupName, Config) -> - Config. - - -grow_heap(doc) -> ["Produce a growing list of elements, ", - "for X calls, then drop one item per call", - "until the list is empty."]; +%% Produce a growing list of elements, +%% for X calls, then drop one item per call +%% until the list is empty. grow_heap(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:minutes(40)), + ct:timetrap({minutes, 40}), ok = grow_heap1(256), ok = grow_heap1(512), ok = grow_heap1(1024), ok = grow_heap1(2048), - test_server:timetrap_cancel(Dog), ok. grow_heap1(Len) -> @@ -77,7 +71,7 @@ grow_heap1(List, MaxLen, CurLen, up) -> grow_heap1([], _MaxLen, _, down) -> ok; grow_heap1([_|List], MaxLen, CurLen, down) -> - {_,_,C} = erlang:now(), + C=erlang:unique_integer([positive]), Num = C rem (length(List))+1, Elem = lists:nth(Num, List), NewList = lists:delete(Elem, List), @@ -85,14 +79,13 @@ grow_heap1([_|List], MaxLen, CurLen, down) -> -grow_stack(doc) -> ["Increase and decrease stack size, and ", - "drop off some garbage from time to time."]; +%% Increase and decrease stack size, and +%% drop off some garbage from time to time. grow_stack(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:minutes(80)), + ct:timetrap({minutes, 80}), show_heap("before:"), grow_stack1(200, 0), show_heap("after:"), - test_server:timetrap_cancel(Dog), ok. grow_stack1(0, _) -> @@ -109,14 +102,12 @@ grow_stack1(Recs, CurRecs) -> %% Let's see how BEAM handles this one... -grow_stack_heap(doc) -> ["While growing the heap, bounces the size ", - "of the stack, and while reducing the heap", - "bounces the stack usage."]; +%% While growing the heap, bounces the size of the +%% stack, and while reducing the heap, bounces the stack usage. grow_stack_heap(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:minutes(40)), + ct:timetrap({minutes, 40}), grow_stack_heap1(16), grow_stack_heap1(32), - test_server:timetrap_cancel(Dog), ok. grow_stack_heap1(MaxLen) -> @@ -136,7 +127,7 @@ grow_stack_heap1(List, MaxLen, CurLen, up) -> grow_stack_heap1([], _MaxLen, _, down) -> ok; grow_stack_heap1([_|List], MaxLen, CurLen, down) -> grow_stack1(CurLen*2,0), - {_,_,C}=erlang:now(), + C=erlang:unique_integer([positive]), Num=C rem (length(List))+1, Elem=lists:nth(Num, List), NewList=lists:delete(Elem, List), @@ -146,8 +137,8 @@ grow_stack_heap1([_|List], MaxLen, CurLen, down) -> %% Create an arbitrary element/term. make_arbit() -> - {AA,BB,CC}=erlang:now(), - A=AA+1, B=BB+1, C=CC+1, + {AA,BB,CC}=erlang:timestamp(), + A=AA+1, B=BB+1, C=(CC+erlang:unique_integer([positive])) rem 1000000 + 1, New = case C rem 9 of 0 -> make_string((B div C) +5); @@ -171,7 +162,7 @@ make_string(Length) -> make_string(_, 0, Acc) -> Acc; make_string(Alph, Length, Acc) -> - {_,_,C}=erlang:now(), + C=erlang:unique_integer([positive]), Pos=1+(Length*C rem length(Alph)), make_string(Alph, Length-1, [lists:nth(Pos,Alph)|Acc]). @@ -183,3 +174,119 @@ show_heap(String) -> {stack_size, SSize}=process_info(self(), stack_size), io:format("Heap/Stack "++String++"~p/~p", [HSize, SSize]). +%% Test that doing a remote GC that triggers the max heap size +%% kills the process. +max_heap_size(_Config) -> + + Pid = spawn_opt(fun long_receive/0,[{max_heap_size, 1024}, + {message_queue_data, on_heap}]), + [Pid ! lists:duplicate(I,I) || I <- lists:seq(1,100)], + Ref = erlang:monitor(process, Pid), + + %% Force messages to be viewed as part of heap + erlang:process_info(Pid, messages), + + %% Do the GC that triggers max heap + erlang:garbage_collect(Pid), + + %% Verify that max heap was triggered + receive + {'DOWN', Ref, process, Pid, killed} -> ok + after 5000 -> + ct:fail({process_did_not_die, Pid, erlang:process_info(Pid)}) + end. + +long_receive() -> + receive + after 10000 -> + ok + end. + +minor_major_gc_option_self(_Config) -> + %% Try as major, the test process will self-trigger GC + check_gc_tracing_around( + fun(Pid, Ref) -> + Pid ! {gc, Ref, major} + end, [gc_major_start, gc_major_end]), + + %% Try as minor, the test process will self-trigger GC + check_gc_tracing_around( + fun(Pid, Ref) -> + Pid ! {gc, Ref, minor} + end, [gc_minor_start, gc_minor_end]). + +minor_major_gc_option_async(_Config) -> + %% Try with default option, must be major GC + check_gc_tracing_around( + fun(Pid, _Ref) -> + erlang:garbage_collect(Pid, []) + end, [gc_major_start, gc_major_end]), + + %% Try with the 'major' type + check_gc_tracing_around( + fun(Pid, _Ref) -> + erlang:garbage_collect(Pid, [{type, major}]) + end, [gc_major_start, gc_major_end]), + + %% Try with 'minor' option, once + check_gc_tracing_around( + fun(Pid, _Ref) -> + erlang:garbage_collect(Pid, [{type, minor}]) + end, [gc_minor_start, gc_minor_end]), + + %% Try with 'minor' option, once, async + check_gc_tracing_around( + fun(Pid, Ref) -> + ?assertEqual(async, + erlang:garbage_collect(Pid, [{type, minor}, {async, Ref}])), + + receive + {garbage_collect, Ref, true} -> + ok + after 10000 -> + ct:fail("Did not receive a completion notification on async GC") + end + end, [gc_minor_start, gc_minor_end]). + +%% Traces garbage collection around the given operation, and fails the test if +%% it results in any unexpected messages or if the expected trace tags are not +%% received. +check_gc_tracing_around(Fun, ExpectedTraceTags) -> + Ref = erlang:make_ref(), + Pid = spawn( + fun Endless() -> + receive + {gc, Ref, Type} -> + erlang:garbage_collect(self(), [{type, Type}]) + after 100 -> + ok + end, + Endless() + end), + erlang:garbage_collect(Pid, []), + erlang:trace(Pid, true, [garbage_collection]), + Fun(Pid, Ref), + expect_trace_messages(Pid, ExpectedTraceTags), + erlang:trace(Pid, false, [garbage_collection]), + erlang:exit(Pid, kill), + check_no_unexpected_messages(). + +%% Ensures that trace messages with the provided tags have all been received +%% within a reasonable timeframe. +expect_trace_messages(_Pid, []) -> + ok; +expect_trace_messages(Pid, [Tag | TraceTags]) -> + receive + {trace, Pid, Tag, _Data} -> + expect_trace_messages(Pid, TraceTags) + after 4000 -> + ct:fail("Didn't receive tag ~p within 4000ms", [Tag]) + end. + +check_no_unexpected_messages() -> + receive + Anything -> + ct:fail("Unexpected message: ~p", [Anything]) + after 0 -> + ok + end. diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl index a5df9b59a0..1a93a9f5c2 100644 --- a/erts/emulator/test/guard_SUITE.erl +++ b/erts/emulator/test/guard_SUITE.erl @@ -1,30 +1,31 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(guard_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, bad_arith/1, bad_tuple/1, +-export([all/0, suite/0, + bad_arith/1, bad_tuple/1, test_heap_guards/1, guard_bifs/1, type_tests/1,guard_bif_binary_part/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/3]). -import(lists, [member/2]). @@ -35,27 +36,12 @@ all() -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, type_tests, guard_bif_binary_part]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly."; +%% Test that a bad arithmetic operation in a guard works correctly. bad_arith(Config) when is_list(Config) -> - ?line 5 = bad_arith1(2, 3), - ?line 10 = bad_arith1(1, infinity), - ?line 10 = bad_arith1(infinity, 1), + 5 = bad_arith1(2, 3), + 10 = bad_arith1(1, infinity), + 10 = bad_arith1(infinity, 1), ok. bad_arith1(T1, T2) when T1+T2 < 10 -> @@ -63,12 +49,12 @@ bad_arith1(T1, T2) when T1+T2 < 10 -> bad_arith1(_, _) -> 10. -bad_tuple(doc) -> "Test that bad arguments to element/2 are handled correctly."; +%% Test that bad arguments to element/2 are handled correctly. bad_tuple(Config) when is_list(Config) -> - ?line error = bad_tuple1(a), - ?line error = bad_tuple1({a, b}), - ?line x = bad_tuple1({x, b}), - ?line y = bad_tuple1({a, b, y}), + error = bad_tuple1(a), + error = bad_tuple1({a, b}), + x = bad_tuple1({x, b}), + y = bad_tuple1({a, b, y}), ok. bad_tuple1(T) when element(1, T) == x -> @@ -78,26 +64,25 @@ bad_tuple1(T) when element(3, T) == y -> bad_tuple1(_) -> error. -test_heap_guards(doc) -> ""; test_heap_guards(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(2)), + ct:timetrap({minutes, 2}), - ?line process_flag(trap_exit, true), - ?line Tuple = {a, tuple, is, built, here, xxx}, - ?line List = [a, list, is, built, here], + process_flag(trap_exit, true), + Tuple = {a, tuple, is, built, here, xxx}, + List = [a, list, is, built, here], - ?line 'try'(fun a_case/1, [Tuple], [Tuple]), - ?line 'try'(fun a_case/1, [List], [List, List]), - ?line 'try'(fun a_case/1, [a], [a]), + 'try'(fun a_case/1, [Tuple], [Tuple]), + 'try'(fun a_case/1, [List], [List, List]), + 'try'(fun a_case/1, [a], [a]), - ?line 'try'(fun an_if/1, [Tuple], [Tuple]), - ?line 'try'(fun an_if/1, [List], [List, List]), - ?line 'try'(fun an_if/1, [a], [a]), + 'try'(fun an_if/1, [Tuple], [Tuple]), + 'try'(fun an_if/1, [List], [List, List]), + 'try'(fun an_if/1, [a], [a]), - ?line 'try'(fun receive_test/1, [Tuple], [Tuple]), - ?line 'try'(fun receive_test/1, [List], [List, List]), - ?line 'try'(fun receive_test/1, [a], [a]), - ?line test_server:timetrap_cancel(Dog). + 'try'(fun receive_test/1, [Tuple], [Tuple]), + 'try'(fun receive_test/1, [List], [List, List]), + 'try'(fun receive_test/1, [a], [a]), + ok. a_case(V) -> case V of @@ -142,12 +127,11 @@ a_receive() -> Pid = spawn_link(?MODULE, init, [Fun,Args,list_to_tuple(Filler)]), receive {'EXIT', Pid, {result, Result}} -> - ?line 'try'(Iter-1, Fun, Args, Result, [0|Filler]); + 'try'(Iter-1, Fun, Args, Result, [0|Filler]); {result, Other} -> - ?line io:format("Expected ~p; got ~p~n", [Result, Other]), - ?line test_server:fail(); + ct:fail("Expected ~p; got ~p~n", [Result, Other]); Other -> - ?line test_server:fail({unexpected_message, Other}) + ct:fail({unexpected_message, Other}) end. init(Fun, Args, Filler) -> @@ -164,15 +148,14 @@ mask_error({'EXIT',{Err,_}}) -> mask_error(Else) -> Else. -guard_bif_binary_part(doc) -> - ["Test the binary_part/2,3 guard BIF's extensively"]; +%% 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 = + badarg = ?MASK_ERROR( binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, -16#7FFFFFFFFFFFFFFF-1})), - ?line badarg = + badarg = ?MASK_ERROR( binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, 16#7FFFFFFFFFFFFFFF})), @@ -197,66 +180,66 @@ guard_bif_binary_part(Config) when is_list(Config) -> 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>>), + 1 = bptest(<<1,2,3>>), + 2 = bptest(<<2,1,3>>), + error = bptest(<<1>>), + error = bptest(<<>>), + error = bptest(apa), + 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), + 1 = bptest(<<1,2,3>>,1), + 2 = bptest(<<2,1,3>>,1), + error = bptest(<<1>>,1), + error = bptest(<<>>,1), + error = bptest(apa,1), + 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), + 1 = bptesty(<<1,2,3>>,1), + 2 = bptesty(<<2,1,3>>,1), + error = bptesty(<<1>>,1), + error = bptesty(<<>>,1), + error = bptesty(apa,1), + 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}), + 1 = bptestx(<<1,2,3>>,{1,1}), + 2 = bptestx(<<2,1,3>>,{1,1}), + error = bptestx(<<1>>,{1,1}), + error = bptestx(<<>>,{1,1}), + error = bptestx(apa,{1,1}), + 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), + 1 = bptest(<<1,2,3>>,1,1), + 2 = bptest(<<2,1,3>>,1,1), + error = bptest(<<1>>,1,1), + error = bptest(<<>>,1,1), + error = bptest(apa,1,1), + 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), + <<2>> = binary_part(<<1,2,3>>,1,1), + <<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), + badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), + badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), + badarg = ?MASK_ERROR(binary_part(apa,1,1)), + <<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]), + <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), + <<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]), + badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), + badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), + badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), + <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), % Constant propagation - ?line Bin = <<1,2,3>>, - ?line ok = if + Bin = <<1,2,3>>, + ok = if binary_part(Bin,1,1) =:= <<2>> -> ok; %% Compiler warning, clause cannot match (expected) true -> error end, - ?line ok = if + ok = if binary_part(Bin,{1,1}) =:= <<2>> -> ok; %% Compiler warning, clause cannot match (expected) @@ -322,91 +305,92 @@ bptest(_,_,_) -> error. -guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments)."; +%% Test all guard bifs with nasty (but legal arguments). guard_bifs(Config) when is_list(Config) -> - ?line Big = -237849247829874297658726487367328971246284736473821617265433, - ?line Float = 387924.874, + Big = -237849247829874297658726487367328971246284736473821617265433, + Float = 387924.874, %% Succeding use of guard bifs. - ?line try_gbif('abs/1', Big, -Big), - ?line try_gbif('float/1', Big, float(Big)), - ?line try_gbif('float/1', Big, float(id(Big))), - ?line try_gbif('trunc/1', Float, 387924.0), - ?line try_gbif('round/1', Float, 387925.0), - ?line try_gbif('length/1', [], 0), + try_gbif('abs/1', Big, -Big), + try_gbif('float/1', Big, float(Big)), + try_gbif('float/1', Big, float(id(Big))), + try_gbif('trunc/1', Float, 387924.0), + try_gbif('round/1', Float, 387925.0), + try_gbif('round/1', 6209607916799025.0, 6209607916799025), + try_gbif('length/1', [], 0), - ?line try_gbif('length/1', [a], 1), - ?line try_gbif('length/1', [a, b], 2), - ?line try_gbif('length/1', lists:seq(0, 31), 32), + try_gbif('length/1', [a], 1), + try_gbif('length/1', [a, b], 2), + try_gbif('length/1', lists:seq(0, 31), 32), - ?line try_gbif('hd/1', [a], a), - ?line try_gbif('hd/1', [a, b], a), + try_gbif('hd/1', [a], a), + try_gbif('hd/1', [a, b], a), - ?line try_gbif('tl/1', [a], []), - ?line try_gbif('tl/1', [a, b], [b]), - ?line try_gbif('tl/1', [a, b, c], [b, c]), + try_gbif('tl/1', [a], []), + try_gbif('tl/1', [a, b], [b]), + try_gbif('tl/1', [a, b, c], [b, c]), - ?line try_gbif('size/1', {}, 0), - ?line try_gbif('size/1', {a}, 1), - ?line try_gbif('size/1', {a, b}, 2), - ?line try_gbif('size/1', {a, b, c}, 3), - ?line try_gbif('size/1', list_to_binary([]), 0), - ?line try_gbif('size/1', list_to_binary([1]), 1), - ?line try_gbif('size/1', list_to_binary([1, 2]), 2), - ?line try_gbif('size/1', list_to_binary([1, 2, 3]), 3), + try_gbif('size/1', {}, 0), + try_gbif('size/1', {a}, 1), + try_gbif('size/1', {a, b}, 2), + try_gbif('size/1', {a, b, c}, 3), + try_gbif('size/1', list_to_binary([]), 0), + try_gbif('size/1', list_to_binary([1]), 1), + try_gbif('size/1', list_to_binary([1, 2]), 2), + try_gbif('size/1', list_to_binary([1, 2, 3]), 3), - ?line try_gbif('bit_size/1', <<0:7>>, 7), + try_gbif('bit_size/1', <<0:7>>, 7), - ?line try_gbif('element/2', {x}, {1, x}), - ?line try_gbif('element/2', {x, y}, {1, x}), - ?line try_gbif('element/2', {x, y}, {2, y}), + try_gbif('element/2', {x}, {1, x}), + try_gbif('element/2', {x, y}, {1, x}), + try_gbif('element/2', {x, y}, {2, y}), - ?line try_gbif('self/0', 0, self()), - ?line try_gbif('node/0', 0, node()), - ?line try_gbif('node/1', self(), node()), + try_gbif('self/0', 0, self()), + try_gbif('node/0', 0, node()), + try_gbif('node/1', self(), node()), %% Failing use of guard bifs. - ?line try_fail_gbif('abs/1', Big, 1), - ?line try_fail_gbif('abs/1', [], 1), + try_fail_gbif('abs/1', Big, 1), + try_fail_gbif('abs/1', [], 1), - ?line try_fail_gbif('float/1', Big, 42), - ?line try_fail_gbif('float/1', [], 42), + try_fail_gbif('float/1', Big, 42), + try_fail_gbif('float/1', [], 42), - ?line try_fail_gbif('trunc/1', Float, 0.0), - ?line try_fail_gbif('trunc/1', [], 0.0), + try_fail_gbif('trunc/1', Float, 0.0), + try_fail_gbif('trunc/1', [], 0.0), - ?line try_fail_gbif('round/1', Float, 1.0), - ?line try_fail_gbif('round/1', [], a), + try_fail_gbif('round/1', Float, 1.0), + try_fail_gbif('round/1', [], a), - ?line try_fail_gbif('length/1', [], 1), - ?line try_fail_gbif('length/1', [a], 0), - ?line try_fail_gbif('length/1', a, 0), - ?line try_fail_gbif('length/1', {a}, 0), + try_fail_gbif('length/1', [], 1), + try_fail_gbif('length/1', [a], 0), + try_fail_gbif('length/1', a, 0), + try_fail_gbif('length/1', {a}, 0), - ?line try_fail_gbif('hd/1', [], 0), - ?line try_fail_gbif('hd/1', [a], x), - ?line try_fail_gbif('hd/1', x, x), + try_fail_gbif('hd/1', [], 0), + try_fail_gbif('hd/1', [a], x), + try_fail_gbif('hd/1', x, x), - ?line try_fail_gbif('tl/1', [], 0), - ?line try_fail_gbif('tl/1', [a], x), - ?line try_fail_gbif('tl/1', x, x), + try_fail_gbif('tl/1', [], 0), + try_fail_gbif('tl/1', [a], x), + try_fail_gbif('tl/1', x, x), - ?line try_fail_gbif('size/1', {}, 1), - ?line try_fail_gbif('size/1', [], 0), - ?line try_fail_gbif('size/1', [a], 1), - ?line try_fail_gbif('size/1', fun() -> 1 end, 0), - ?line try_fail_gbif('size/1', fun() -> 1 end, 1), + try_fail_gbif('size/1', {}, 1), + try_fail_gbif('size/1', [], 0), + try_fail_gbif('size/1', [a], 1), + try_fail_gbif('size/1', fun() -> 1 end, 0), + try_fail_gbif('size/1', fun() -> 1 end, 1), - ?line try_fail_gbif('element/2', {}, {1, x}), - ?line try_fail_gbif('element/2', {x}, {1, y}), - ?line try_fail_gbif('element/2', [], {1, z}), + try_fail_gbif('element/2', {}, {1, x}), + try_fail_gbif('element/2', {x}, {1, y}), + try_fail_gbif('element/2', [], {1, z}), - ?line try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), - ?line try_fail_gbif('node/0', 0, xxxx), - ?line try_fail_gbif('node/1', self(), xxx), - ?line try_fail_gbif('node/1', yyy, xxx), + try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), + try_fail_gbif('node/0', 0, xxxx), + try_fail_gbif('node/1', self(), xxx), + try_fail_gbif('node/1', yyy, xxx), ok. try_gbif(Id, X, Y) -> @@ -414,9 +398,7 @@ try_gbif(Id, X, Y) -> {Id, X, Y} -> io:format("guard_bif(~p, ~p, ~p) -- ok", [Id, X, Y]); Other -> - ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", - [Id, X, Y, Other]), - ?line test_server:fail() + ct:fail("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", [Id, X, Y, Other]) end. try_fail_gbif(Id, X, Y) -> @@ -424,9 +406,7 @@ try_fail_gbif(Id, X, Y) -> {'EXIT',{function_clause,[{?MODULE,guard_bif,[Id,X,Y],_}|_]}} -> io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); Other -> - ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", - [Id, X, Y, Other]), - ?line test_server:fail() + ct:fail("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", [Id, X, Y, Other]) end. guard_bif('abs/1', X, Y) when abs(X) == Y -> @@ -456,22 +436,20 @@ guard_bif('node/0', X, Y) when node() == Y -> guard_bif('node/1', X, Y) when node(X) == Y -> {'node/1', X, Y}. -type_tests(doc) -> "Test the type tests."; +%% Test the type tests. type_tests(Config) when is_list(Config) -> - ?line Types = all_types(), - ?line Tests = type_test_desc(), - ?line put(errors, 0), - ?line put(violations, 0), - ?line type_tests(Tests, Types), - ?line case {get(errors), get(violations)} of + Types = all_types(), + Tests = type_test_desc(), + put(errors, 0), + put(violations, 0), + type_tests(Tests, Types), + case {get(errors), get(violations)} of {0, 0} -> ok; {0, N} -> {comment, integer_to_list(N) ++ " standard violation(s)"}; {Errors, Violations} -> - io:format("~p sub test(s) failed, ~p violation(s)", - [Errors, Violations]), - ?line test_server:fail() + ct:fail("~p sub test(s) failed, ~p violation(s)", [Errors, Violations]) end. type_tests([{Test, AllowedTypes}| T], AllTypes) -> @@ -498,7 +476,7 @@ type_tests(Test, [Type|T], Allowed) -> when is_list(Loc) -> ok; {'EXIT',Other} -> - ?line test_server:fail({unexpected_error_reason,Other}); + ct:fail({unexpected_error_reason,Other}); tuple when is_function(Value) -> io:format("Standard violation: Test ~p(~p) should fail", [Test, Value]), diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index 647bb45049..3cbb3c7d5f 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -33,7 +34,6 @@ -export([basic_test/0,cmp_test/1,range_test/0,spread_test/1, phash2_test/0, otp_5292_test/0, otp_7127_test/0]). --compile({nowarn_deprecated_function, {erlang,hash,2}}). %% %% Define to run outside of test server @@ -49,7 +49,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). @@ -69,83 +69,43 @@ config(priv_dir,_) -> ".". -else. %% When run in test server. --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, test_basic/1,test_cmp/1,test_range/1,test_spread/1, test_phash2/1,otp_5292/1,bit_level_binaries/1,otp_7127/1, - end_per_testcase/2,init_per_testcase/2]). -init_per_testcase(_Case, Config) -> - Dog=test_server:timetrap(test_server:minutes(10)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. + test_hash_zero/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. all() -> [test_basic, test_cmp, test_range, test_spread, - test_phash2, otp_5292, bit_level_binaries, otp_7127]. - -groups() -> - []. + test_phash2, otp_5292, bit_level_binaries, otp_7127, + test_hash_zero]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -test_basic(suite) -> - []; -test_basic(doc) -> - ["Tests basic functionality of erlang:phash and that the " - "hashes has not changed (neither hash nor phash)"]; +%% Tests basic functionality of erlang:phash and that the +%% hashes has not changed (neither hash nor phash) test_basic(Config) when is_list(Config) -> basic_test(). -test_cmp(suite) -> - []; -test_cmp(doc) -> - ["Compares integer hashes made by erlang:phash with those of a reference " - "implementation"]; +%% Compares integer hashes made by erlang:phash with those of a reference implementation test_cmp(Config) when is_list(Config) -> cmp_test(10000). -test_range(suite) -> - []; -test_range(doc) -> - ["Tests ranges on erlang:phash from 1 to 2^32"]; +%% Tests ranges on erlang:phash from 1 to 2^32 test_range(Config) when is_list(Config) -> range_test(). -test_spread(suite) -> - []; -test_spread(doc) -> - ["Tests that the hashes are spread ok"]; +%% Tests that the hashes are spread ok test_spread(Config) when is_list(Config) -> spread_test(10). -test_phash2(suite) -> - []; -test_phash2(doc) -> - ["Tests phash2"]; +%% Tests phash2 test_phash2(Config) when is_list(Config) -> phash2_test(). -otp_5292(suite) -> - []; -otp_5292(doc) -> - ["Tests hash, phash and phash2 regarding integers."]; +%% Tests hash, phash and phash2 regarding integers. otp_5292(Config) when is_list(Config) -> otp_5292_test(). @@ -153,13 +113,12 @@ otp_5292(Config) when is_list(Config) -> bit_level_binaries(Config) when is_list(Config) -> bit_level_binaries_do(). -otp_7127(suite) -> - []; -otp_7127(doc) -> - ["Tests phash2/1."]; +%% Tests phash2/1. otp_7127(Config) when is_list(Config) -> otp_7127_test(). +test_hash_zero(Config) when is_list(Config) -> + hash_zero_test(). -endif. @@ -170,24 +129,12 @@ otp_7127(Config) when is_list(Config) -> %% basic_test() -> 685556714 = erlang:phash({a,b,c},16#FFFFFFFF), - 14468079 = erlang:hash({a,b,c},16#7FFFFFF), 37442646 = erlang:phash([a,b,c,{1,2,3},c:pid(0,2,3), 16#77777777777777],16#FFFFFFFF), - Comment = case erlang:hash([a,b,c,{1,2,3},c:pid(0,2,3), - 16#77777777777777],16#7FFFFFF) of - 102727602 -> - big = erlang:system_info(endian), - "Big endian machine"; - 105818829 -> - little = erlang:system_info(endian), - "Little endian machine" - end, ExternalReference = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64, 110,111,104,111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0>>, 1113403635 = erlang:phash(binary_to_term(ExternalReference), 16#FFFFFFFF), - 123 = erlang:hash(binary_to_term(ExternalReference), - 16#7FFFFFF), ExternalFun = <<131,117,0,0,0,3,103,100,0,13,110,111,110,111,100,101,64, 110,111,104,111,115,116,0,0,0,38,0,0,0,0,0,100,0,8,101, 114,108,95,101,118,97,108,97,20,98,5,182,139,98,108,0,0, @@ -206,22 +153,19 @@ basic_test() -> 64,110,111,104,111,115,116,0,0,0,22,0,0,0,0,0,106>>, 170987488 = erlang:phash(binary_to_term(ExternalFun), 16#FFFFFFFF), - 124460689 = erlang:hash(binary_to_term(ExternalFun), - 16#7FFFFFF), case (catch erlang:phash(1,0)) of {'EXIT',{badarg, _}} -> - {comment, Comment}; + ok; _ -> exit(phash_accepted_zero_as_range) end. range_test() -> - random:seed(), F = fun(From,From,_FF) -> ok; (From,To,FF) -> - R = random:uniform(16#FFFFFFFFFFFFFFFF), + R = rand:uniform(16#FFFFFFFFFFFFFFFF), X = erlang:phash(R, From), Y = erlang:phash(R, 16#100000000) - 1, Z = (Y rem From) + 1, @@ -234,7 +178,6 @@ range_test() -> end, F(1,16#100000000,F). - spread_test(N) -> test_fun(N,{erlang,phash},16#50000000000,fun(X) -> @@ -259,14 +202,13 @@ spread_test(N) -> cmp_test(N) -> - % No need to save seed, the error indicates what number caused it. - random:seed(), do_cmp_hashes(N,8). + do_cmp_hashes(0,_) -> ok; do_cmp_hashes(N,Steps) -> - R0 = random:uniform(1 bsl Steps - 1) + random:uniform(16#FFFFFFFF), - R = case random:uniform(2) of + R0 = rand:uniform(1 bsl Steps - 1) + rand:uniform(16#FFFFFFFF), + R = case rand:uniform(2) of 1 -> R0; _ -> @@ -461,7 +403,7 @@ phash2_test() -> {"abc"++[1009], 290369864}, {"abc"++[1009]++"de", 4134369195}, {"1234567890123456", 963649519}, - + %% tuple {{}, 221703996}, {{{}}, 2165044361}, @@ -494,30 +436,15 @@ f3(X, Y) -> -endif. otp_5292_test() -> - H = fun(E) -> [erlang:hash(E, 16#7FFFFFF), - erlang:hash(-E, 16#7FFFFFF)] - end, - S1 = md5([md5(hash_int(S, E, H)) || {Start, N, Sz} <- d(), - {S, E} <- int(Start, N, Sz)]), PH = fun(E) -> [erlang:phash(E, 1 bsl 32), erlang:phash(-E, 1 bsl 32), erlang:phash2(E, 1 bsl 32), erlang:phash2(-E, 1 bsl 32)] end, - S2 = md5([md5(hash_int(S, E, PH)) || {Start, N, Sz} <- d(), + S2 = md5([md5(hash_int(S, E, PH)) || {Start, N, Sz} <- d(), {S, E} <- int(Start, N, Sz)]), - Comment = case S1 of - <<4,248,208,156,200,131,7,1,173,13,239,173,112,81,16,174>> -> - big = erlang:system_info(endian), - "Big endian machine"; - <<180,28,33,231,239,184,71,125,76,47,227,241,78,184,176,233>> -> - little = erlang:system_info(endian), - "Little endian machine" - end, <<124,81,198,121,174,233,19,137,10,83,33,80,226,111,238,99>> = S2, - 2 = erlang:hash(1, (1 bsl 27) -1), - {'EXIT', _} = (catch erlang:hash(1, (1 bsl 27))), - {comment, Comment}. + ok. d() -> [%% Start, NumOfIntervals, SizeOfInterval @@ -538,8 +465,6 @@ md5(T) -> bit_level_binaries_do() -> [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = - bit_level_all_different(fun erlang:hash/2), - [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = bit_level_all_different(fun erlang:phash/2), [102233154,19716,102133857,4532024,123369135,24565730,109558721|_] = bit_level_all_different(fun erlang:phash2/2), @@ -577,9 +502,7 @@ bit_level_all_different(Hash) -> Hashes1. test_hash_phash(Bitstr, Rem) -> - Hash = erlang:hash(Bitstr, Rem), Hash = erlang:phash(Bitstr, Rem), - Hash = erlang:hash(unaligned_sub_bitstr(Bitstr), Rem), Hash = erlang:phash(unaligned_sub_bitstr(Bitstr), Rem). test_phash2(Bitstr, Rem) -> @@ -591,6 +514,25 @@ otp_7127_test() -> 38990304 = erlang:phash2(<<"Scott9">>), ok. +hash_zero_test() -> + Zs = [0.0, -0.0, 0/-1, 0.0/-1, 0/-(1 bsl 65), + binary_to_term(<<131,70,0,0,0,0,0,0,0,0>>), %% +0.0 + binary_to_term(<<131,70,128,0,0,0,0,0,0,0>>)], %% -0.0 + ok = hash_zero_test(Zs,fun(T) -> erlang:phash2(T, 1 bsl 32) end), + ok = hash_zero_test(Zs,fun(T) -> erlang:phash(T, 1 bsl 32) end), + ok. + +hash_zero_test([Z|Zs],F) -> + hash_zero_test(Zs,Z,F(Z),F). +hash_zero_test([Z|Zs],Z0,V,F) -> + true = Z0 =:= Z, %% assert exact equal + Z0 = Z, %% assert matching + V = F(Z), %% assert hash + hash_zero_test(Zs,Z0,V,F); +hash_zero_test([],_,_,_) -> + ok. + + %% %% Reference implementation of integer hashing %% diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl index 31938e6c65..a20f306e04 100644 --- a/erts/emulator/test/hibernate_SUITE.erl +++ b/erts/emulator/test/hibernate_SUITE.erl @@ -1,65 +1,44 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(hibernate_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, +-export([all/0, suite/0, basic/1,dynamic_call/1,min_heap_size/1,bad_args/1, - messages_in_queue/1,undefined_mfa/1,no_heap/1,wake_up_and_bif_trap/1]). + messages_in_queue/1,undefined_mfa/1,no_heap/1, + wake_up_and_bif_trap/1]). %% Used by test cases. --export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2, no_heap_loop/0,characters_to_list_trap/1]). +-export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2, + no_heap_loop/0,characters_to_list_trap/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [basic, dynamic_call, min_heap_size, bad_args, messages_in_queue, undefined_mfa, no_heap, wake_up_and_bif_trap]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(3)), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - %%% %%% Testing the basic functionality of erlang:hibernate/3. %%% @@ -68,9 +47,9 @@ basic(Config) when is_list(Config) -> Ref = make_ref(), Info = {self(),Ref}, ExpectedHeapSz = erts_debug:size([Info]), - ?line Child = spawn_link(fun() -> basic_hibernator(Info) end), - ?line hibernate_wake_up(100, ExpectedHeapSz, Child), - ?line Child ! please_quit_now, + Child = spawn_link(fun() -> basic_hibernator(Info) end), + hibernate_wake_up(100, ExpectedHeapSz, Child), + Child ! please_quit_now, ok. hibernate_wake_up(0, _, _) -> ok; @@ -84,35 +63,35 @@ hibernate_wake_up(N, ExpectedHeapSz, Child) -> end; 1 -> ok end, - ?line Child ! {hibernate,self()}, - ?line wait_until(fun () -> + Child ! {hibernate,self()}, + wait_until(fun () -> {current_function,{erlang,hibernate,3}} == process_info(Child, current_function) end), - ?line {message_queue_len,0} = process_info(Child, message_queue_len), - ?line {status,waiting} = process_info(Child, status), - ?line {heap_size,ExpectedHeapSz} = process_info(Child, heap_size), + {message_queue_len,0} = process_info(Child, message_queue_len), + {status,waiting} = process_info(Child, status), + {heap_size,ExpectedHeapSz} = process_info(Child, heap_size), io:format("Before hibernation: ~p After hibernation: ~p\n", [Before,ExpectedHeapSz]), - ?line Child ! {whats_up,self()}, - ?line receive - {all_fine,X,Child,_Ref} -> - if - N =:= 1 -> io:format("~p\n", [X]); - true -> ok - end, - {backtrace,Bin} = process_info(Child, backtrace), - if - size(Bin) > 1000 -> - io:format("~s\n", [binary_to_list(Bin)]), - ?line ?t:fail(stack_is_growing); - true -> - hibernate_wake_up(N-1, ExpectedHeapSz, Child) - end; - Other -> - ?line io:format("~p\n", [Other]), - ?line ?t:fail(unexpected_message) - end. + Child ! {whats_up,self()}, + receive + {all_fine,X,Child,_Ref} -> + if + N =:= 1 -> io:format("~p\n", [X]); + true -> ok + end, + {backtrace,Bin} = process_info(Child, backtrace), + if + size(Bin) > 1000 -> + io:format("~s\n", [binary_to_list(Bin)]), + ct:fail(stack_is_growing); + true -> + hibernate_wake_up(N-1, ExpectedHeapSz, Child) + end; + Other -> + io:format("~p\n", [Other]), + ct:fail(unexpected_message) + end. basic_hibernator(Info) -> {catchlevel,0} = process_info(self(), catchlevel), @@ -164,9 +143,9 @@ dynamic_call(Config) when is_list(Config) -> Ref = make_ref(), Info = {self(),Ref}, ExpectedHeapSz = erts_debug:size([Info]), - ?line Child = spawn_link(fun() -> ?MODULE:dynamic_call_hibernator(Info, hibernate) end), - ?line hibernate_wake_up(100, ExpectedHeapSz, Child), - ?line Child ! please_quit_now, + Child = spawn_link(fun() -> ?MODULE:dynamic_call_hibernator(Info, hibernate) end), + hibernate_wake_up(100, ExpectedHeapSz, Child), + Child ! please_quit_now, ok. dynamic_call_hibernator(Info, Function) -> @@ -194,34 +173,32 @@ min_heap_size(Config) when is_list(Config) -> end. min_heap_size_1(Config) when is_list(Config) -> - ?line erlang:trace(new, true, [call]), + erlang:trace(new, true, [call]), MFA = {?MODULE,min_hibernator,1}, - ?line 1 = erlang:trace_pattern(MFA, true, [local]), + 1 = erlang:trace_pattern(MFA, true, [local]), Ref = make_ref(), Info = {self(),Ref}, - ?line Child = spawn_opt(fun() -> min_hibernator(Info) end, + Child = spawn_opt(fun() -> min_hibernator(Info) end, [{min_heap_size,15000},link]), receive - {trace,Child,call,{?MODULE,min_hibernator,_}} -> - ?line 1 = erlang:trace_pattern(MFA, false, [local]), - ?line erlang:trace(new, false, [call]) + {trace,Child,call,{?MODULE,min_hibernator,_}} -> + 1 = erlang:trace_pattern(MFA, false, [local]), + erlang:trace(new, false, [call]) end, {heap_size,HeapSz} = process_info(Child, heap_size), io:format("Heap size: ~p\n", [HeapSz]), - ?line if - HeapSz < 20 -> ok - end, - ?line Child ! wake_up, + if + HeapSz < 20 -> ok + end, + Child ! wake_up, receive {heap_size,AfterSize} -> io:format("Heap size after wakeup: ~p\n", [AfterSize]), - ?line - if - AfterSize >= 15000 -> ok - end; + if + AfterSize >= 15000 -> ok + end; Other -> - io:format("Unexpected: ~p\n", [Other]), - ?line ?t:fail() + ct:fail("Unexpected: ~p\n", [Other]) end. min_hibernator({Parent,_Ref}) -> @@ -238,23 +215,23 @@ min_hibernator_recv(Parent) -> %%% bad_args(Config) when is_list(Config) -> - ?line bad_args(?MODULE, {name,glurf}, [0]), - ?line {'EXIT',{system_limit,_}} = + bad_args(?MODULE, {name,glurf}, [0]), + {'EXIT',{system_limit,_}} = (catch erlang:hibernate(x, y, lists:duplicate(5122, xxx))), - ?line bad_args(42, name, [0]), - ?line bad_args(xx, 42, [1]), - ?line bad_args(xx, 42, glurf), - ?line bad_args(xx, 42, {}), - ?line bad_args({}, name, [2]), - ?line bad_args({1}, name, [3]), - ?line bad_args({1,2,3}, name, [4]), - ?line bad_args({1,2,3}, name, [5]), - ?line bad_args({1,2,3,4}, name, [6]), - ?line bad_args({1,2,3,4,5,6}, name,[7]), - ?line bad_args({1,2,3,4,5}, name, [8]), - ?line bad_args({1,2}, name, [9]), - ?line bad_args([1,2], name, [9]), - ?line bad_args(55.0, name, [9]), + bad_args(42, name, [0]), + bad_args(xx, 42, [1]), + bad_args(xx, 42, glurf), + bad_args(xx, 42, {}), + bad_args({}, name, [2]), + bad_args({1}, name, [3]), + bad_args({1,2,3}, name, [4]), + bad_args({1,2,3}, name, [5]), + bad_args({1,2,3,4}, name, [6]), + bad_args({1,2,3,4,5,6}, name,[7]), + bad_args({1,2,3,4,5}, name, [8]), + bad_args({1,2}, name, [9]), + bad_args([1,2], name, [9]), + bad_args(55.0, name, [9]), ok. bad_args(Mod, Name, Args) -> @@ -265,7 +242,7 @@ bad_args(Mod, Name, Args) -> io:format("erlang:hibernate(~p, ~p, ~p) -> ~p\n", [Mod,Name,Args,Res]); Other -> io:format("erlang:hibernate(~p, ~p, ~p) -> ~p\n", [Mod,Name,Args,Res]), - ?t:fail({bad_result,Other}) + ct:fail({bad_result,Other}) end. @@ -282,8 +259,8 @@ messages_in_queue(Config) when is_list(Config) -> receive done -> ok; Other -> - ?line io:format("~p\n", [Other]), - ?line ?t:fail(unexpected_message) + io:format("~p\n", [Other]), + ct:fail(unexpected_message) end. messages_in_queue_1(Parent, ExpectedMsg) -> @@ -295,13 +272,13 @@ messages_in_queue_1(Parent, ExpectedMsg) -> [Parent,ExpectedMsg]). messages_in_queue_restart(Parent, ExpectedMessage) -> - ?line receive - ExpectedMessage -> - Parent ! done; - Other -> - io:format("~p\n", [Other]), - ?t:fail(unexpected_message) - end, + receive + ExpectedMessage -> + Parent ! done; + Other -> + io:format("~p\n", [Other]), + ct:fail(unexpected_message) + end, ok. @@ -311,36 +288,36 @@ messages_in_queue_restart(Parent, ExpectedMessage) -> %%% undefined_mfa(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line Pid = spawn_link(fun() -> + process_flag(trap_exit, true), + Pid = spawn_link(fun() -> %% Will be a call_only instruction. erlang:hibernate(?MODULE, blarf, []) end), - ?line Pid ! {a,message}, - ?line receive - {'EXIT',Pid,{undef,Undef}} -> - io:format("~p\n", [Undef]), - ok; - Other -> - ?line io:format("~p\n", [Other]), - ?line ?t:fail(unexpected_message) - end, + Pid ! {a,message}, + receive + {'EXIT',Pid,{undef,Undef}} -> + io:format("~p\n", [Undef]), + ok; + Other -> + io:format("~p\n", [Other]), + ct:fail(unexpected_message) + end, undefined_mfa_1(). undefined_mfa_1() -> - ?line Pid = spawn_link(fun() -> + Pid = spawn_link(fun() -> %% Force a call_last instruction by calling bar() %% (if that is not obvious). bar(), erlang:hibernate(?MODULE, blarf, []) end), - ?line Pid ! {another,message}, - ?line receive + Pid ! {another,message}, + receive {'EXIT',Pid,{undef,Undef}} -> io:format("~p\n", [Undef]), ok; Other -> - ?line io:format("~p\n", [Other]), - ?line ?t:fail(unexpected_message) + io:format("~p\n", [Other]), + ct:fail(unexpected_message) end, ok. @@ -351,23 +328,17 @@ bar() -> %% No heap %% -no_heap(doc) -> []; -no_heap(suite) -> []; no_heap(Config) when is_list(Config) -> - ?line H = spawn_link(fun () -> clean_dict(), no_heap_loop() end), - ?line lists:foreach(fun (_) -> - wait_until(fun () -> is_hibernated(H) end), - ?line [{heap_size,1}, - {total_heap_size,1}] - = process_info(H, - [heap_size, - total_heap_size]), - receive after 10 -> ok end, - H ! again - end, - lists:seq(1, 100)), - ?line unlink(H), - ?line exit(H, bye). + H = spawn_link(fun () -> clean_dict(), no_heap_loop() end), + lists:foreach(fun (_) -> + wait_until(fun () -> is_hibernated(H) end), + [{heap_size,1}, {total_heap_size,1}] + = process_info(H, [heap_size, total_heap_size]), + receive after 10 -> ok end, + H ! again + end, lists:seq(1, 100)), + unlink(H), + exit(H, bye). no_heap_loop() -> flush(), @@ -378,22 +349,20 @@ clean_dict() -> lists:foreach(fun ({Key, _}) -> erase(Key) end, Dict). %% -%% Wake up and then immediatly bif trap with a lengthy computation. +%% Wake up and then immediately bif trap with a lengthy computation. %% -wake_up_and_bif_trap(doc) -> []; -wake_up_and_bif_trap(suite) -> []; wake_up_and_bif_trap(Config) when is_list(Config) -> - ?line Self = self(), - ?line Pid = spawn_link(fun() -> erlang:hibernate(?MODULE, characters_to_list_trap, [Self]) end), - ?line Pid ! wakeup, - ?line receive + Self = self(), + Pid = spawn_link(fun() -> erlang:hibernate(?MODULE, characters_to_list_trap, [Self]) end), + Pid ! wakeup, + receive {ok, Pid0} when Pid0 =:= Pid -> ok after 5000 -> - ?line ?t:fail(process_blocked) + ct:fail(process_blocked) end, - ?line unlink(Pid), - ?line exit(Pid, bye). + unlink(Pid), + exit(Pid, bye). %% Lengthy computation that traps (in characters_to_list_trap_3). characters_to_list_trap(Parent) -> diff --git a/erts/emulator/test/hipe_SUITE.erl b/erts/emulator/test/hipe_SUITE.erl new file mode 100644 index 0000000000..e62d4260f6 --- /dev/null +++ b/erts/emulator/test/hipe_SUITE.erl @@ -0,0 +1,188 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(hipe_SUITE). +-export([all/0 + ,t_copy_literals/1 + ,t_purge/1 + ,t_trycatch/1 + ]). + +all() -> + case erlang:system_info(hipe_architecture) of + undefined -> {skip, "HiPE is disabled"}; + _ -> [t_copy_literals + ,t_purge + ,t_trycatch + ] + end. + +t_copy_literals(doc) -> + "Check that BEAM literals referenced from HiPE stack are copied by" + " check_process_code"; +t_copy_literals(Config) when is_list(Config) -> + %% Compile the the ref_cell and literals modules. + Data = proplists:get_value(data_dir, Config), + Priv = proplists:get_value(priv_dir, Config), + RefFile = filename:join(Data, "ref_cell"), + {ok,ref_cell} = c:c(RefFile, [{outdir,Priv},native]), + true = code:is_module_native(ref_cell), + LitFile = filename:join(Data, "literals"), + {ok,literals} = c:c(LitFile, [{outdir,Priv}]), + + %% store references to literals on HiPE stacks + PA = ref_cell:start_link(), + ref_cell:call(PA, {put_res_of, fun literals:a/0}), + PB = ref_cell:start_link_deep(), + ref_cell:call(PB, {put_res_of, fun literals:b/0}), + + %% purge the literals + _ = (catch erlang:purge_module(literals)), + true = erlang:delete_module(literals), + true = erlang:purge_module(literals), + + %% Give the literal collector some time to work... + receive after 2000 -> ok end, + + %% check that the ex-literals are ok + [a,b,c] = ref_cell:call(PA, get), + {a,b,c} = ref_cell:call(PB, get), + + %% cleanup + ref_cell:call(PA, done), + ref_cell:call(PB, done), + _ = (catch erlang:purge_module(ref_cell)), + true = erlang:delete_module(ref_cell), + true = erlang:purge_module(ref_cell), + ok. + +t_purge(doc) -> "Checks that native code is properly found and purged"; +t_purge(Config) when is_list(Config) -> + Data = proplists:get_value(data_dir, Config), + Priv = proplists:get_value(priv_dir, Config), + SrcFile = filename:join(Data, "ref_cell"), + BeamFile = filename:join(Priv, "ref_cell"), + {ok,ref_cell} = c:c(SrcFile, [{outdir,Priv},native]), + true = code:is_module_native(ref_cell), + + PA = ref_cell:start_link(), + + %% Unload, PA should still be running + true = erlang:delete_module(ref_cell), + %% Can't use ref_cel:call/2, it's in old code! + call(PA, {put_res_of, fun()-> hej end}), + hej = call(PA, get), + + %% Load same module again + code:load_abs(BeamFile), + true = code:is_module_native(ref_cell), + PB = ref_cell:start_link(), + + %% Purge old code, PA should be killed, PB should survive + unlink(PA), + ARef = monitor(process, PA), + true = erlang:purge_module(ref_cell), + receive {'DOWN', ARef, process, PA, killed} -> ok + after 1 -> ct:fail("PA was not killed") + end, + + %% Unload, PB should still be running + true = erlang:delete_module(ref_cell), + call(PB, {put_res_of, fun()-> svejs end}), + svejs = call(PB, get), + + unlink(PB), + BRef = monitor(process, PB), + true = erlang:purge_module(ref_cell), + receive {'DOWN', BRef, process, PB, killed} -> ok + after 1 -> ct:fail("PB was not killed") + end, + + ok. + +call(Pid, Call) -> + Pid ! {Call, self()}, + receive {Pid, Res} -> Res end. + +t_trycatch(Config) -> + DataDir = proplists:get_value(data_dir, Config), + Files = ["trycatch_1.erl","trycatch_2.erl","trycatch_3.erl"], + Sources0 = [filename:join(DataDir, Src) || Src <- Files], + Sources = trycatch_combine(Sources0), + t_trycatch_1(Sources). + +t_trycatch_1([S|Ss]) -> + io:format("~p", [S]), + compile_and_load(S), + call_trycatch(try_catch), + call_trycatch(plain_catch), + io:nl(), + t_trycatch_1(Ss); +t_trycatch_1([]) -> + ok. + +trycatch_combine([N|Ns]) -> + Combined = trycatch_combine(Ns), + lists:append([[[{N,[]}|C],[{N,[native]},C]] || C <- Combined]); +trycatch_combine([]) -> + [[]]. + +call_trycatch(Func) -> + case do_call_trycatch(error, Func, {error,whatever}) of + {error,whatever,[{trycatch_3,three,1,_}|_]} -> + ok + end, + case do_call_trycatch(error, Func, fc) of + {error,function_clause,[{trycatch_3,three,[fc],_}|_]} -> + ok; + {error,function_clause,[{trycatch_3,three,1,_}|_]} -> + ok + end, + case do_call_trycatch(throw, Func, {throw,{a,b}}) of + {throw,{a,b},[{trycatch_3,three,1,_}|_]} -> + ok + end, + case do_call_trycatch(exit, Func, {exit,{a,b,c}}) of + {exit,{a,b,c},[{trycatch_3,three,1,_}|_]} -> + ok + end, + ok. + +do_call_trycatch(_Class, try_catch, Argument) -> + trycatch_1:one_try_catch(Argument); +do_call_trycatch(error, plain_catch, Argument) -> + {{'EXIT',{Reason,Stk}},Stk} = trycatch_1:one_plain_catch(Argument), + {error,Reason,Stk}; +do_call_trycatch(throw, plain_catch, Argument) -> + {Reason,Stk} = trycatch_1:one_plain_catch(Argument), + {throw,Reason,Stk}; +do_call_trycatch(exit, plain_catch, Argument) -> + {{'EXIT',Reason},Stk} = trycatch_1:one_plain_catch(Argument), + {exit,Reason,Stk}. + +compile_and_load(Sources) -> + _ = [begin + {ok,Mod,Bin} = compile:file(Src, [binary,report|Opts]), + code:purge(Mod), + code:delete(Mod), + code:purge(Mod), + {module,Mod} = code:load_binary(Mod, atom_to_list(Mod), Bin) + end || {Src,Opts} <- Sources], + ok. diff --git a/erts/emulator/test/hipe_SUITE_data/literals.erl b/erts/emulator/test/hipe_SUITE_data/literals.erl new file mode 100644 index 0000000000..31e443970f --- /dev/null +++ b/erts/emulator/test/hipe_SUITE_data/literals.erl @@ -0,0 +1,26 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(literals). + +-export([a/0, b/0]). + +a() -> [a,b,c]. +b() -> {a,b,c}. diff --git a/erts/emulator/test/hipe_SUITE_data/ref_cell.erl b/erts/emulator/test/hipe_SUITE_data/ref_cell.erl new file mode 100644 index 0000000000..2654e4077b --- /dev/null +++ b/erts/emulator/test/hipe_SUITE_data/ref_cell.erl @@ -0,0 +1,64 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ref_cell). + +-export([start_link/0, start_link_deep/0, call/2]). + +-compile(native). + +-define(DEPTH, 100). +-define(ALLOCS, 500). + +start_link() -> + spawn_link(fun() -> loop(undefined) end). + +start_link_deep() -> + spawn_link(fun() -> go_deep(?DEPTH) end). + +%% Create a stack large enough to get a graylimit trap placed next time there's +%% a minor gc. +go_deep(0) -> + alloc_some(?ALLOCS), + loop(undefined), + 0; +go_deep(Depth) -> + go_deep(Depth-1)+1. + +%% Do some allocation to trigger a minor gc +alloc_some(Amount) -> + Check = (Amount * (Amount + 1)) div 2, + Check = lists:sum(lists:seq(1, Amount)). + +call(Pid, Call) -> + Pid ! {Call, self()}, + receive {Pid, Res} -> Res end. + +loop(Thing) -> + receive + {done, Pid} -> Pid ! {self(), done}; + {{put_res_of, Fun}, Pid} -> + NewThing = Fun(), + Pid ! {self(), put}, + loop(NewThing); + {get, Pid} -> + Pid ! {self(), Thing}, + loop(Thing) + end. diff --git a/erts/emulator/test/hipe_SUITE_data/trycatch_1.erl b/erts/emulator/test/hipe_SUITE_data/trycatch_1.erl new file mode 100644 index 0000000000..702b14b5b9 --- /dev/null +++ b/erts/emulator/test/hipe_SUITE_data/trycatch_1.erl @@ -0,0 +1,14 @@ +-module(trycatch_1). +-export([one_try_catch/1,one_plain_catch/1]). + +one_try_catch(Term) -> + try + trycatch_2:two(Term) + catch + C:R -> + Stk = erlang:get_stacktrace(), + {C,R,Stk} + end. + +one_plain_catch(Term) -> + {catch trycatch_2:two(Term),erlang:get_stacktrace()}. diff --git a/erts/emulator/test/hipe_SUITE_data/trycatch_2.erl b/erts/emulator/test/hipe_SUITE_data/trycatch_2.erl new file mode 100644 index 0000000000..ffac420197 --- /dev/null +++ b/erts/emulator/test/hipe_SUITE_data/trycatch_2.erl @@ -0,0 +1,10 @@ +-module(trycatch_2). +-export([two/1]). + +two(Term) -> + Res = trycatch_3:three(Term), + foo(), + Res. + +foo() -> + ok. diff --git a/erts/emulator/test/hipe_SUITE_data/trycatch_3.erl b/erts/emulator/test/hipe_SUITE_data/trycatch_3.erl new file mode 100644 index 0000000000..578fa0e87e --- /dev/null +++ b/erts/emulator/test/hipe_SUITE_data/trycatch_3.erl @@ -0,0 +1,9 @@ +-module(trycatch_3). +-export([three/1]). + +three({error,Term}) -> + error(Term); +three({throw,Term}) -> + throw(Term); +three({exit,Term}) -> + exit(Term). diff --git a/erts/emulator/test/ignore_cores.erl b/erts/emulator/test/ignore_cores.erl index 8b1ac0fe6c..25dce346b9 100644 --- a/erts/emulator/test/ignore_cores.erl +++ b/erts/emulator/test/ignore_cores.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,7 +28,7 @@ -module(ignore_cores). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). @@ -52,7 +53,7 @@ init(Config) -> fini(Config) -> #ignore_cores{org_cwd = OrgCWD, org_path = OrgPath, - org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + org_pwd_env = OrgPWD} = proplists:get_value(ignore_cores, Config), ok = file:set_cwd(OrgCWD), true = code:set_path(OrgPath), case OrgPWD of @@ -69,10 +70,10 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), is_list(Config) -> #ignore_cores{org_cwd = OrgCWD, org_path = OrgPath, - org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + org_pwd_env = OrgPWD} = proplists:get_value(ignore_cores, Config), Path = lists:map(fun (".") -> OrgCWD; (Dir) -> Dir end, OrgPath), true = code:set_path(Path), - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), IgnDir = filename:join([PrivDir, atom_to_list(Suite) ++ "_" @@ -93,7 +94,7 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), end, ok = file:write_file(filename:join([IgnDir, "ignore_core_files"]), <<>>), %% cores are dumped in /cores on MacOS X - CoresDir = case {?t:os_type(), filelib:is_dir("/cores")} of + CoresDir = case {os:type(), filelib:is_dir("/cores")} of {{unix,darwin}, true} -> filelib:fold_files("/cores", "^core.*$", @@ -118,7 +119,7 @@ restore(Config) -> org_path = OrgPath, org_pwd_env = OrgPWD, ign_dir = IgnDir, - cores_dir = CoresDir} = ?config(ignore_cores, Config), + cores_dir = CoresDir} = proplists:get_value(ignore_cores, Config), try case CoresDir of false -> @@ -154,5 +155,5 @@ restore(Config) -> dir(Config) -> - #ignore_cores{ign_dir = Dir} = ?config(ignore_cores, Config), + #ignore_cores{ign_dir = Dir} = proplists:get_value(ignore_cores, Config), Dir. diff --git a/erts/emulator/test/iovec_SUITE.erl b/erts/emulator/test/iovec_SUITE.erl new file mode 100644 index 0000000000..49dc64b0d2 --- /dev/null +++ b/erts/emulator/test/iovec_SUITE.erl @@ -0,0 +1,176 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(iovec_SUITE). + +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). + +-export([integer_lists/1, binary_lists/1, empty_lists/1, empty_binary_lists/1, + mixed_lists/1, improper_lists/1, illegal_lists/1, cons_bomb/1, + sub_binary_lists/1, iolist_to_iovec_idempotence/1, + iolist_to_iovec_correctness/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. + +all() -> + [integer_lists, binary_lists, empty_lists, empty_binary_lists, mixed_lists, + sub_binary_lists, illegal_lists, improper_lists, cons_bomb, + iolist_to_iovec_idempotence, iolist_to_iovec_correctness]. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + application:stop(os_mon), + Config. + +integer_lists(Config) when is_list(Config) -> + Variations = gen_variations([I || I <- lists:seq(1, 255)]), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations). + +sub_binary_lists(Config) when is_list(Config) -> + Parent = <<0:256/unit:8, "gazurka">>, + <<0:196/unit:8, Child/binary>> = Parent, + equivalence_test(fun erlang:iolist_to_iovec/1, gen_variations(Child)). + +binary_lists(Config) when is_list(Config) -> + Variations = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations). + +empty_lists(Config) when is_list(Config) -> + Variations = gen_variations([[] || _ <- lists:seq(1, 256)]), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations), + [] = erlang:iolist_to_iovec([]), + ok. + +empty_binary_lists(Config) when is_list(Config) -> + Variations = gen_variations([<<>> || _ <- lists:seq(1, 8192)]), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations), + [] = erlang:iolist_to_iovec(Variations), + ok. + +mixed_lists(Config) when is_list(Config) -> + Variations = gen_variations([<<>>, lists:seq(1, 40), <<12, 45, 78>>]), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations). + +illegal_lists(Config) when is_list(Config) -> + BitStrs = gen_variations(["gurka", <<1:1>>, "gaffel"]), + BadInts = gen_variations(["gurka", 890, "gaffel"]), + Atoms = gen_variations([gurka, "gaffel"]), + BadTails = [["test" | 0], ["gurka", gaffel]], + + Variations = + BitStrs ++ BadInts ++ Atoms ++ BadTails, + + illegality_test(fun erlang:iolist_to_iovec/1, Variations). + +improper_lists(Config) when is_list(Config) -> + Variations = [ + [[[[1 | <<2>>] | <<3>>] | <<4>>] | <<5>>], + [[<<1>>, 2] | <<3, 4, 5>>], + [1, 2, 3 | <<4, 5>>] + ], + equivalence_test(fun erlang:iolist_to_iovec/1, Variations). + +cons_bomb(Config) when is_list(Config) -> + IntBase = gen_variations([I || I <- lists:seq(1, 255)]), + BinBase = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]), + MixBase = gen_variations([<<12, 45, 78>>, lists:seq(1, 255)]), + + Rounds = + case system_mem_size() of + Mem when Mem >= (16 bsl 30) -> 32; + Mem when Mem >= (3 bsl 30) -> 28; + _ -> 20 + end, + + Variations = gen_variations([IntBase, BinBase, MixBase], Rounds), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations). + +iolist_to_iovec_idempotence(Config) when is_list(Config) -> + IntVariations = gen_variations([I || I <- lists:seq(1, 255)]), + BinVariations = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]), + MixVariations = gen_variations([<<12, 45, 78>>, lists:seq(1, 255)]), + + Variations = [IntVariations, BinVariations, MixVariations], + Optimized = erlang:iolist_to_iovec(Variations), + + true = Optimized =:= erlang:iolist_to_iovec(Optimized), + ok. + +iolist_to_iovec_correctness(Config) when is_list(Config) -> + IntVariations = gen_variations([I || I <- lists:seq(1, 255)]), + BinVariations = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]), + MixVariations = gen_variations([<<12, 45, 78>>, lists:seq(1, 255)]), + + Variations = [IntVariations, BinVariations, MixVariations], + Optimized = erlang:iolist_to_iovec(Variations), + + true = is_iolist_equal(Optimized, Variations), + ok. + +illegality_test(Fun, Variations) -> + [{'EXIT',{badarg, _}} = (catch Fun(Variation)) || Variation <- Variations], + ok. + +equivalence_test(Fun, [Head | _] = Variations) -> + %% Check that each variation is equal to the others, and that the sum of + %% them is equal to the input. + Comparand = Fun(Head), + [true = is_iolist_equal(Comparand, Fun(V)) || V <- Variations], + true = is_iolist_equal(Variations, Fun(Variations)), + ok. + +is_iolist_equal(A, B) -> + iolist_to_binary(A) =:= iolist_to_binary(B). + +%% Generates a bunch of lists whose contents will be equal to Base repeated a +%% few times. The lists only differ by their structure, so their reduction to +%% a simpler format should yield the same result. +gen_variations(Base) -> + gen_variations(Base, 16). +gen_variations(Base, N) -> + [gen_flat_list(Base, N), + gen_nested_list(Base, N), + gen_nasty_list(Base, N)]. + +gen_flat_list(Base, N) -> + lists:flatten(gen_nested_list(Base, N)). + +gen_nested_list(Base, N) -> + [Base || _ <- lists:seq(1, N)]. + +gen_nasty_list(Base, N) -> + gen_nasty_list_1(gen_nested_list(Base, N), []). +gen_nasty_list_1([], Result) -> + Result; +gen_nasty_list_1([Head | Base], Result) when is_list(Head) -> + gen_nasty_list_1(Base, [[Result], [gen_nasty_list_1(Head, [])]]); +gen_nasty_list_1([Head | Base], Result) -> + gen_nasty_list_1(Base, [[Result], [Head]]). + +system_mem_size() -> + application:ensure_all_started(os_mon), + {Tot,_Used,_} = memsup:get_memory_data(), + Tot. diff --git a/erts/emulator/test/lcnt_SUITE.erl b/erts/emulator/test/lcnt_SUITE.erl new file mode 100644 index 0000000000..504b9b54cf --- /dev/null +++ b/erts/emulator/test/lcnt_SUITE.erl @@ -0,0 +1,156 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(lcnt_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-export( + [all/0, suite/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). + +-export( + [toggle_lock_counting/1, error_on_invalid_category/1, preserve_locks/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. + +all() -> + [toggle_lock_counting, error_on_invalid_category, preserve_locks]. + +init_per_suite(Config) -> + case erlang:system_info(lock_counting) of + true -> + %% The tests will run straight over these properties, so we have to + %% preserve them to avoid tainting the other tests. + OldCopySave = erts_debug:lcnt_control(copy_save), + OldMask = erts_debug:lcnt_control(mask), + [{lcnt_SUITE, {OldCopySave, OldMask}} | Config]; + _ -> + {skip, "Lock counting is not enabled"} + end. + +end_per_suite(Config) -> + {OldCopySave, OldMask} = proplists:get_value(lcnt_SUITE, Config), + + erts_debug:lcnt_control(copy_save, OldCopySave), + OldCopySave = erts_debug:lcnt_control(copy_save), + + erts_debug:lcnt_control(mask, OldMask), + OldMask = erts_debug:lcnt_control(mask), + + erts_debug:lcnt_clear(), + ok. + +init_per_testcase(_Case, Config) -> + disable_lock_counting(), + Config. + +end_per_testcase(_Case, _Config) -> + ok. + +disable_lock_counting() -> + ok = erts_debug:lcnt_control(copy_save, false), + ok = erts_debug:lcnt_control(mask, []), + ok = erts_debug:lcnt_clear(), + + %% Sanity check. + false = erts_debug:lcnt_control(copy_save), + [] = erts_debug:lcnt_control(mask), + + %% The above commands rely on some lazy operations, so we'll have to wait + %% for the list to clear. + ok = wait_for_empty_lock_list(). + +wait_for_empty_lock_list() -> + wait_for_empty_lock_list(10). +wait_for_empty_lock_list(Tries) when Tries > 0 -> + try_flush_cleanup_ops(), + case erts_debug:lcnt_collect() of + [{duration, _}, {locks, []}] -> + ok; + _ -> + timer:sleep(50), + wait_for_empty_lock_list(Tries - 1) + end; +wait_for_empty_lock_list(0) -> + ct:fail("Lock list failed to clear after disabling lock counting."). + +%% Queue up a lot of thread progress cleanup ops in a vain attempt to +%% flush the lock list. +try_flush_cleanup_ops() -> + false = lists:member(process, erts_debug:lcnt_control(mask)), + [spawn(fun() -> ok end) || _ <- lists:seq(1, 1000)]. + +%% +%% Test cases +%% + +toggle_lock_counting(Config) when is_list(Config) -> + Categories = + [allocator, db, debug, distribution, generic, io, process, scheduler], + lists:foreach( + fun(Category) -> + Locks = get_lock_info_for(Category), + if + Locks =/= [] -> + disable_lock_counting(); + Locks =:= [] -> + ct:fail("Failed to toggle ~p locks.", [Category]) + end + end, Categories). + +get_lock_info_for(Categories) when is_list(Categories) -> + ok = erts_debug:lcnt_control(mask, Categories), + [{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(), + Locks; + +get_lock_info_for(Category) when is_atom(Category) -> + get_lock_info_for([Category]). + +preserve_locks(Config) when is_list(Config) -> + erts_debug:lcnt_control(mask, [process]), + + erts_debug:lcnt_control(copy_save, true), + [spawn(fun() -> ok end) || _ <- lists:seq(1, 1000)], + + %% Wait for the processes to be fully destroyed before disabling copy_save, + %% then remove all active locks from the list. (There's no foolproof method + %% to do this; sleeping before/after is the best way we have) + timer:sleep(500), + + erts_debug:lcnt_control(copy_save, false), + erts_debug:lcnt_control(mask, []), + + try_flush_cleanup_ops(), + timer:sleep(500), + + case erts_debug:lcnt_collect() of + [{duration, _}, {locks, Locks}] when length(Locks) > 0 -> + ct:pal("Preserved ~p locks.", [length(Locks)]); + [{duration, _}, {locks, []}] -> + ct:fail("copy_save didn't preserve any locks.") + end. + +error_on_invalid_category(Config) when is_list(Config) -> + {error, badarg, q_invalid} = erts_debug:lcnt_control(mask, [q_invalid]), + ok. diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl index 45a44d8b43..f95251943d 100644 --- a/erts/emulator/test/list_bif_SUITE.erl +++ b/erts/emulator/test/list_bif_SUITE.erl @@ -1,166 +1,141 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(list_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2]). +-export([all/0, suite/0]). -export([hd_test/1,tl_test/1,t_length/1,t_list_to_pid/1, - t_list_to_float/1,t_list_to_integer/1]). + t_list_to_port/1,t_list_to_float/1,t_list_to_integer/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. -suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [hd_test, tl_test, t_length, t_list_to_pid, + [hd_test, tl_test, t_length, t_list_to_pid, t_list_to_port, t_list_to_float, t_list_to_integer]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - -t_list_to_integer(suite) -> - []; -t_list_to_integer(doc) -> - ["tests list_to_integer and string:to_integer"]; +%% Tests list_to_integer and string:to_integer t_list_to_integer(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = (catch list_to_integer("12373281903728109372810937209817320981321ABC")), - ?line 12373281903728109372810937209817320981321 = (catch list_to_integer("12373281903728109372810937209817320981321")), - ?line 12373 = (catch list_to_integer("12373")), - ?line -12373 = (catch list_to_integer("-12373")), - ?line 12373 = (catch list_to_integer("+12373")), - ?line {'EXIT',{badarg,_}} = ( catch list_to_integer(abc)), - ?line {'EXIT',{badarg,_}} = (catch list_to_integer("")), - ?line {12373281903728109372810937209817320981321,"ABC"} = string:to_integer("12373281903728109372810937209817320981321ABC"), - ?line {-12373281903728109372810937209817320981321,"ABC"} = string:to_integer("-12373281903728109372810937209817320981321ABC"), - ?line {12,[345]} = string:to_integer([$1,$2,345]), - ?line {12,[a]} = string:to_integer([$1,$2,a]), - ?line {error,no_integer} = string:to_integer([$A]), - ?line {error,not_a_list} = string:to_integer($A), + {'EXIT',{badarg,_}} = (catch list_to_integer("12373281903728109372810937209817320981321ABC")), + 12373281903728109372810937209817320981321 = (catch list_to_integer("12373281903728109372810937209817320981321")), + 12373 = (catch list_to_integer("12373")), + -12373 = (catch list_to_integer("-12373")), + 12373 = (catch list_to_integer("+12373")), + {'EXIT',{badarg,_}} = ( catch list_to_integer(abc)), + {'EXIT',{badarg,_}} = (catch list_to_integer("")), + {12373281903728109372810937209817320981321,"ABC"} = string:to_integer("12373281903728109372810937209817320981321ABC"), + {-12373281903728109372810937209817320981321,"ABC"} = string:to_integer("-12373281903728109372810937209817320981321ABC"), + {12,[345]} = string:to_integer([$1,$2,345]), + {error, badarg} = string:to_integer([$1,$2,a]), + {error,no_integer} = string:to_integer([$A]), + {error,badarg} = string:to_integer($A), ok. %% Test hd/1 with correct and incorrect arguments. hd_test(Config) when is_list(Config) -> - ?line $h = hd(id("hejsan")), - ?line case catch hd(id($h)) of - {'EXIT', {badarg, _}} -> ok; - Res -> - Str=io_lib:format("hd/1 with incorrect args "++ - "succeeded.~nResult: ~p", [Res]), - test_server:fail(Str) - end, + $h = hd(id("hejsan")), + case catch hd(id($h)) of + {'EXIT', {badarg, _}} -> ok; + Res -> + ct:fail("hd/1 with incorrect args succeeded.~nResult: ~p", [Res]) + end, ok. %% Test tl/1 with correct and incorrect arguments. tl_test(Config) when is_list(Config) -> - ?line "ejsan" = tl(id("hejsan")), - ?line case catch tl(id(104)) of - {'EXIT', {badarg, _}} -> - ok; - Res -> - Str=io_lib:format("tl/1 with incorrect args "++ - "succeeded.~nResult: ~p", [Res]), - test_server:fail(Str) - end, + "ejsan" = tl(id("hejsan")), + case catch tl(id(104)) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + ct:fail("tl/1 with incorrect args succeeded.~nResult: ~p", [Res]) + end, ok. %% Test length/1 with correct and incorrect arguments. t_length(Config) when is_list(Config) -> - ?line 0 = length(""), - ?line 0 = length([]), - ?line 1 = length([1]), - ?line 2 = length([1,a]), - ?line 2 = length("ab"), - ?line 3 = length("abc"), - ?line 4 = length(id([x|"abc"])), - ?line 6 = length("hejsan"), - ?line {'EXIT',{badarg,_}} = (catch length(id([a,b|c]))), - ?line case catch length({tuple}) of - {'EXIT', {badarg, _}} -> - ok; - Res -> - Str = io_lib:format("length/1 with incorrect args "++ - "succeeded.~nResult: ~p", [Res]), - ?line test_server:fail(Str) - end, + 0 = length(""), + 0 = length([]), + 1 = length([1]), + 2 = length([1,a]), + 2 = length("ab"), + 3 = length("abc"), + 4 = length(id([x|"abc"])), + 6 = length("hejsan"), + {'EXIT',{badarg,_}} = (catch length(id([a,b|c]))), + case catch length({tuple}) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + ct:fail("length/1 with incorrect args succeeded.~nResult: ~p", [Res]) + end, ok. %% Test list_to_pid/1 with correct and incorrect arguments. t_list_to_pid(Config) when is_list(Config) -> - ?line Me = self(), - ?line MyListedPid = pid_to_list(Me), - ?line Me = list_to_pid(MyListedPid), - ?line case catch list_to_pid(id("Incorrect list")) of - {'EXIT', {badarg, _}} -> - ok; - Res -> - Str=io_lib:format("list_to_pid/1 with incorrect "++ - "arg succeeded.~nResult: ~p", - [Res]), - test_server:fail(Str) - end, + Me = self(), + MyListedPid = pid_to_list(Me), + Me = list_to_pid(MyListedPid), + case catch list_to_pid(id("Incorrect list")) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + ct:fail("list_to_pid/1 with incorrect arg succeeded.~n" + "Result: ~p", [Res]) + end, ok. +%% Test list_to_port/1 with correct and incorrect arguments. + +t_list_to_port(Config) when is_list(Config) -> + Me = hd(erlang:ports()), + MyListedPid = port_to_list(Me), + Me = list_to_port(MyListedPid), + case catch list_to_port(id("Incorrect list")) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + ct:fail("list_to_port/1 with incorrect arg succeeded.~n" + "Result: ~p", [Res]) + end, + ok. %% Test list_to_float/1 with correct and incorrect arguments. t_list_to_float(Config) when is_list(Config) -> - ?line 5.89000 = list_to_float(id("5.89")), - ?line 5.89898 = list_to_float(id("5.89898")), - ?line case catch list_to_float(id("58")) of - {'EXIT', {badarg, _}} -> ok; - Res -> - Str=io_lib:format("list_to_float with incorrect "++ - "arg succeeded.~nResult: ~p", - [Res]), - test_server:fail(Str) - end, + 5.89000 = list_to_float(id("5.89")), + 5.89898 = list_to_float(id("5.89898")), + case catch list_to_float(id("58")) of + {'EXIT', {badarg, _}} -> ok; + Res -> + ct:fail("list_to_float with incorrect arg succeeded.~nResult: ~p", [Res]) + end, ok. id(I) -> I. - - diff --git a/erts/emulator/test/long_timers_test.erl b/erts/emulator/test/long_timers_test.erl index 28a4fba9f6..de1a6e6d32 100644 --- a/erts/emulator/test/long_timers_test.erl +++ b/erts/emulator/test/long_timers_test.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% Copyright Ericsson AB 2006-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -26,11 +27,16 @@ %%% Created : 21 Aug 2006 by Rickard Green <[email protected]> %%%------------------------------------------------------------------- +-define(HIGH_CPU_INFO, "Ignored due to high CPU utilization."). +-define(MISSING_CPU_INFO, "Ignored due to missing CPU utilization information."). -define(MAX_TIMEOUT, 60). % Minutes --define(MAX_LATE, 10*1000). % Milliseconds +-define(MAX_LATE_MS, 1000). % Milliseconds -define(REG_NAME, '___LONG___TIMERS___TEST___SERVER___'). +-define(HIGH_UTIL, 96.0). +-define(UTIL_INTERVAL, 10000). + -define(DRV_NAME, timer_driver). % First byte in communication with the timer driver @@ -71,75 +77,206 @@ check_result() -> receive {'DOWN', Mon, process, _, Reason} -> {?REG_NAME, 'DOWN', Reason}; - {result, ?REG_NAME, TORs, Start, End} -> + {result, ?REG_NAME, TORs, Start, End, UtilData} -> erlang:demonitor(Mon), receive {'DOWN', Mon, _, _, _} -> ok after 0 -> ok end, stop_node(Node), - check(TORs, (timer:now_diff(End, Start) div 1000) - ?MAX_LATE, ok) + Res = check(TORs, Start, End, UtilData, ms((End - Start) - max_late()), ok), + io:format("Start = ~p~n End = ~p~n UtilData = ~p~n", [Start, End, UtilData]), + Res end. +res(New, Old) when New == failed; Old == failed -> + failed; +res(New, Old) when New == missing_cpu_info; Old == missing_cpu_info -> + missing_cpu_info; +res(New, Old) when New == high_cpu; Old == high_cpu -> + high_cpu; +res(New, _Old) -> + New. + check([#timeout_rec{timeout = Timeout, type = Type, timeout_diff = undefined} | TORs], + Start, + End, + UtilData, NeedRes, - _Ok) when Timeout < NeedRes -> - io:format("~p timeout = ~p failed! No timeout.~n", - [Type, Timeout]), - check(TORs, NeedRes, failed); + Ok) when Timeout < NeedRes -> + {NewOk, HCPU} = case had_high_cpu_util(Start, + Timeout, + End - Timeout*1000, + UtilData) of + yes -> {res(high_cpu, Ok), ?HIGH_CPU_INFO}; + no -> {res(failed, Ok), ""}; + missing -> {res(missing_cpu_info, Ok), "FAILED", ?MISSING_CPU_INFO} + end, + io:format("~p timeout = ~p ms FAILED! No timeout. ~s~n", + [Type, Timeout, HCPU]), + check(TORs, Start, End, UtilData, NeedRes, NewOk); check([#timeout_rec{timeout_diff = undefined} | TORs], + Start, + End, + UtilData, NeedRes, Ok) -> - check(TORs, NeedRes, Ok); + check(TORs, Start, End, UtilData, NeedRes, Ok); check([#timeout_rec{timeout = Timeout, type = Type, timeout_diff = {error, Reason}} | TORs], + Start, + End, + UtilData, NeedRes, _Ok) -> - io:format("~p timeout = ~p failed! exit reason ~p~n", + io:format("~p timeout = ~p ms FAILED! exit reason ~p~n", [Type, Timeout, Reason]), - check(TORs, NeedRes, failed); + check(TORs, Start, End, UtilData, NeedRes, failed); check([#timeout_rec{timeout = Timeout, type = Type, timeout_diff = TimeoutDiff} | TORs], + Start, + End, + UtilData, NeedRes, Ok) -> - case (0 =< TimeoutDiff) and (TimeoutDiff =< ?MAX_LATE) of - true -> - io:format("~p timeout = ~p succeded! timeout diff = ~p.~n", - [Type, Timeout, TimeoutDiff]), - check(TORs, NeedRes, Ok); - false -> - io:format("~p timeout = ~p failed! timeout diff = ~p.~n", - [Type, Timeout, TimeoutDiff]), - check(TORs, NeedRes, failed) - end; -check([], _NeedRes, Ok) -> + {NewOk, SuccessStr, HCPU} = case {(0 =< TimeoutDiff), + (TimeoutDiff =< max_late())} of + {true, true} -> + {res(ok, Ok), "succeeded", ""}; + {false, _} -> + {res(failed, Ok), "FAILED", ""}; + _ -> + case had_high_cpu_util(Start, + Timeout, + TimeoutDiff, + UtilData) of + yes -> {res(high_cpu, Ok), "FAILED", ?HIGH_CPU_INFO}; + no -> {res(failed, Ok), "FAILED", ""}; + missing -> {res(missing_cpu_info, Ok), "FAILED", ?MISSING_CPU_INFO} + end + end, + io:format("~s timeout = ~s ms ~s! timeout diff = ~s. ~s~n", + [type_str(Type), + time_str(Timeout), + SuccessStr, + time_str(TimeoutDiff, 1000000), + HCPU]), + check(TORs, Start, End, UtilData, NeedRes, NewOk); +check([],_Start,_End,_UtilData,_NeedRes, Ok) -> Ok. +% TargetTimeout in ms, other in us. +had_high_cpu_util(StartTime, + TargetTimeout, + TimeoutDiff, + UtilData) -> + TargetTo = StartTime + TargetTimeout*1000, + ActTo = TargetTo + TimeoutDiff, + hcpu(ActTo, TargetTo, UtilData). + +hcpu(_ActTo, _TargetTo, [{_UT, 0} | _]) -> + missing; %% Util is the integer zero when not supported... +%% UT2 =:= UT1 +hcpu(ActTo, TargetTo, [{UT, _}, {UT, _} | _] = UD) -> + hcpu(ActTo, TargetTo, tl(UD)); +%% UT2 > UT1 > ActTo > TargetTo +hcpu(ActTo, TargetTo, [{_UT2, _}, {UT1, _} | _] = UD) when UT1 > ActTo -> + hcpu(ActTo, TargetTo, tl(UD)); +%% UT2 >= ActTo > TargetTo >= UT1 +hcpu(ActTo, TargetTo, + [{UT2, U}, {UT1, _} | _]) when UT2 >= ActTo, + TargetTo >= UT1 -> + case U >= (((ActTo - TargetTo) / (UT2 - UT1)) + * (?HIGH_UTIL/100.0)) of + true -> yes; + false -> no + end; +%% UT2 >= ActTo >= UT1 > TargetTo +hcpu(ActTo, TargetTo, + [{UT2, U}, {UT1, _} | _] = UD) when UT2 >= ActTo, + ActTo >= UT1, + UT1 > TargetTo -> + case U >= (((ActTo - UT1) / (UT2 - UT1)) + * (?HIGH_UTIL/100.0)) of + true -> hcpu(ActTo, TargetTo, tl(UD)); + false -> no + end; +%% ActTo > UT2 >= TargetTo >= UT1 +hcpu(ActTo, TargetTo, + [{UT2, U}, {UT1, _} | _]) when ActTo > UT2, + TargetTo >= UT1 -> + case U >= (((UT2 - TargetTo) / (UT2 - UT1)) + * (?HIGH_UTIL/100.0)) of + true -> yes; + false -> no + end; +%% ActTo > UT2 > UT1 > TargetTo +hcpu(ActTo, TargetTo, + [{UT2, U}, {UT1, _} | _] = UD) when ActTo > UT2, + UT1 > TargetTo -> + case U >= ?HIGH_UTIL of + true -> hcpu(ActTo, TargetTo, tl(UD)); + false -> no + end. + +type_str(receive_after) -> "receive ... after"; +type_str(bif_timer) -> "BIF timer"; +type_str(driver) -> "driver". + +time_str(Time, Unit) -> + lists:flatten([time_str(Time), " ", unit_str(Unit)]). + +time_str(Time) -> + lists:reverse(conv_time_str(lists:reverse(integer_to_list(Time)))). + +conv_time_str([X,Y,Z,C|Cs]) when C /= $- -> + [X,Y,Z,$`|conv_time_str([C|Cs])]; +conv_time_str(Cs) -> + Cs. + +unit_str(1) -> "s"; +unit_str(1000) -> "ms"; +unit_str(1000000) -> "us"; +unit_str(1000000000) -> "ns"; +unit_str(Res) when is_integer(Res) -> ["/ ", integer_to_list(Res), " s"]; +unit_str(Res) -> Res. + +to_diff(Timeout, Start, Stop) -> + %% 'Timeout' in milli seconds + %% 'Start', 'Stop', and result in micro seconds + (Stop - Start) - Timeout*1000. + +ms(Time) -> + erlang:convert_time_unit(Time, microsecond, millisecond). + +max_late() -> + erlang:convert_time_unit(?MAX_LATE_MS, millisecond, microsecond). + receive_after(Timeout) -> - Start = now(), + Start = erlang:monotonic_time(microsecond), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), type = receive_after, timeout = Timeout} after Timeout -> - Stop = now(), + Stop = erlang:monotonic_time(microsecond), receive {get_result, ?REG_NAME} -> - TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000) - - Timeout), ?REG_NAME ! #timeout_rec{pid = self(), type = receive_after, timeout = Timeout, - timeout_diff = TimeoutDiff} + timeout_diff = to_diff(Timeout, + Start, + Stop)} end end. driver(Timeout) -> Port = open_port({spawn, ?DRV_NAME},[]), link(Port), - Start = now(), + Start = erlang:monotonic_time(microsecond), erlang:port_command(Port, <<?START_TIMER, Timeout:32>>), receive {get_result, ?REG_NAME} -> @@ -147,49 +284,58 @@ driver(Timeout) -> type = driver, timeout = Timeout}; {Port,{data,[?TIMER]}} -> - Stop = now(), + Stop = erlang:monotonic_time(microsecond), unlink(Port), true = erlang:port_close(Port), receive {get_result, ?REG_NAME} -> - TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000) - - Timeout), ?REG_NAME ! #timeout_rec{pid = self(), type = driver, timeout = Timeout, - timeout_diff = TimeoutDiff} + timeout_diff = to_diff(Timeout, + Start, + Stop)} end end. bif_timer(Timeout) -> + Start = erlang:monotonic_time(microsecond), Tmr = erlang:start_timer(Timeout, self(), ok), - Start = now(), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), type = bif_timer, timeout = Timeout}; {timeout, Tmr, ok} -> - Stop = now(), + Stop = erlang:monotonic_time(microsecond), receive {get_result, ?REG_NAME} -> - TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000) - - Timeout), ?REG_NAME ! #timeout_rec{pid = self(), type = bif_timer, timeout = Timeout, - timeout_diff = TimeoutDiff} + timeout_diff = to_diff(Timeout, + Start, + Stop)} end end. test(Starter, DrvDir, StartDone) -> + process_flag(priority, high), erl_ddll:start(), ok = load_driver(DrvDir, ?DRV_NAME), process_flag(trap_exit, true), register(?REG_NAME, self()), {group_leader, GL} = process_info(whereis(net_kernel),group_leader), group_leader(GL, self()), - Start = now(), + try + application:start(sasl), + application:start(os_mon) + catch + _ : _ -> + ok + end, + UtilData = new_util(), + Start = erlang:monotonic_time(microsecond), TORs = lists:map(fun (Min) -> TO = Min*60*1000, [#timeout_rec{pid = spawn_opt( @@ -217,16 +363,27 @@ test(Starter, DrvDir, StartDone) -> lists:seq(1, ?MAX_TIMEOUT)), FlatTORs = lists:flatten(TORs), Starter ! StartDone, - test_loop(FlatTORs, Start). + test_loop(FlatTORs, Start, UtilData). + +new_util() -> + new_util([]). + +new_util(UtilData) -> + Util = cpu_sup:util(), + Time = erlang:monotonic_time(microsecond), + [{Time, Util} | UtilData]. -test_loop(TORs, Start) -> +test_loop(TORs, Start, UtilData) -> receive {get_result, ?REG_NAME, Pid} -> - End = now(), - Pid ! {result, ?REG_NAME, get_test_results(TORs), Start, End}, + End = erlang:monotonic_time(microsecond), + EndUtilData = new_util(UtilData), + Pid ! {result, ?REG_NAME, get_test_results(TORs), Start, End, EndUtilData}, erl_ddll:unload_driver(?DRV_NAME), erl_ddll:stop(), exit(bye) + after ?UTIL_INTERVAL -> + test_loop(TORs, Start, new_util(UtilData)) end. get_test_results(TORs) -> diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl new file mode 100644 index 0000000000..19c3844c40 --- /dev/null +++ b/erts/emulator/test/lttng_SUITE.erl @@ -0,0 +1,499 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(lttng_SUITE). + +-export([all/0, suite/0]). +-export([init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). + +-export([t_lttng_list/1, + t_carrier_pool/1, + t_memory_carrier/1, + t_async_io_pool/1, + t_driver_control_ready_async/1, + t_driver_start_stop/1, + t_driver_ready_input_output/1, + t_driver_timeout/1, + t_driver_caller/1, + t_driver_flush/1, + t_scheduler_poll/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. + +all() -> + [t_lttng_list, + t_memory_carrier, + t_carrier_pool, + t_async_io_pool, + t_driver_start_stop, + t_driver_ready_input_output, + t_driver_control_ready_async, + t_driver_timeout, + t_driver_caller, + t_driver_flush, + t_scheduler_poll]. + + +init_per_suite(Config) -> + case erlang:system_info(dynamic_trace) of + lttng -> + ensure_lttng_stopped("--all"), + Config; + _ -> + {skip, "No LTTng configured on system."} + end. + +end_per_suite(_Config) -> + ensure_lttng_stopped("--all"), + ok. + +init_per_testcase(Case, Config) -> + Name = atom_to_list(Case), + ok = ensure_lttng_started(Name, Config), + [{session, Name}|Config]. + +end_per_testcase(Case, _Config) -> + Name = atom_to_list(Case), + ok = ensure_lttng_stopped(Name), + ok. + +%% Not tested yet +%% org_erlang_otp:driver_process_exit + +%% tracepoints +%% +%% org_erlang_otp:carrier_pool_get +%% org_erlang_otp:carrier_pool_put +%% org_erlang_otp:carrier_destroy +%% org_erlang_otp:carrier_create +%% org_erlang_otp:aio_pool_put +%% org_erlang_otp:aio_pool_get +%% org_erlang_otp:driver_control +%% org_erlang_otp:driver_call +%% org_erlang_otp:driver_finish +%% org_erlang_otp:driver_ready_async +%% org_erlang_otp:driver_process_exit +%% org_erlang_otp:driver_stop +%% org_erlang_otp:driver_flush +%% org_erlang_otp:driver_stop_select +%% org_erlang_otp:driver_timeout +%% org_erlang_otp:driver_ready_output +%% org_erlang_otp:driver_ready_input +%% org_erlang_otp:driver_output +%% org_erlang_otp:driver_outputv +%% org_erlang_otp:driver_init +%% org_erlang_otp:driver_start +%% org_erlang_otp:scheduler_poll + +%% +%% Testcases +%% + +t_lttng_list(_Config) -> + {ok, _} = cmd("lttng list -u"), + ok. + +%% org_erlang_otp:carrier_pool_get +%% org_erlang_otp:carrier_pool_put +t_carrier_pool(Config) -> + case have_carriers(ets_alloc) of + false -> + {skip, "No Memory Carriers configured on system."}; + true -> + ok = lttng_start_event("org_erlang_otp:carrier_pool*", Config), + + ok = ets_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("org_erlang_otp:carrier_pool_get", Res), + ok = check_tracepoint("org_erlang_otp:carrier_pool_put", Res), + ok + end. + +%% org_erlang_otp:carrier_destroy +%% org_erlang_otp:carrier_create +t_memory_carrier(Config) -> + case have_carriers(ets_alloc) of + false -> + {skip, "No Memory Carriers configured on system."}; + true -> + ok = lttng_start_event("org_erlang_otp:carrier_*", Config), + + ok = ets_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("org_erlang_otp:carrier_destroy", Res), + ok = check_tracepoint("org_erlang_otp:carrier_create", Res), + ok + end. + +%% org_erlang_otp:aio_pool_put +%% org_erlang_otp:aio_pool_get +t_async_io_pool(Config) -> + case have_async_threads() of + false -> + {skip, "No Async Threads configured on system."}; + true -> + ok = lttng_start_event("org_erlang_otp:aio_pool_*", Config), + + Path1 = proplists:get_value(priv_dir, Config), + {ok, [[Path2]]} = init:get_argument(home), + {ok, _} = file:list_dir(Path1), + {ok, _} = file:list_dir(Path2), + {ok, _} = file:list_dir(Path1), + {ok, _} = file:list_dir(Path2), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("org_erlang_otp:aio_pool_put", Res), + ok = check_tracepoint("org_erlang_otp:aio_pool_get", Res), + ok + end. + + +%% org_erlang_otp:driver_start +%% org_erlang_otp:driver_stop +t_driver_start_stop(Config) -> + ok = lttng_start_event("org_erlang_otp:driver_*", Config), + timer:sleep(500), + Path = proplists:get_value(priv_dir, Config), + Name = filename:join(Path, "sometext.txt"), + Bin = txt(), + ok = file:write_file(Name, Bin), + {ok, Bin} = file:read_file(Name), + timer:sleep(500), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("org_erlang_otp:driver_start", Res), + ok = check_tracepoint("org_erlang_otp:driver_stop", Res), + ok = check_tracepoint("org_erlang_otp:driver_control", Res), + ok = check_tracepoint("org_erlang_otp:driver_outputv", Res), + ok = check_tracepoint("org_erlang_otp:driver_ready_async", Res), + ok. + +%% org_erlang_otp:driver_control +%% org_erlang_otp:driver_outputv +%% org_erlang_otp:driver_ready_async +t_driver_control_ready_async(Config) -> + ok = lttng_start_event("org_erlang_otp:driver_control", Config), + ok = lttng_start_event("org_erlang_otp:driver_outputv", Config), + ok = lttng_start_event("org_erlang_otp:driver_ready_async", Config), + Path = proplists:get_value(priv_dir, Config), + Name = filename:join(Path, "sometext.txt"), + Bin = txt(), + ok = file:write_file(Name, Bin), + {ok, Bin} = file:read_file(Name), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("org_erlang_otp:driver_control", Res), + ok = check_tracepoint("org_erlang_otp:driver_outputv", Res), + ok = check_tracepoint("org_erlang_otp:driver_ready_async", Res), + ok. + +%% org_erlang_otp:driver_ready_input +%% org_erlang_otp:driver_ready_output +t_driver_ready_input_output(Config) -> + ok = lttng_start_event("org_erlang_otp:driver_ready_*", Config), + timer:sleep(500), + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, active) end), + receive {Pid, accept} -> ok end, + Bin = txt(), + Sz = byte_size(Bin), + + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2}]), + ok = gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + ok = gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + ok = gen_tcp:close(Sock), + receive {Pid, done} -> ok end, + + timer:sleep(500), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("org_erlang_otp:driver_ready_input", Res), + ok = check_tracepoint("org_erlang_otp:driver_ready_output", Res), + ok. + + +%% org_erlang_otp:driver_stop_select +%% org_erlang_otp:driver_timeout +t_driver_timeout(Config) -> + ok = lttng_start_event("org_erlang_otp:driver_*", Config), + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, timeout) end), + receive {Pid, accept} -> ok end, + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary]), + ok = gen_tcp:send(Sock, <<"hej">>), + receive {Pid, done} -> ok end, + ok = gen_tcp:close(Sock), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("org_erlang_otp:driver_timeout", Res), + ok = check_tracepoint("org_erlang_otp:driver_stop_select", Res), + ok. + +%% org_erlang_otp:driver_call +%% org_erlang_otp:driver_output +%% org_erlang_otp:driver_init +%% org_erlang_otp:driver_finish +t_driver_caller(Config) -> + ok = lttng_start_event("org_erlang_otp:driver_*", Config), + + Drv = 'caller_drv', + os:putenv("CALLER_DRV_USE_OUTPUTV", "false"), + + ok = load_driver(proplists:get_value(data_dir, Config), Drv), + Port = open_port({spawn, Drv}, []), + true = is_port(Port), + + chk_caller(Port, start, self()), + chk_caller(Port, output, spawn_link(fun() -> + port_command(Port, "") + end)), + Port ! {self(), {command, ""}}, + chk_caller(Port, output, self()), + chk_caller(Port, control, spawn_link(fun () -> + port_control(Port, 0, "") + end)), + chk_caller(Port, call, spawn_link(fun() -> + erlang:port_call(Port, 0, "") + end)), + + true = port_close(Port), + erl_ddll:unload_driver(Drv), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("org_erlang_otp:driver_call", Res), + ok = check_tracepoint("org_erlang_otp:driver_output", Res), + ok = check_tracepoint("org_erlang_otp:driver_init", Res), + ok = check_tracepoint("org_erlang_otp:driver_finish", Res), + ok. + +%% org_erlang_otp:scheduler_poll +t_scheduler_poll(Config) -> + ok = lttng_start_event("org_erlang_otp:scheduler_poll", Config), + + ok = memory_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("org_erlang_otp:scheduler_poll", Res), + ok. + +%% org_erlang_otp:driver_flush +t_driver_flush(Config) -> + ok = lttng_start_event("org_erlang_otp:driver_flush", Config), + + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, passive_no_read) end), + receive {Pid, accept} -> ok end, + Bin = iolist_to_binary([txt() || _ <- lists:seq(1,100)]), + Sz = byte_size(Bin), + + %% We want to create a scenario where sendings stalls and we + %% queue packets in the driver. + %% When we close the socket it has to flush the queue. + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2}, + {send_timeout, 10}, + {sndbuf, 10000000}]), + Pids = [spawn_link(fun() -> + gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + Me ! {self(), ok} + end) || _ <- lists:seq(1,100)], + [receive {P, ok} -> ok end || P <- Pids], + ok = gen_tcp:close(Sock), + Pid ! die, + receive {Pid, done} -> ok end, + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("org_erlang_otp:driver_flush", Res), + ok. + +%% +%% AUX +%% + +chk_caller(Port, Callback, ExpectedCaller) -> + receive + {caller, Port, Callback, Caller} -> + ExpectedCaller = Caller + end. + + +ets_load() -> + Tid = ets:new(ets_load, [public,set]), + N = erlang:system_info(schedulers_online), + Pids = [spawn_link(fun() -> ets_shuffle(Tid) end) || _ <- lists:seq(1,N)], + ok = ets_kill(Pids, 500), + ok. + + +ets_kill([], _) -> ok; +ets_kill([Pid|Pids], Time) -> + timer:sleep(Time), + Pid ! done, + ets_kill(Pids, Time). + +ets_shuffle(Tid) -> + Payload = lists:duplicate(100, $x), + ets_shuffle(Tid, 100, Payload). +ets_shuffle(Tid, I, Data) -> + ets_shuffle(Tid, I, I, Data, Data). + +ets_shuffle(Tid, 0, N, _, Data) -> + ets_shuffle(Tid, N, N, Data, Data); +ets_shuffle(Tid, I, N, Data, Data0) -> + receive + done -> ok + after 0 -> + Key = rand:uniform(1000), + Data1 = [I|Data], + ets:insert(Tid, {Key, Data1}), + ets_shuffle(Tid, I - 1, N, Data1, Data0) + end. + + + + +memory_load() -> + Me = self(), + Pids0 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)], + timer:sleep(50), + Pids1 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)], + [receive {Pid, done} -> ok end || Pid <- Pids0 ++ Pids1], + timer:sleep(500), + ok. + +memory_loop(Parent, N, Bin) -> + memory_loop(Parent, N, Bin, []). + +memory_loop(Parent, 0, _Bin, _) -> + Parent ! {self(), done}; +memory_loop(Parent, N, Bin0, Ls) -> + Bin = binary:copy(<<Bin0/binary, Bin0/binary>>), + memory_loop(Parent, N - 1, Bin, [a,b,c|Ls]). + +tcp_server(Pid, Type) -> + {ok, LSock} = gen_tcp:listen(5679, [binary, + {reuseaddr, true}, + {active, false}]), + Pid ! {self(), accept}, + {ok, Sock} = gen_tcp:accept(LSock), + case Type of + passive_no_read -> + receive die -> ok end; + active -> + inet:setopts(Sock, [{active, once}, {packet,2}]), + receive Msg1 -> io:format("msg1: ~p~n", [Msg1]) end, + inet:setopts(Sock, [{active, once}, {packet,2}]), + receive Msg2 -> io:format("msg2: ~p~n", [Msg2]) end, + ok = gen_tcp:close(Sock); + timeout -> + Res = gen_tcp:recv(Sock, 2000, 1000), + io:format("res ~p~n", [Res]) + end, + Pid ! {self(), done}, + ok. + +txt() -> + <<"%% tracepoints\n" + "%%\n" + "%% org_erlang_otp:carrier_pool_get\n" + "%% org_erlang_otp:carrier_pool_put\n" + "%% org_erlang_otp:carrier_destroy\n" + "%% org_erlang_otp:carrier_create\n" + "%% org_erlang_otp:aio_pool_put\n" + "%% org_erlang_otp:aio_pool_get\n" + "%% org_erlang_otp:driver_control\n" + "%% org_erlang_otp:driver_call\n" + "%% org_erlang_otp:driver_finish\n" + "%% org_erlang_otp:driver_ready_async\n" + "%% org_erlang_otp:driver_process_exit\n" + "%% org_erlang_otp:driver_stop\n" + "%% org_erlang_otp:driver_flush\n" + "%% org_erlang_otp:driver_stop_select\n" + "%% org_erlang_otp:driver_timeout\n" + "%% org_erlang_otp:driver_ready_output\n" + "%% org_erlang_otp:driver_ready_input\n" + "%% org_erlang_otp:driver_output\n" + "%% org_erlang_otp:driver_outputv\n" + "%% org_erlang_otp:driver_init\n" + "%% org_erlang_otp:driver_start\n" + "%% org_erlang_otp:scheduler_poll">>. + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. + +%% check + +have_carriers(Alloc) -> + case erlang:system_info({allocator,Alloc}) of + false -> false; + _ -> true + end. + +have_async_threads() -> + Tps = erlang:system_info(thread_pool_size), + if Tps =:= 0 -> false; + true -> true + end. + +%% lttng +lttng_stop_and_view(Config) -> + Path = proplists:get_value(priv_dir, Config), + Name = proplists:get_value(session, Config), + {ok,_} = cmd("lttng stop " ++ Name), + {ok,Res} = cmd("lttng view " ++ Name ++ " --trace-path=" ++ Path), + Res. + +check_tracepoint(TP, Data) -> + case re:run(Data, TP, [global]) of + {match, _} -> ok; + _ -> notfound + end. + +lttng_start_event(Event, Config) -> + Name = proplists:get_value(session, Config), + {ok, _} = cmd("lttng enable-event -u " ++ Event ++ " --session=" ++ Name), + {ok, _} = cmd("lttng start " ++ Name), + ok. + +ensure_lttng_started(Name, Config) -> + Out = case proplists:get_value(priv_dir, Config) of + undefined -> []; + Path -> "--output="++Path++" " + end, + {ok,_} = cmd("lttng create " ++ Out ++ Name), + ok. + +ensure_lttng_stopped(Name) -> + {ok,_} = cmd("lttng stop"), + {ok,_} = cmd("lttng destroy " ++ Name), + ok. + +cmd(Cmd) -> + io:format("<< ~ts~n", [Cmd]), + Res = os:cmd(Cmd), + io:format(">> ~ts~n", [Res]), + {ok,Res}. diff --git a/erts/emulator/test/lttng_SUITE_data/Makefile.src b/erts/emulator/test/lttng_SUITE_data/Makefile.src new file mode 100644 index 0000000000..fe7a1b6ef3 --- /dev/null +++ b/erts/emulator/test/lttng_SUITE_data/Makefile.src @@ -0,0 +1,7 @@ + +MISC_DRVS = caller_drv@dll@ + + +all: $(MISC_DRVS) + +@SHLIB_RULES@ diff --git a/erts/emulator/test/lttng_SUITE_data/caller_drv.c b/erts/emulator/test/lttng_SUITE_data/caller_drv.c new file mode 100644 index 0000000000..86fd0a2995 --- /dev/null +++ b/erts/emulator/test/lttng_SUITE_data/caller_drv.c @@ -0,0 +1,159 @@ +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * 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 <stdlib.h> +#include <string.h> +#include "erl_driver.h" + +static int init(); +static void stop(ErlDrvData drv_data); +static void finish(); +static void flush(ErlDrvData drv_data); +static ErlDrvData start(ErlDrvPort port, char *command); +static void output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len); +static void outputv(ErlDrvData drv_data, ErlIOVec *ev); +static ErlDrvSSizeT control(ErlDrvData drv_data, + unsigned int command, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen); +static ErlDrvSSizeT call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags); + +static ErlDrvEntry caller_drv_entry = { + init, + start, + stop, + output, + NULL /* ready_input */, + NULL /* ready_output */, + "caller_drv", + finish, + NULL /* handle */, + control, + NULL /* timeout */, + outputv, + NULL /* ready_async */, + flush, + call, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(caller_drv) +{ + char buf[10]; + size_t bufsz = sizeof(buf); + char *use_outputv; + use_outputv = (erl_drv_getenv("CALLER_DRV_USE_OUTPUTV", buf, &bufsz) == 0 + ? buf + : "false"); + if (strcmp(use_outputv, "true") != 0) + caller_drv_entry.outputv = NULL; + return &caller_drv_entry; +} + +void +send_caller(ErlDrvData drv_data, char *func) +{ + int res; + ErlDrvPort port = (ErlDrvPort) drv_data; + ErlDrvTermData msg[] = { + ERL_DRV_ATOM, driver_mk_atom("caller"), + ERL_DRV_PORT, driver_mk_port(port), + ERL_DRV_ATOM, driver_mk_atom(func), + ERL_DRV_PID, driver_caller(port), + ERL_DRV_TUPLE, (ErlDrvTermData) 4 + }; + res = erl_drv_output_term(driver_mk_port(port), msg, sizeof(msg)/sizeof(ErlDrvTermData)); + if (res <= 0) + driver_failure_atom(port, "erl_drv_output_term failed"); +} + +static int +init() { + return 0; +} + +static void +stop(ErlDrvData drv_data) +{ + +} + +static void +flush(ErlDrvData drv_data) +{ + +} + +static void +finish() +{ + +} + +static ErlDrvData +start(ErlDrvPort port, char *command) +{ + send_caller((ErlDrvData) port, "start"); + return (ErlDrvData) port; +} + +static void +output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) +{ + send_caller(drv_data, "output"); +} + +static void +outputv(ErlDrvData drv_data, ErlIOVec *ev) +{ + send_caller(drv_data, "outputv"); +} + +static ErlDrvSSizeT +control(ErlDrvData drv_data, + unsigned int command, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) +{ + send_caller(drv_data, "control"); + return 0; +} + +static ErlDrvSSizeT +call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags) +{ + /* echo call */ + if (len > rlen) + *rbuf = driver_alloc(len); + memcpy((void *) *rbuf, (void *) buf, len); + send_caller(drv_data, "call"); + return len; +} diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 888ed8e272..02f3c89318 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -2,112 +2,152 @@ %% %% Copyright Ericsson AB 2013. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(map_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2 - ]). - --export([ - t_build_and_match_literals/1, - t_update_literals/1,t_match_and_update_literals/1, - t_update_map_expressions/1, - t_update_assoc/1,t_update_exact/1, - t_guard_bifs/1, t_guard_sequence/1, t_guard_update/1, - t_guard_receive/1, t_guard_fun/1, - t_list_comprehension/1, - t_map_sort_literals/1, - t_map_equal/1, - %t_size/1, - t_map_size/1, - - %% Specific Map BIFs - t_bif_map_get/1, - t_bif_map_find/1, - t_bif_map_is_key/1, - t_bif_map_keys/1, - t_bif_map_merge/1, - t_bif_map_new/1, - t_bif_map_put/1, - t_bif_map_remove/1, - t_bif_map_update/1, - t_bif_map_values/1, - t_bif_map_to_list/1, - t_bif_map_from_list/1, - - %% erlang - t_erlang_hash/1, - t_map_encode_decode/1, - - %% maps module not bifs - t_maps_fold/1, - t_maps_map/1, - t_maps_size/1, - t_maps_without/1, - - %% misc - t_pdict/1, - t_ets/1, - t_dets/1, - t_tracing/1 - ]). +-export([all/0, suite/0]). + +-export([t_build_and_match_literals/1, t_build_and_match_literals_large/1, + t_update_literals/1, t_update_literals_large/1, + t_match_and_update_literals/1, t_match_and_update_literals_large/1, + t_update_map_expressions/1, + t_update_assoc/1, t_update_assoc_large/1, + t_update_exact/1, t_update_exact_large/1, + t_guard_bifs/1, + t_guard_sequence/1, t_guard_sequence_large/1, + t_guard_update/1, t_guard_update_large/1, + t_guard_receive/1, t_guard_receive_large/1, + t_guard_fun/1, + t_update_deep/1, + t_list_comprehension/1, + t_map_sort_literals/1, + t_map_equal/1, + t_map_compare/1, + t_map_size/1, + t_is_map/1, + + %% Specific Map BIFs + t_bif_map_get/1, + t_bif_map_find/1, + t_bif_map_is_key/1, + t_bif_map_keys/1, + t_bif_map_merge/1, + t_bif_map_new/1, + t_bif_map_put/1, + t_bif_map_remove/1, + t_bif_map_take/1, t_bif_map_take_large/1, + t_bif_map_update/1, + t_bif_map_values/1, + t_bif_map_to_list/1, + t_bif_map_from_list/1, + t_bif_erts_internal_maps_to_list/1, + + %% erlang + t_erlang_hash/1, + t_map_encode_decode/1, + t_gc_rare_map_overflow/1, + + %% non specific BIF related + t_bif_build_and_check/1, + t_bif_merge_and_check/1, + + %% maps module not bifs + t_maps_fold/1, + t_maps_map/1, + t_maps_size/1, + t_maps_without/1, + + %% misc + t_hashmap_balance/1, + t_erts_internal_order/1, + t_erts_internal_hash/1, + t_pdict/1, + t_ets/1, + t_dets/1, + t_tracing/1, + t_hash_entropy/1, + + %% instruction-level tests + t_has_map_fields/1, + y_regs/1, + badmap_17/1]). -include_lib("stdlib/include/ms_transform.hrl"). -suite() -> []. - -all() -> [ - t_build_and_match_literals, - t_update_literals, t_match_and_update_literals, - t_update_map_expressions, - t_update_assoc,t_update_exact, - t_guard_bifs, t_guard_sequence, t_guard_update, - t_guard_receive,t_guard_fun, t_list_comprehension, - t_map_equal, - t_map_sort_literals, - - %% Specific Map BIFs - t_bif_map_get,t_bif_map_find,t_bif_map_is_key, - t_bif_map_keys, t_bif_map_merge, t_bif_map_new, - t_bif_map_put, - t_bif_map_remove, t_bif_map_update, - t_bif_map_values, - t_bif_map_to_list, t_bif_map_from_list, - - %% erlang - t_erlang_hash, t_map_encode_decode, - t_map_size, +-define(CHECK(Cond,Term), + case (catch (Cond)) of + true -> true; + _ -> io:format("###### CHECK FAILED ######~nINPUT: ~p~n", [Term]), + exit(Term) + end). - %% maps module - t_maps_fold, t_maps_map, - t_maps_size, t_maps_without, - - - %% Other functions - t_pdict, - t_ets, - t_tracing - ]. - -groups() -> []. - -init_per_suite(Config) -> Config. -end_per_suite(_Config) -> ok. +suite() -> []. -init_per_group(_GroupName, Config) -> Config. -end_per_group(_GroupName, Config) -> Config. +all() -> [t_build_and_match_literals, t_build_and_match_literals_large, + t_update_literals, t_update_literals_large, + t_match_and_update_literals, t_match_and_update_literals_large, + t_update_map_expressions, + t_update_assoc, t_update_assoc_large, + t_update_exact, t_update_exact_large, + t_guard_bifs, + t_guard_sequence, t_guard_sequence_large, + t_guard_update, t_guard_update_large, + t_guard_receive, t_guard_receive_large, + t_guard_fun, t_list_comprehension, + t_update_deep, + t_map_equal, t_map_compare, + t_map_sort_literals, + + %% Specific Map BIFs + t_bif_map_get,t_bif_map_find,t_bif_map_is_key, + t_bif_map_keys, t_bif_map_merge, t_bif_map_new, + t_bif_map_put, + t_bif_map_remove, + t_bif_map_take, t_bif_map_take_large, + t_bif_map_update, + t_bif_map_values, + t_bif_map_to_list, t_bif_map_from_list, + t_bif_erts_internal_maps_to_list, + + %% erlang + t_erlang_hash, t_map_encode_decode, + t_gc_rare_map_overflow, + t_map_size, t_is_map, + + %% non specific BIF related + t_bif_build_and_check, + t_bif_merge_and_check, + + %% maps module + t_maps_fold, t_maps_map, + t_maps_size, t_maps_without, + + + %% Other functions + t_hashmap_balance, + t_erts_internal_order, + t_erts_internal_hash, + t_pdict, + t_ets, + t_tracing, + t_hash_entropy, + + %% instruction-level tests + t_has_map_fields, + y_regs, + badmap_17]. %% tests @@ -124,6 +164,9 @@ t_build_and_match_literals(Config) when is_list(Config) -> #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}), + #{[]:=a,42.0:=b,x:={x,y},[a,b]:=list} = + id(#{[]=>a,42.0=>b,x=>{x,y},[a,b]=>list}), + #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}), #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =) @@ -145,17 +188,461 @@ t_build_and_match_literals(Config) when is_list(Config) -> {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), ok. +t_build_and_match_literals_large(Config) when is_list(Config) -> + % normal non-repeating + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }), + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M0, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M0, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M0, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M0, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M0, + + 60 = map_size(M0), + 60 = maps:size(M0), + + % with repeating + M1 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 10=>na0,20=>nb0,30=>"nc0","40"=>"nd0",<<"50">>=>"ne0",{["00"]}=>"n10", + 11=>na1,21=>nb1,31=>"nc1","41"=>"nd1",<<"51">>=>"ne1",{["01"]}=>"n11", + 12=>na2,22=>nb2,32=>"nc2","42"=>"nd2",<<"52">>=>"ne2",{["02"]}=>"n12", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + + 13=>na3,23=>nb3,33=>"nc3","43"=>"nd3",<<"53">>=>"ne3",{["03"]}=>"n13", + 14=>na4,24=>nb4,34=>"nc4","44"=>"nd4",<<"54">>=>"ne4",{["04"]}=>"n14", + + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }), + + #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1, + #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1, + #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1, + #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1, + #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1, + + 60 = map_size(M1), + 60 = maps:size(M1), + + % with floats + + M2 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9"}), + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + 90 = map_size(M2), + 90 = maps:size(M2), + + % with bignums + M3 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + 36893488147419103232=>big1, 73786976294838206464=>big2, + 147573952589676412928=>big3, 18446744073709551616=>big4, + 4294967296=>big5, 8589934592=>big6, + 4294967295=>big7, 67108863=>big8 + }), + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + + 98 = map_size(M3), + 98 = maps:size(M3), + + %% with maps + + M4 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M4, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M4, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M4, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M4, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M4, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M4, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M4, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M4, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M4, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M4, + + #{ #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := "small map key 2", + #{ third => small, map => key } := "small map key 3" } = M4, + + #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M4, + + + #{ 15:=V1,25:=b5,35:=V2,"45":="d5",<<"55">>:=V3,{["05"]}:="15", + #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := V4, + #{ third => small, map => key } := "small map key 3", + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := V5 } = M4, + + a5 = V1, + "c5" = V2, + "e5" = V3, + "small map key 2" = V4, + "large map key 1" = V5, + + 95 = map_size(M4), + 95 = maps:size(M4), + + % call for value + + M5 = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + #{ one => small, map => key } => id("small map key 1"), + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => id("large map key 2") }), + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M5, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M5, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M5, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M5, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M5, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M5, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M5, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M5, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M5, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M5, + + #{ #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := "small map key 2", + #{ third => small, map => key } := "small map key 3" } = M5, + + #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M5, + + 95 = map_size(M5), + 95 = maps:size(M5), + + %% remember + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0, + + #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1, + #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1, + #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1, + #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1, + #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, -%% Tests size(Map). -%% not implemented, perhaps it shouldn't be either + ok. -%t_size(Config) when is_list(Config) -> -% 0 = size(#{}), -% 1 = size(#{a=>1}), -% 1 = size(#{a=>#{a=>1}}), -% 2 = size(#{a=>1, b=>2}), -% 3 = size(#{a=>1, b=>2, b=>"3"}), -% ok. t_map_size(Config) when is_list(Config) -> 0 = map_size(id(#{})), @@ -172,16 +659,108 @@ t_map_size(Config) when is_list(Config) -> true = map_is_size(M#{ "a" => 2}, 2), false = map_is_size(M#{ "c" => 2}, 2), + Ks = [build_key(fun(K) -> <<1,K:32,1>> end,I)||I<-lists:seq(1,100)], + ok = build_and_check_size(Ks,0,#{}), + + %% try deep collisions + %% statistically we get another subtree at 50k -> 100k elements + %% Try to be nice and don't use too much memory in the testcase, + + N = 500000, + Is = lists:seq(1,N), + N = map_size(maps:from_list([{I,I}||I<-Is])), + N = map_size(maps:from_list([{<<I:32>>,I}||I<-Is])), + N = map_size(maps:from_list([{integer_to_list(I),I}||I<-Is])), + N = map_size(maps:from_list([{float(I),I}||I<-Is])), + %% Error cases. - {'EXIT',{badarg,_}} = (catch map_size([])), - {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)), - {'EXIT',{badarg,_}} = (catch map_size(1)), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch map_size(T)) + end), + ok. + +build_and_check_size([K|Ks],N,M0) -> + N = map_size(M0), + M1 = M0#{ K => K }, + build_and_check_size(Ks,N + 1,M1); +build_and_check_size([],N,M) -> + N = map_size(M), ok. map_is_size(M,N) when map_size(M) =:= N -> true; map_is_size(_,_) -> false. +t_is_map(Config) when is_list(Config) -> + true = is_map(#{}), + true = is_map(#{a=>1}), + false = is_map({a,b}), + false = is_map(x), + if is_map(#{}) -> ok end, + if is_map(#{b=>1}) -> ok end, + if not is_map([1,2,3]) -> ok end, + if not is_map(x) -> ok end, + ok. + % test map updates without matching +t_update_literals_large(Config) when is_list(Config) -> + Map = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + #{ one => small, map => key } => id("small map key 1"), + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => id("large map key 2") }), + + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + t_update_literals(Config) when is_list(Config) -> Map = #{x=>1,y=>2,z=>3,q=>4}, #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ @@ -189,13 +768,15 @@ t_update_literals(Config) when is_list(Config) -> ]), ok. + loop_update_literals_x_q(Map, []) -> Map; loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). % test map updates with matching t_match_and_update_literals(Config) when is_list(Config) -> - Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1}, + Map = #{ x=>0,y=>"untouched",z=>"also untouched",q=>1, + #{ "one" => small, map => key } => "small map key 1" }, #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ {1,2},{3,4},{5,6},{7,8} ]), @@ -209,8 +790,78 @@ t_match_and_update_literals(Config) when is_list(Config) -> #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, ok. +t_match_and_update_literals_large(Config) when is_list(Config) -> + Map = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + x=>0,y=>"untouched",z=>"also untouched",q=>1, + + #{ "one" => small, map => key } => id("small map key 1"), + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => id("large map key 2") }), + + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = id(Map#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}), + M1 = id(Map#{}), + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + + loop_match_and_update_literals_x_q(Map, []) -> Map; -loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) -> +loop_match_and_update_literals_x_q(#{ q:=Q0, x:=X0, + #{ "one" => small, map => key } := "small map key 1" } = Map, [{X,Q}|Vs]) -> loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). @@ -222,13 +873,17 @@ t_update_map_expressions(Config) when is_list(Config) -> #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + Ks = lists:seq($a,$z), + #{ "aa" := {$a,$a}, "ac":=41, "dc":=42 } = + (maps:from_list([{[K1,K2],{K1,K2}}|| K1 <- Ks, K2 <- Ks]))#{ "ac" := 41, "dc" => 42 }, - %% Error cases, FIXME: should be 'badmap'? - {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), - {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), + %% Error cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch (T)#{a:=42,b=>2}) + end), ok. - t_update_assoc(Config) when is_list(Config) -> M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), @@ -241,8 +896,75 @@ t_update_assoc(Config) when is_list(Config) -> M2 = M0#{3.0:=wrong,3.0=>new}, %% Errors cases. - BadMap = id(badmap), - {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + ok. + + +t_update_assoc_large(Config) when is_list(Config) -> + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), + + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,10.0:=fa0,4:=[a,b,c],25:=b5} = M1, + #{ 10:=43, 24:=b4, 15:=a5, 35:="c5", 2.0:=100, 13.0:=fa3, 4.0:=[a,b,c]} = + M0#{1.0=>float,10:=43,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{13.0=>new}, + #{10:=a0,20:=b0,13.0:=new,"40":="d0",<<"50">>:="e0"} = M2, + M2 = M0#{13.0:=wrong,13.0=>new}, ok. @@ -265,15 +987,124 @@ t_update_exact(Config) when is_list(Config) -> 1 := update2, 1.0 := new_val2, 1.0 => new_val3, 1.0 => new_val4 }, + %% Errors cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + Empty = id(#{}), + {'EXIT',{{badkey,nonexisting},_}} = (catch Empty#{nonexisting:=val}), + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. + +t_update_exact_large(Config) when is_list(Config) -> + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), + + + M1 = M0#{10:=42,<<"55">>:=100,10.0:=[a,b,c]}, + #{ 10:=42,<<"55">>:=100,{["05"]}:="15",10.0:=[a,b,c], + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1" } = M1, + + M1 = M0#{10:=wrong,10=>42,<<"55">>=>wrong,<<"55">>:=100,10.0:=[a,b,c]}, + + M2 = M0#{13.0:=new}, + #{10:=a0,20:=b0,13.0:=new} = M2, + M2 = M0#{13.0=>wrong,13.0:=new}, %% Errors cases. - {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), - {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), - {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), - {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), ok. +t_update_deep(Config) when is_list(Config) -> + N = 250000, + M0 = maps:from_list([{integer_to_list(I),a}||I<-lists:seq(1,N)]), + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + + M1 = M0#{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + + M2 = M0#{ "1" => c, "10" => c, "100" => c, "1000" => c, "10000" => c }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2, + + M3 = M2#{ "n1" => d, "n10" => d, "n100" => d, "n1000" => d, "n10000" => d }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M3, + #{ "n1" := d, "n10" := d, "n100" := d, "n1000" := d, "n10000" := d } = M3, + ok. + t_guard_bifs(Config) when is_list(Config) -> true = map_guard_head(#{a=>1}), false = map_guard_head([]), @@ -303,12 +1134,82 @@ t_guard_sequence(Config) when is_list(Config) -> {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})), {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})), {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})), - + %% error case {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})), {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), ok. +t_guard_sequence_large(Config) when is_list(Config) -> + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), + + {1, "a"} = map_guard_sequence_1(M0#{seq=>1,val=>id("a")}), + {2, "b"} = map_guard_sequence_1(M0#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(M0#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(M0#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(M0#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(M0#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(M0#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(M0#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(M0#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(M0#{a=>kk, b=>other, c=>sc2})), + + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(M0#{seq=>6,val=>id("e")})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(M0#{b=>5})), + ok. + + map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; @@ -328,6 +1229,66 @@ t_guard_update(Config) when is_list(Config) -> second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), ok. +t_guard_update_large(Config) when is_list(Config) -> + M0 = id(#{ 70=>a0,80=>b0,90=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", + 71=>a1,81=>b1,91=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11", + 72=>a2,82=>b2,92=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12", + 73=>a3,83=>b3,93=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13", + 74=>a4,84=>b4,94=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14", + + 75=>a5,85=>b5,95=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15", + 76=>a6,86=>b6,96=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16", + 77=>a7,87=>b7,97=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17", + 78=>a8,88=>b8,98=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18", + 79=>a9,89=>b9,99=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19", + + 70.0=>fa0,80.0=>fb0,90.0=>"fc0", + 71.0=>fa1,81.0=>fb1,91.0=>"fc1", + 72.0=>fa2,82.0=>fb2,92.0=>"fc2", + 73.0=>fa3,83.0=>fb3,93.0=>"fc3", + 74.0=>fa4,84.0=>fb4,94.0=>"fc4", + + 75.0=>fa5,85.0=>fb5,95.0=>"fc5", + 76.0=>fa6,86.0=>fb6,96.0=>"fc6", + 77.0=>fa7,87.0=>fb7,97.0=>"fc7", + 78.0=>fa8,88.0=>fb8,98.0=>"fc8", + 79.0=>fa9,89.0=>fb9,99.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), + + + error = map_guard_update(M0#{},M0#{}), + first = map_guard_update(M0#{},M0#{x=>first}), + second = map_guard_update(M0#{y=>old}, M0#{x=>second,y=>old}), + ok. + + map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; map_guard_update(_, _) -> error. @@ -357,6 +1318,42 @@ t_guard_receive(Config) when is_list(Config) -> done = call(Pid, done), ok. +-define(t_guard_receive_large_procs, 1500). + +t_guard_receive_large(Config) when is_list(Config) -> + M = lists:foldl(fun(_,#{procs := Ps } = M) -> + M#{ procs := Ps#{ spawn_link(fun() -> grecv_loop() end) => 0 }} + end, #{procs => #{}, done => 0}, lists:seq(1,?t_guard_receive_large_procs)), + lists:foreach(fun(Pid) -> + Pid ! {self(), hello} + end, maps:keys(maps:get(procs,M))), + ok = guard_receive_large_loop(M), + ok. + +guard_receive_large_loop(#{done := ?t_guard_receive_large_procs}) -> + ok; +guard_receive_large_loop(M) -> + receive + #{pid := Pid, msg := hello} -> + case M of + #{done := Count, procs := #{Pid := 150}} -> + Pid ! {self(), done}, + guard_receive_large_loop(M#{done := Count + 1}); + #{procs := #{Pid := Count} = Ps} -> + Pid ! {self(), hello}, + guard_receive_large_loop(M#{procs := Ps#{Pid := Count + 1}}) + end + end. + +grecv_loop() -> + receive + {_, done} -> + ok; + {Pid, hello} -> + Pid ! #{pid=>self(), msg=>hello}, + grecv_loop() + end. + call(Pid, M) -> Pid ! {self(), M}, receive {Pid, Res} -> Res end. @@ -387,6 +1384,11 @@ guard_receive_loop() -> t_list_comprehension(Config) when is_list(Config) -> [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + + Ks = lists:seq($a,$z), + Ms = [#{[K1,K2]=>{K1,K2}} || K1 <- Ks, K2 <- Ks], + [#{"aa" := {$a,$a}},#{"ab":={$a,$b}}|_] = Ms, + [#{"zz" := {$z,$z}},#{"zy":={$z,$y}}|_] = lists:reverse(Ms), ok. t_guard_fun(Config) when is_list(Config) -> @@ -432,7 +1434,7 @@ t_map_sort_literals(Config) when is_list(Config) -> true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}), true = #{ "a" => 1 } < id(#{ <<"a">> => 1}), false = #{ <<"a">> => 1 } < id(#{ "a" => 1}), - false = #{ 1 => 1 } < id(#{ 1.0 => 1}), + true = #{ 1 => 1 } < id(#{ 1.0 => 1}), false = #{ 1.0 => 1 } < id(#{ 1 => 1}), %% value order @@ -440,16 +1442,47 @@ t_map_sort_literals(Config) when is_list(Config) -> false = #{ a => 2 } < id(#{ a => 1}), false = #{ a => 2, b => 1 } < id(#{ a => 1, b => 3}), true = #{ a => 1, b => 1 } < id(#{ a => 1, b => 3}), + false = #{ a => 1 } < id(#{ a => 1.0}), + false = #{ a => 1.0 } < id(#{ a => 1}), true = #{ "a" => "hi", b => 134 } == id(#{ b => 134,"a" => "hi"}), + %% large maps + + M = maps:from_list([{I,I}||I <- lists:seq(1,500)]), + + %% size order + true = M#{ a => 1, b => 2} < id(M#{ a => 1, b => 1, c => 1}), + true = M#{ b => 1, a => 1} < id(M#{ c => 1, a => 1, b => 1}), + false = M#{ c => 1, b => 1, a => 1} < id(M#{ c => 1, a => 1}), + + %% key order + true = M#{ a => 1 } < id(M#{ b => 1}), + false = M#{ b => 1 } < id(M#{ a => 1}), + true = M#{ a => 1, b => 1, c => 1 } < id(M#{ b => 1, c => 1, d => 1}), + true = M#{ b => 1, c => 1, d => 1 } > id(M#{ a => 1, b => 1, c => 1}), + true = M#{ c => 1, b => 1, a => 1 } < id(M#{ b => 1, c => 1, d => 1}), + true = M#{ "a" => 1 } < id(M#{ <<"a">> => 1}), + false = M#{ <<"a">> => 1 } < id(#{ "a" => 1}), + true = M#{ 1 => 1 } < id(maps:remove(1,M#{ 1.0 => 1})), + false = M#{ 1.0 => 1 } < id(M#{ 1 => 1}), + + %% value order + true = M#{ a => 1 } < id(M#{ a => 2}), + false = M#{ a => 2 } < id(M#{ a => 1}), + false = M#{ a => 2, b => 1 } < id(M#{ a => 1, b => 3}), + true = M#{ a => 1, b => 1 } < id(M#{ a => 1, b => 3}), + false = M#{ a => 1 } < id(M#{ a => 1.0}), + false = M#{ a => 1.0 } < id(M#{ a => 1}), + + true = M#{ "a" => "hi", b => 134 } == id(M#{ b => 134,"a" => "hi"}), + %% lists:sort SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), - ok. t_map_equal(Config) when is_list(Config) -> @@ -469,27 +1502,268 @@ t_map_equal(Config) when is_list(Config) -> true = id(#{ a => 1, b => 3, c => <<"wat">> }) =:= id(#{ a => 1, b => 3, c=><<"wat">>}), ok. + +t_map_compare(Config) when is_list(Config) -> + rand:seed(exsplus), + io:format("seed = ~p\n", [rand:export_seed()]), + repeat(100, fun(_) -> float_int_compare() end, []), + repeat(100, fun(_) -> recursive_compare() end, []), + ok. + +float_int_compare() -> + Terms = numeric_keys(3), + %%io:format("Keys to use: ~p\n", [Terms]), + Pairs = lists:map(fun(K) -> list_to_tuple([{K,V} || V <- Terms]) end, Terms), + lists:foreach(fun(Size) -> + MapGen = fun() -> map_gen(list_to_tuple(Pairs), Size) end, + repeat(100, fun do_compare/1, [MapGen, MapGen]) + end, + lists:seq(1,length(Terms))), + ok. + +numeric_keys(N) -> + lists:foldl(fun(_,Acc) -> + Int = rand:uniform(N*4) - N*2, + Float = float(Int), + [Int, Float, Float * 0.99, Float * 1.01 | Acc] + end, + [], + lists:seq(1,N)). + + +repeat(0, _, _) -> + ok; +repeat(N, Fun, Arg) -> + Fun(Arg), + repeat(N-1, Fun, Arg). + +copy_term(T) -> + Papa = self(), + P = spawn_link(fun() -> receive Msg -> Papa ! Msg end end), + P ! T, + receive R -> R end. + +do_compare([Gen1, Gen2]) -> + M1 = Gen1(), + M2 = Gen2(), + %%io:format("Maps to compare: ~p AND ~p\n", [M1, M2]), + C = (M1 < M2), + Erlang = maps_lessthan(M1, M2), + C = Erlang, + ?CHECK(M1==M1, M1), + + %% Change one key from int to float (or vice versa) and check compare + ML1 = maps:to_list(M1), + {K1,V1} = lists:nth(rand:uniform(length(ML1)), ML1), + case K1 of + I when is_integer(I) -> + case maps:find(float(I),M1) of + error -> + M1f = maps:remove(I, maps:put(float(I), V1, M1)), + ?CHECK(M1f > M1, [M1f, M1]); + _ -> ok + end; + + F when is_float(F), round(F) == F -> + case maps:find(round(F),M1) of + error -> + M1i = maps:remove(F, maps:put(round(F), V1, M1)), + ?CHECK(M1i < M1, [M1i, M1]); + _ -> ok + end; + + _ -> ok % skip floats with decimals + end, + + ?CHECK(M2 == M2, [M2]). + + +maps_lessthan(M1, M2) -> + case {maps:size(M1),maps:size(M2)} of + {_S,_S} -> + {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))), + {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))), + + case erts_internal:cmp_term(K1,K2) of + -1 -> true; + 0 -> (V1 < V2); + 1 -> false + end; + + {S1, S2} -> + S1 < S2 + end. + +term_sort(L) -> + lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) =< 0 end, + L). + + +cmp(T1, T2, Exact) when is_tuple(T1) and is_tuple(T2) -> + case {size(T1),size(T2)} of + {_S,_S} -> cmp(tuple_to_list(T1), tuple_to_list(T2), Exact); + {S1,S2} when S1 < S2 -> -1; + {S1,S2} when S1 > S2 -> 1 + end; + +cmp([H1|T1], [H2|T2], Exact) -> + case cmp(H1,H2, Exact) of + 0 -> cmp(T1,T2, Exact); + C -> C + end; + +cmp(M1, M2, Exact) when is_map(M1) andalso is_map(M2) -> + cmp_maps(M1,M2,Exact); +cmp(M1, M2, Exact) -> + cmp_others(M1, M2, Exact). + +cmp_maps(M1, M2, Exact) -> + case {maps:size(M1),maps:size(M2)} of + {_S,_S} -> + {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))), + {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))), + + case cmp(K1, K2, true) of + 0 -> cmp(V1, V2, Exact); + C -> C + end; + + {S1,S2} when S1 < S2 -> -1; + {S1,S2} when S1 > S2 -> 1 + end. + +cmp_others(I, F, true) when is_integer(I), is_float(F) -> + -1; +cmp_others(F, I, true) when is_float(F), is_integer(I) -> + 1; +cmp_others(T1, T2, _) -> + case {T1<T2, T1==T2} of + {true,false} -> -1; + {false,true} -> 0; + {false,false} -> 1 + end. + +map_gen(Pairs, Size) -> + {_,L} = lists:foldl(fun(_, {Keys, Acc}) -> + KI = rand:uniform(size(Keys)), + K = element(KI,Keys), + KV = element(rand:uniform(size(K)), K), + {erlang:delete_element(KI,Keys), [KV | Acc]} + end, + {Pairs, []}, + lists:seq(1,Size)), + + maps:from_list(L). + + +recursive_compare() -> + Leafs = {atom, 17, 16.9, 17.1, [], self(), spawn(fun() -> ok end), make_ref(), make_ref()}, + {A, B} = term_gen_recursive(Leafs, 0, 0), + %%io:format("Recursive term A = ~p\n", [A]), + %%io:format("Recursive term B = ~p\n", [B]), + + ?CHECK({true,false} =:= case do_cmp(A, B, false) of + -1 -> {A<B, A>=B}; + 0 -> {A==B, A/=B}; + 1 -> {A>B, A=<B} + end, + {A,B}), + A2 = copy_term(A), + ?CHECK(A == A2, {A,A2}), + ?CHECK(0 =:= cmp(A, A2, false), {A,A2}), + + B2 = copy_term(B), + ?CHECK(B == B2, {B,B2}), + ?CHECK(0 =:= cmp(B, B2, false), {B,B2}), + ok. + +do_cmp(A, B, Exact) -> + C = cmp(A, B, Exact), + C. + +%% Generate two terms {A,B} that may only differ +%% at float vs integer types. +term_gen_recursive(Leafs, Flags, Depth) -> + MaxDepth = 10, + Rnd = case {Flags, Depth} of + {_, MaxDepth} -> % Only leafs + rand:uniform(size(Leafs)) + 3; + {0, 0} -> % Only containers + rand:uniform(3); + {0,_} -> % Anything + rand:uniform(size(Leafs)+3) + end, + case Rnd of + 1 -> % Make map + Size = rand:uniform(size(Leafs)), + lists:foldl(fun(_, {Acc1,Acc2}) -> + {K1,K2} = term_gen_recursive(Leafs, Flags, + Depth+1), + {V1,V2} = term_gen_recursive(Leafs, Flags, Depth+1), + {maps:put(K1,V1, Acc1), maps:put(K2,V2, Acc2)} + end, + {maps:new(), maps:new()}, + lists:seq(1,Size)); + 2 -> % Make cons + {Car1,Car2} = term_gen_recursive(Leafs, Flags, Depth+1), + {Cdr1,Cdr2} = term_gen_recursive(Leafs, Flags, Depth+1), + {[Car1 | Cdr1], [Car2 | Cdr2]}; + 3 -> % Make tuple + Size = rand:uniform(size(Leafs)), + L = lists:map(fun(_) -> term_gen_recursive(Leafs, Flags, Depth+1) end, + lists:seq(1,Size)), + {L1, L2} = lists:unzip(L), + {list_to_tuple(L1), list_to_tuple(L2)}; + + N -> % Make leaf + case element(N-3, Leafs) of + I when is_integer(I) -> + case rand:uniform(4) of + 1 -> {I, float(I)}; + 2 -> {float(I), I}; + _ -> {I,I} + end; + T -> {T,T} + end + end. + + %% BIFs t_bif_map_get(Config) when is_list(Config) -> - + %% small map 1 = maps:get(a, #{ a=> 1}), 2 = maps:get(b, #{ a=> 1, b => 2}), "hi" = maps:get("hello", #{ a=>1, "hello" => "hi"}), "tuple hi" = maps:get({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), - M = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), - "v4" = maps:get(<<"k2">>, M#{ <<"k2">> => "v4" }), + M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + "v4" = maps:get(<<"k2">>, M0#{<<"k2">> => "v4"}), - %% error case - {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,[])), - {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,<<>>)), - {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), - {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{})), - {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{ b=>1, c=>2})), + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + 1 = maps:get(a, M1), + 2 = maps:get(b, M1), + "hi" = maps:get("hello", M1), + "tuple hi" = maps:get({1,1.0}, M1), + "v3" = maps:get(<<"k2">>, M1), + + %% error cases + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,get,_,_}|_]}} = + (catch maps:get(a, T)) + end), + + {'EXIT',{{badkey,{1,1}},[{maps,get,_,_}|_]}} = + (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), + {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = (catch maps:get(a, #{})), + {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = + (catch maps:get(a, #{b=>1, c=>2})), ok. t_bif_map_find(Config) when is_list(Config) -> - + %% small map {ok, 1} = maps:find(a, #{ a=> 1}), {ok, 2} = maps:find(b, #{ a=> 1, b => 2}), {ok, "int"} = maps:find(1, #{ 1 => "int"}), @@ -498,8 +1772,18 @@ t_bif_map_find(Config) when is_list(Config) -> {ok, "hi"} = maps:find("hello", #{ a=>1, "hello" => "hi"}), {ok, "tuple hi"} = maps:find({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), - M = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), - {ok, "v4"} = maps:find(<<"k2">>, M#{ <<"k2">> => "v4" }), + M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + {ok, "v4"} = maps:find(<<"k2">>, M0#{ <<"k2">> => "v4" }), + + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + {ok, 1} = maps:find(a, M1), + {ok, 2} = maps:find(b, M1), + {ok, "hi"} = maps:find("hello", M1), + {ok, "tuple hi"} = maps:find({1,1.0}, M1), + {ok, "v3"} = maps:find(<<"k2">>, M1), %% error case error = maps:find(a,#{}), @@ -508,9 +1792,10 @@ t_bif_map_find(Config) when is_list(Config) -> error = maps:find(1, #{ 1.0 => "float"}), error = maps:find({1.0,1}, #{ a=>a, {1,1.0} => "tuple hi"}), % reverse types in tuple key - - {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id([]))), - {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id(<<>>))), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,find,_,_}|_]}} = + (catch maps:find(a, T)) + end), ok. @@ -535,26 +1820,27 @@ t_bif_map_is_key(Config) when is_list(Config) -> false = maps:is_key(1.0, maps:put(1, "number", M1)), %% error case - {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id([]))), - {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id(<<>>))), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,is_key,_,_}|_]}} = + (catch maps:is_key(a, T)) + end), ok. t_bif_map_keys(Config) when is_list(Config) -> [] = maps:keys(#{}), - [1,2,3,4,5] = maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), - [1,2,3,4,5] = maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + [1,2,3,4,5] = lists:sort(maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + [1,2,3,4,5] = lists:sort(maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), % values in key order: [4,int,"hi",<<"key">>] M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, - [4,int,"hi",<<"key">>] = maps:keys(M1), + [4,int,"hi",<<"key">>] = lists:sort(maps:keys(M1)), %% error case - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(154)), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(atom)), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys([])), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(<<>>)), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,keys,_,_}|_]}} = + (catch maps:keys(T)) + end), ok. t_bif_map_new(Config) when is_list(Config) -> @@ -582,11 +1868,58 @@ t_bif_map_merge(Config) when is_list(Config) -> #{4 := integer, 18446744073709551629 := wat, float := 3.3, int := 3, {1,2} := "tuple", "hi" := "hello again", <<"key">> := <<"value">>} = maps:merge(M0,M1), - %% error case - {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge((1 bsl 65 + 3), <<>>)), - {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(<<>>, id(#{ a => 1}))), - {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(id(#{ a => 2}), <<>> )), + %% try deep collisions + N = 150000, + Is = lists:seq(1,N), + M2 = maps:from_list([{I,I}||I<-Is]), + 150000 = maps:size(M2), + M3 = maps:from_list([{<<I:32>>,I}||I<-Is]), + 150000 = maps:size(M3), + M4 = maps:merge(M2,M3), + 300000 = maps:size(M4), + M5 = maps:from_list([{integer_to_list(I),I}||I<-Is]), + 150000 = maps:size(M5), + M6 = maps:merge(M4,M5), + 450000 = maps:size(M6), + M7 = maps:from_list([{float(I),I}||I<-Is]), + 150000 = maps:size(M7), + M8 = maps:merge(M7,M6), + 600000 = maps:size(M8), + + #{ 1 := 1, "1" := 1, <<1:32>> := 1 } = M8, + #{ 10 := 10, "10" := 10, <<10:32>> := 10 } = M8, + #{ 100 := 100, "100" := 100, <<100:32>> := 100 } = M8, + #{ 1000 := 1000, "1000" := 1000, <<1000:32>> := 1000 } = M8, + #{ 10000 := 10000, "10000" := 10000, <<10000:32>> := 10000 } = M8, + #{ 100000 := 100000, "100000" := 100000, <<100000:32>> := 100000 } = M8, + + %% overlapping + M8 = maps:merge(M2,M8), + M8 = maps:merge(M3,M8), + M8 = maps:merge(M4,M8), + M8 = maps:merge(M5,M8), + M8 = maps:merge(M6,M8), + M8 = maps:merge(M7,M8), + M8 = maps:merge(M8,M8), + + %% maps:merge/2 and mixed + + Ks1 = [764492191,2361333849], %% deep collision + Ks2 = lists:seq(1,33), + M9 = maps:from_list([{K,K}||K <- Ks1]), + M10 = maps:from_list([{K,K}||K <- Ks2]), + M11 = maps:merge(M9,M10), + ok = check_keys_exist(Ks1 ++ Ks2, M11), + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(#{}, T)), + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(T, #{})), + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(T, T)) + end), ok. @@ -596,63 +1929,70 @@ t_bif_map_put(Config) when is_list(Config) -> M1 = #{ "hi" := "hello"} = maps:put("hi", "hello", #{}), - ["hi"] = maps:keys(M1), - ["hello"] = maps:values(M1), + true = is_members(["hi"],maps:keys(M1)), + true = is_members(["hello"],maps:values(M1)), M2 = #{ int := 3 } = maps:put(int, 3, M1), - [int,"hi"] = maps:keys(M2), - [3,"hello"] = maps:values(M2), + true = is_members([int,"hi"],maps:keys(M2)), + true = is_members([3,"hello"],maps:values(M2)), M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2), - [int,"hi",<<"key">>] = maps:keys(M3), - [3,"hello",<<"value">>] = maps:values(M3), + true = is_members([int,"hi",<<"key">>],maps:keys(M3)), + true = is_members([3,"hello",<<"value">>],maps:values(M3)), M4 = #{ 18446744073709551629 := wat } = maps:put(18446744073709551629, wat, M3), - [18446744073709551629,int,"hi",<<"key">>] = maps:keys(M4), - [wat,3,"hello",<<"value">>] = maps:values(M4), + true = is_members([18446744073709551629,int,"hi",<<"key">>],maps:keys(M4)), + true = is_members([wat,3,"hello",<<"value">>],maps:values(M4)), M0 = #{ 4 := number } = M5 = maps:put(4, number, M4), - [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M5), - [number,wat,3,"hello",<<"value">>] = maps:values(M5), + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M5)), + true = is_members([number,wat,3,"hello",<<"value">>],maps:values(M5)), M6 = #{ <<"key">> := <<"other value">> } = maps:put(<<"key">>, <<"other value">>, M5), - [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M6), - [number,wat,3,"hello",<<"other value">>] = maps:values(M6), + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M6)), + true = is_members([number,wat,3,"hello",<<"other value">>],maps:values(M6)), %% error case - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,154)), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,atom)), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,[])), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,<<>>)), - ok. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,put,_,_}|_]}} = + (catch maps:put(1, a, T)) + end), + ok. + +is_members(Ks,Ls) when length(Ks) =/= length(Ls) -> false; +is_members(Ks,Ls) -> is_members_do(Ks,Ls). + +is_members_do([],[]) -> true; +is_members_do([],_) -> false; +is_members_do([K|Ks],Ls) -> + is_members_do(Ks, lists:delete(K,Ls)). t_bif_map_remove(Config) when is_list(Config) -> 0 = erlang:map_size(maps:remove(some_key, #{})), M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, - 4 => number, 18446744073709551629 => wat}, + 4 => number, 18446744073709551629 => wat}, M1 = maps:remove("hi", M0), - [4,18446744073709551629,int,<<"key">>] = maps:keys(M1), - [number,wat,3,<<"value">>] = maps:values(M1), + true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), + true = is_members([number,wat,3,<<"value">>],maps:values(M1)), M2 = maps:remove(int, M1), - [4,18446744073709551629,<<"key">>] = maps:keys(M2), - [number,wat,<<"value">>] = maps:values(M2), + true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)), + true = is_members([number,wat,<<"value">>],maps:values(M2)), M3 = maps:remove(<<"key">>, M2), - [4,18446744073709551629] = maps:keys(M3), - [number,wat] = maps:values(M3), + true = is_members([4,18446744073709551629],maps:keys(M3)), + true = is_members([number,wat],maps:values(M3)), M4 = maps:remove(18446744073709551629, M3), - [4] = maps:keys(M4), - [number] = maps:values(M4), + true = is_members([4],maps:keys(M4)), + true = is_members([number],maps:values(M4)), M5 = maps:remove(4, M4), [] = maps:keys(M5), @@ -664,12 +2004,72 @@ t_bif_map_remove(Config) when is_list(Config) -> #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)), %% error case - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,154)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,atom)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,[])), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,<<>>)), - ok. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = (catch maps:remove(a, T)) + end), + ok. + +t_bif_map_take(Config) when is_list(Config) -> + error = maps:take(some_key, #{}), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + 5 = maps:size(M0), + {"hello", M1} = maps:take("hi", M0), + true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), + true = is_members([number,wat,3,<<"value">>],maps:values(M1)), + error = maps:take("hi", M1), + 4 = maps:size(M1), + + {3, M2} = maps:take(int, M1), + true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)), + true = is_members([number,wat,<<"value">>],maps:values(M2)), + error = maps:take(int, M2), + 3 = maps:size(M2), + + {<<"value">>,M3} = maps:take(<<"key">>, M2), + true = is_members([4,18446744073709551629],maps:keys(M3)), + true = is_members([number,wat],maps:values(M3)), + error = maps:take(<<"key">>, M3), + 2 = maps:size(M3), + + {wat,M4} = maps:take(18446744073709551629, M3), + true = is_members([4],maps:keys(M4)), + true = is_members([number],maps:values(M4)), + error = maps:take(18446744073709551629, M4), + 1 = maps:size(M4), + + {number,M5} = maps:take(4, M4), + [] = maps:keys(M5), + [] = maps:values(M5), + error = maps:take(4, M5), + 0 = maps:size(M5), + + {wat,#{ "hi" := "hello", int := 3, 4 := number, <<"key">> := <<"value">>}} = maps:take(18446744073709551629,M0), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,take,_,_}|_]}} = (catch maps:take(a, T)) + end), + ok. + +t_bif_map_take_large(Config) when is_list(Config) -> + KVs = [{{erlang:md5(<<I:64>>),I}, I}|| I <- lists:seq(1,500)], + M0 = maps:from_list(KVs), + ok = bif_map_take_all(KVs, M0), + ok. + +bif_map_take_all([], M0) -> + 0 = maps:size(M0), + ok; +bif_map_take_all([{K,V}|KVs],M0) -> + {ok,V} = maps:find(K,M0), + {V,M1} = maps:take(K,M0), + error = maps:find(K,M1), + error = maps:take(K,M1), + bif_map_take_all(KVs,M1). + t_bif_map_update(Config) when is_list(Config) -> M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, @@ -691,10 +2091,10 @@ t_bif_map_update(Config) when is_list(Config) -> 4 := number, 18446744073709551629 := wazzup} = maps:update(18446744073709551629, wazzup, M0), %% error case - {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,{})), - {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,<<"value">>)), - {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(5,none,M0)), - + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,update,_,_}|_]}} = + (catch maps:update(1, none, T)) + end), ok. @@ -702,92 +2102,77 @@ t_bif_map_update(Config) when is_list(Config) -> t_bif_map_values(Config) when is_list(Config) -> [] = maps:values(#{}), + [1] = maps:values(#{a=>1}), - [a,b,c,d,e] = maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), - [a,b,c,d,e] = maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + true = is_members([a,b,c,d,e],maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + true = is_members([a,b,c,d,e],maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), - % values in key order: [4,int,"hi",<<"key">>] M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> }, - [number,3,"hello2",<<"value2">>] = maps:values(M2), - [number,3,"hello",<<"value">>] = maps:values(M1), + true = is_members([number,3,"hello2",<<"value2">>],maps:values(M2)), + true = is_members([number,3,"hello",<<"value">>],maps:values(M1)), + + Vs = lists:seq(1000,20000), + M3 = maps:from_list([{K,K}||K<-Vs]), + M4 = maps:merge(M1,M3), + M5 = maps:merge(M2,M3), + true = is_members(Vs,maps:values(M3)), + true = is_members([number,3,"hello",<<"value">>]++Vs,maps:values(M4)), + true = is_members([number,3,"hello2",<<"value2">>]++Vs,maps:values(M5)), %% error case - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(atom)), - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values([])), - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(<<>>)), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,values,_,_}|_]}} = + (catch maps:values(T)) + end), ok. t_erlang_hash(Config) when is_list(Config) -> ok = t_bif_erlang_phash2(), ok = t_bif_erlang_phash(), - ok = t_bif_erlang_hash(), - ok. t_bif_erlang_phash2() -> 39679005 = erlang:phash2(#{}), - 78942764 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), - 37338230 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), - 14363616 = erlang:phash2(#{ 1 => a }), - 51612236 = erlang:phash2(#{ a => 1 }), + 33667975 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), % 78942764 + 95332690 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), % 37338230 + 108954384 = erlang:phash2(#{ 1 => a }), % 14363616 + 59617982 = erlang:phash2(#{ a => 1 }), % 51612236 - 37468437 = erlang:phash2(#{{} => <<>>}), - 44049159 = erlang:phash2(#{<<>> => {}}), + 42770201 = erlang:phash2(#{{} => <<>>}), % 37468437 + 71687700 = erlang:phash2(#{<<>> => {}}), % 44049159 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 118679416 = erlang:phash2(M0), - 51612236 = erlang:phash2(M1), - 118679416 = erlang:phash2(M2), + 70249457 = erlang:phash2(M0), % 118679416 + 59617982 = erlang:phash2(M1), % 51612236 + 70249457 = erlang:phash2(M2), % 118679416 ok. t_bif_erlang_phash() -> Sz = 1 bsl 32, - 268440612 = erlang:phash(#{},Sz), - 1196461908 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), - 3944426064 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), - 1394238263 = erlang:phash(#{ 1 => a },Sz), - 4066388227 = erlang:phash(#{ a => 1 },Sz), - - 1578050717 = erlang:phash(#{{} => <<>>},Sz), - 1578050717 = erlang:phash(#{<<>> => {}},Sz), % yep, broken - - M0 = #{ a => 1, "key" => <<"value">> }, - M1 = maps:remove("key",M0), - M2 = M1#{ "key" => <<"value">> }, - - 3590546636 = erlang:phash(M0,Sz), - 4066388227 = erlang:phash(M1,Sz), - 3590546636 = erlang:phash(M2,Sz), - ok. - -t_bif_erlang_hash() -> - Sz = 1 bsl 27 - 1, - 5158 = erlang:hash(#{},Sz), - 71555838 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), - 5497225 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), - 126071654 = erlang:hash(#{ 1 => a },Sz), - 126426236 = erlang:hash(#{ a => 1 },Sz), + 1113425985 = erlang:phash(#{},Sz), % 268440612 + 1510068139 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 1196461908 + 3182345590 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 3944426064 + 2927531828 = erlang:phash(#{ 1 => a },Sz), % 1394238263 + 1670235874 = erlang:phash(#{ a => 1 },Sz), % 4066388227 - 101655720 = erlang:hash(#{{} => <<>>},Sz), - 101655720 = erlang:hash(#{<<>> => {}},Sz), % yep, broken + 3935089469 = erlang:phash(#{{} => <<>>},Sz), % 1578050717 + 71692856 = erlang:phash(#{<<>> => {}},Sz), % 1578050717 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 38260486 = erlang:hash(M0,Sz), - 126426236 = erlang:hash(M1,Sz), - 38260486 = erlang:hash(M2,Sz), + 2620391445 = erlang:phash(M0,Sz), % 3590546636 + 1670235874 = erlang:phash(M1,Sz), % 4066388227 + 2620391445 = erlang:phash(M2,Sz), % 3590546636 ok. - t_map_encode_decode(Config) when is_list(Config) -> <<131,116,0,0,0,0>> = erlang:term_to_binary(#{}), Pairs = [ @@ -805,7 +2190,9 @@ t_map_encode_decode(Config) when is_list(Config) -> {<<>>, sc9}, {3.14158, sc10}, {[3.14158], sc11}, {more_atoms, sc12}, {{more_tuples}, sc13}, {self(), sc14}, - {{},{}},{[],[]} + {{},{}},{[],[]}, + {map_s, #{a=>a, 2=>b, 3=>c}}, + {map_l, maps:from_list([{I,I}||I <- lists:seq(1,74)])} ], ok = map_encode_decode_and_match(Pairs,[],#{}), @@ -818,14 +2205,35 @@ t_map_encode_decode(Config) when is_list(Config) -> %% literally #{ "hi" => "value", a=>33, b=>55 } in the internal order #{ a:=33, b:=55, "hi" := "value"} = erlang:binary_to_term(<<131,116,0,0,0,3, - 107,0,2,104,105, % "hi" :: list() + 107,0,2,104,105, % "hi" :: list() 107,0,5,118,97,108,117,101, % "value" :: list() - 100,0,1,97, % a :: atom() - 97,33, % 33 :: integer() - 100,0,1,98, % b :: atom() - 97,55 % 55 :: integer() + 100,0,1,97, % a :: atom() + 97,33, % 33 :: integer() + 100,0,1,98, % b :: atom() + 97,55 % 55 :: integer() >>), + %% Maps of different sizes + lists:foldl(fun(Key, M0) -> + M1 = M0#{Key => Key}, + case Key rem 17 of + 0 -> + M1 = binary_to_term(term_to_binary(M1)); + _ -> + ok + end, + M1 + end, + #{}, + lists:seq(1,10000)), + + %% many maps in same binary + MapList = lists:foldl(fun(K, [M|_]=Acc) -> [M#{K => K} | Acc] end, + [#{}], + lists:seq(1,100)), + MapList = binary_to_term(term_to_binary(MapList)), + MapListR = lists:reverse(MapList), + MapListR = binary_to_term(term_to_binary(MapListR)), %% error cases %% template: <<131,116,0,0,0,2,100,0,1,97,100,0,1,98,97,1,97,1>> @@ -848,51 +2256,77 @@ t_map_encode_decode(Config) when is_list(Config) -> %% bad size (too small) .. should fail just truncate it .. weird. %% possibly change external format so truncated will be #{a:=1} - #{ a:=b } = - erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>), - + #{ a:=b } = erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>), + + %% specific fannerl (opensource app) binary_to_term error in 18.1 + + #{bias := {1,1,0}, + bit_fail := 0, + connections := #{{2,9} := _, + {8,14} := _, + {2,12} := _, + {5,7} := _, + {11,16} := _, + {11,15} := _}, + layers := {5,7,3}, + network_type := fann_nettype_layer, + num_input := 5, + num_layers := 3, + num_output := 3, + rprop_delta_max := _, + rprop_delta_min := _, + total_connections := 66, + total_neurons := 17, + train_error_function := fann_errorfunc_tanh, + train_stop_function := fann_stopfunc_mse, + training_algorithm := fann_train_rprop} = erlang:binary_to_term(fannerl()), ok. map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> M1 = maps:put(K,V,M0), B0 = erlang:term_to_binary(M1), - Ls = lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, [{K, erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs]), - %% sort Ks and Vs according to term spec, then match it - KVbins = lists:foldr(fun({_,Kbin,Vbin}, Acc) -> [Kbin,Vbin | Acc] end, [], Ls), - ok = match_encoded_map(B0, length(Ls), KVbins), + Ls = [{erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs], + ok = match_encoded_map(B0, length(Ls), Ls), %% decode and match it M1 = erlang:binary_to_term(B0), map_encode_decode_and_match(Pairs,Ls,M1); map_encode_decode_and_match([],_,_) -> ok. match_encoded_map(<<131,116,Size:32,Encoded/binary>>,Size,Items) -> - match_encoded_map(Encoded,Items); + match_encoded_map_stripped_size(Encoded,Items,Items); match_encoded_map(_,_,_) -> no_match_size. -match_encoded_map(<<>>,[]) -> ok; -match_encoded_map(Bin,[<<131,Item/binary>>|Items]) -> - Size = erlang:byte_size(Item), - <<EncodedTerm:Size/binary, Bin1/binary>> = Bin, - EncodedTerm = Item, %% Asssert - match_encoded_map(Bin1,Items). +match_encoded_map_stripped_size(<<>>,_,_) -> ok; +match_encoded_map_stripped_size(B0,[{<<131,K/binary>>,<<131,V/binary>>}|Items],Ls) -> + Ksz = byte_size(K), + Vsz = byte_size(V), + case B0 of + <<K:Ksz/binary,V:Vsz/binary,B1/binary>> -> + match_encoded_map_stripped_size(B1,Ls,Ls); + _ -> + match_encoded_map_stripped_size(B0,Items,Ls) + end; +match_encoded_map_stripped_size(_,[],_) -> fail. t_bif_map_to_list(Config) when is_list(Config) -> [] = maps:to_list(#{}), - [{a,1},{b,2}] = maps:to_list(#{a=>1,b=>2}), - [{a,1},{b,2},{c,3}] = maps:to_list(#{c=>3,a=>1,b=>2}), - [{a,1},{b,2},{g,3}] = maps:to_list(#{g=>3,a=>1,b=>2}), - [{a,1},{b,2},{g,3},{"c",4}] = maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4}), - [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = maps:to_list(#{ - <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5}), + [{a,1},{b,2}] = lists:sort(maps:to_list(#{a=>1,b=>2})), + [{a,1},{b,2},{c,3}] = lists:sort(maps:to_list(#{c=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3},{"c",4}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4})), + [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5})), - [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = maps:to_list(#{ - <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, - <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10}), + [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, + <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10})), %% error cases - {'EXIT', {badarg,_}} = (catch maps:to_list(id(a))), - {'EXIT', {badarg,_}} = (catch maps:to_list(id(42))), + do_badmap(fun(T) -> + {'EXIT', {{badmap,T},_}} = + (catch maps:to_list(T)) + end), ok. @@ -901,7 +2335,7 @@ t_bif_map_from_list(Config) when is_list(Config) -> A = maps:from_list([]), 0 = erlang:map_size(A), - #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]), + #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]), #{c:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{c,3}]), #{g:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{g,3}]), @@ -914,6 +2348,13 @@ t_bif_map_from_list(Config) when is_list(Config) -> maps:from_list([ {{hi,3},v3}, {"hi",v0},{3,v1}, {<<"hi">>,v4}, {hi,v2}, {<<"hi">>,v6}, {{hi,3},v10},{"hi",v11}, {hi,v9}, {3,v8}]), + %% repeated keys (large -> small) + Ps1 = [{a,I}|| I <- lists:seq(1,32)], + Ps2 = [{a,I}|| I <- lists:seq(33,64)], + + M = maps:from_list(Ps1 ++ [{b,1},{c,1}] ++ Ps2), + #{ a := 64, b := 1, c := 1 } = M, + %% error cases {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},b]))), {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},{b,b,3}]))), @@ -923,6 +2364,216 @@ t_bif_map_from_list(Config) when is_list(Config) -> {'EXIT', {badarg,_}} = (catch maps:from_list(id(42))), ok. +t_bif_erts_internal_maps_to_list(Config) when is_list(Config) -> + %% small maps + [] = erts_internal:maps_to_list(#{},-1), + [] = erts_internal:maps_to_list(#{},-2), + [] = erts_internal:maps_to_list(#{},10), + [{a,1},{b,2}] = lists:sort(erts_internal:maps_to_list(#{a=>1,b=>2}, 2)), + [{a,1},{b,2}] = lists:sort(erts_internal:maps_to_list(#{a=>1,b=>2}, -1)), + [{_,_}] = erts_internal:maps_to_list(#{a=>1,b=>2}, 1), + [{a,1},{b,2},{c,3}] = lists:sort(erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},-2)), + [{a,1},{b,2},{c,3}] = lists:sort(erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},3)), + [{a,1},{b,2},{c,3}] = lists:sort(erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},5)), + [{_,_},{_,_}] = erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},2), + [{_,_}] = erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},1), + [] = erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},0), + + %% big maps + M = maps:from_list([{I,ok}||I <- lists:seq(1,500)]), + [] = erts_internal:maps_to_list(M,0), + [{_,_}] = erts_internal:maps_to_list(M,1), + [{_,_},{_,_}] = erts_internal:maps_to_list(M,2), + Ls1 = erts_internal:maps_to_list(M,10), + 10 = length(Ls1), + Ls2 = erts_internal:maps_to_list(M,20), + 20 = length(Ls2), + Ls3 = erts_internal:maps_to_list(M,120), + 120 = length(Ls3), + Ls4 = erts_internal:maps_to_list(M,-1), + 500 = length(Ls4), + + %% error cases + {'EXIT', {{badmap,[{a,b},b]},_}} = (catch erts_internal:maps_to_list(id([{a,b},b]),id(1))), + {'EXIT', {badarg,_}} = (catch erts_internal:maps_to_list(id(#{}),id(a))), + {'EXIT', {badarg,_}} = (catch erts_internal:maps_to_list(id(#{1=>2}),id(<<>>))), + ok. + +t_bif_build_and_check(Config) when is_list(Config) -> + ok = check_build_and_remove(750,[fun(K) -> [K,K] end, + fun(K) -> [float(K),K] end, + fun(K) -> K end, + fun(K) -> {1,K} end, + fun(K) -> {K} end, + fun(K) -> [K|K] end, + fun(K) -> [K,1,2,3,4] end, + fun(K) -> {K,atom} end, + fun(K) -> float(K) end, + fun(K) -> integer_to_list(K) end, + fun(K) -> list_to_atom(integer_to_list(K)) end, + fun(K) -> [K,{K,[K,{K,[K]}]}] end, + fun(K) -> <<K:32>> end]), + ok. + +check_build_and_remove(_,[]) -> ok; +check_build_and_remove(N,[F|Fs]) -> + {M,Ks} = build_and_check(N, maps:new(), F, []), + ok = remove_and_check(Ks,M), + check_build_and_remove(N,Fs). + +build_and_check(0, M0, _, Ks) -> {M0, Ks}; +build_and_check(N, M0, F, Ks) -> + K = build_key(F,N), + M1 = maps:put(K,K,M0), + ok = check_keys_exist([I||{I,_} <- [{K,M1}|Ks]], M1), + M2 = maps:update(K,v,M1), + v = maps:get(K,M2), + build_and_check(N-1,M1,F,[{K,M1}|Ks]). + +remove_and_check([],_) -> ok; +remove_and_check([{K,Mc}|Ks], M0) -> + K = maps:get(K,M0), + true = maps:is_key(K,M0), + true = Mc =:= M0, + true = M0 == Mc, + M1 = maps:remove(K,M0), + false = M1 =:= Mc, + false = Mc == M1, + false = maps:is_key(K,M1), + true = maps:is_key(K,M0), + ok = check_keys_exist([I||{I,_} <- Ks],M1), + error = maps:find(K,M1), + remove_and_check(Ks, M1). + +build_key(F,N) when N rem 3 =:= 0 -> F(N); +build_key(F,N) when N rem 3 =:= 1 -> K = F(N), {K,K}; +build_key(F,N) when N rem 3 =:= 2 -> K = F(N), [K,K]. + +check_keys_exist([], _) -> ok; +check_keys_exist([K|Ks],M) -> + true = maps:is_key(K,M), + check_keys_exist(Ks,M). + +t_bif_merge_and_check(Config) when is_list(Config) -> + + io:format("rand:export_seed() -> ~p\n",[rand:export_seed()]), + + %% simple disjunct ones + %% make sure all keys are unique + Kss = [[a,b,c,d], + [1,2,3,4], + [], + ["hi"], + [e], + [build_key(fun(K) -> {small,K} end, I) || I <- lists:seq(1,32)], + lists:seq(5, 28), + lists:seq(29, 59), + [build_key(fun(K) -> integer_to_list(K) end, I) || I <- lists:seq(2000,10000)], + [build_key(fun(K) -> <<K:32>> end, I) || I <- lists:seq(1,80)], + [build_key(fun(K) -> {<<K:32>>} end, I) || I <- lists:seq(100,1000)]], + + + KsMs = build_keys_map_pairs(Kss), + Cs = [{CKs1,CM1,CKs2,CM2} || {CKs1,CM1} <- KsMs, {CKs2,CM2} <- KsMs], + ok = merge_and_check_combo(Cs), + + %% overlapping ones + + KVs1 = [{a,1},{b,2},{c,3}], + KVs2 = [{b,3},{c,4},{d,5}], + KVs = [{I,I} || I <- lists:seq(1,32)], + KVs3 = KVs1 ++ KVs, + KVs4 = KVs2 ++ KVs, + + M1 = maps:from_list(KVs1), + M2 = maps:from_list(KVs2), + M3 = maps:from_list(KVs3), + M4 = maps:from_list(KVs4), + + M12 = maps:merge(M1,M2), + ok = check_key_values(KVs2 ++ [{a,1}], M12), + M21 = maps:merge(M2,M1), + ok = check_key_values(KVs1 ++ [{d,5}], M21), + + M34 = maps:merge(M3,M4), + ok = check_key_values(KVs4 ++ [{a,1}], M34), + M43 = maps:merge(M4,M3), + ok = check_key_values(KVs3 ++ [{d,5}], M43), + + M14 = maps:merge(M1,M4), + ok = check_key_values(KVs4 ++ [{a,1}], M14), + M41 = maps:merge(M4,M1), + ok = check_key_values(KVs1 ++ [{d,5}] ++ KVs, M41), + + [begin Ma = random_map(SzA, a), + Mb = random_map(SzB, b), + ok = merge_maps(Ma, Mb) + end || SzA <- [3,10,20,100,200,1000], SzB <- [3,10,20,100,200,1000]], + + ok. + +% Generate random map with an average of Sz number of pairs: K -> {V,K} +random_map(Sz, V) -> + random_map_insert(#{}, 0, V, Sz*2). + +random_map_insert(M0, K0, _, Sz) when K0 > Sz -> + M0; +random_map_insert(M0, K0, V, Sz) -> + Key = K0 + rand:uniform(3), + random_map_insert(M0#{Key => {V,Key}}, Key, V, Sz). + + +merge_maps(A, B) -> + AB = maps:merge(A, B), + %%io:format("A=~p\nB=~p\n",[A,B]), + maps_foreach(fun(K,VB) -> VB = maps:get(K, AB) + end, B), + maps_foreach(fun(K,VA) -> + case {maps:get(K, AB),maps:find(K, B)} of + {VA, error} -> ok; + {VB, {ok, VB}} -> ok + end + end, A), + + maps_foreach(fun(K,V) -> + case {maps:find(K, A),maps:find(K, B)} of + {{ok, V}, error} -> ok; + {error, {ok, V}} -> ok; + {{ok,_}, {ok, V}} -> ok + end + end, AB), + ok. + +maps_foreach(Fun, Map) -> + maps:fold(fun(K,V,_) -> Fun(K,V) end, void, Map). + + +check_key_values([],_) -> ok; +check_key_values([{K,V}|KVs],M) -> + V = maps:get(K,M), + check_key_values(KVs,M). + +merge_and_check_combo([]) -> ok; +merge_and_check_combo([{Ks1,M1,Ks2,M2}|Cs]) -> + M12 = maps:merge(M1,M2), + ok = check_keys_exist(Ks1 ++ Ks2, M12), + M21 = maps:merge(M2,M1), + ok = check_keys_exist(Ks1 ++ Ks2, M21), + + true = M12 =:= M21, + M12 = M21, + + merge_and_check_combo(Cs). + +build_keys_map_pairs([]) -> []; +build_keys_map_pairs([Ks|Kss]) -> + M = maps:from_list(keys_to_pairs(Ks)), + ok = check_keys_exist(Ks, M), + [{Ks,M}|build_keys_map_pairs(Kss)]. + +keys_to_pairs(Ks) -> [{K,K} || K <- Ks]. + + %% Maps module, not BIFs t_maps_fold(_Config) -> Vs = lists:seq(1,100), @@ -960,6 +2611,191 @@ t_maps_without(_Config) -> %% MISC + +%% Verify that the the number of nodes in hashmaps +%% of different types and sizes does not deviate too +%% much from the theoretical model. +t_hashmap_balance(_Config) -> + io:format("Integer keys\n", []), + hashmap_balance(fun(I) -> I end), + io:format("Float keys\n", []), + hashmap_balance(fun(I) -> float(I) end), + io:format("String keys\n", []), + hashmap_balance(fun(I) -> integer_to_list(I) end), + io:format("Binary (big) keys\n", []), + hashmap_balance(fun(I) -> <<I:16/big>> end), + io:format("Binary (little) keys\n", []), + hashmap_balance(fun(I) -> <<I:16/little>> end), + io:format("Atom keys\n", []), + erts_debug:set_internal_state(available_internal_state, true), + hashmap_balance(fun(I) -> erts_debug:get_internal_state({atom,I}) end), + erts_debug:set_internal_state(available_internal_state, false), + + ok. + +hashmap_balance(KeyFun) -> + F = fun(I, {M0,Max0}) -> + Key = KeyFun(I), + M1 = M0#{Key => Key}, + Max1 = case erts_internal:term_type(M1) of + hashmap -> + Nodes = hashmap_nodes(M1), + Avg = maps:size(M1) * 0.4, + StdDev = math:sqrt(maps:size(M1)) / 3, + SD_diff = abs(Nodes - Avg) / StdDev, + %%io:format("~p keys: ~p nodes avg=~p SD_diff=~p\n", + %% [maps:size(M1), Nodes, Avg, SD_diff]), + {MaxDiff0, _} = Max0, + case {Nodes > Avg, SD_diff > MaxDiff0} of + {true, true} -> {SD_diff, M1}; + _ -> Max0 + end; + + flatmap -> Max0 + end, + {M1, Max1} + end, + + {_,{MaxDiff,MaxMap}} = lists:foldl(F, + {#{}, {0, 0}}, + lists:seq(1,10000)), + io:format("Max std dev diff ~p for map of size ~p (nodes=~p, flatsize=~p)\n", + [MaxDiff, maps:size(MaxMap), hashmap_nodes(MaxMap), erts_debug:flat_size(MaxMap)]), + + true = (MaxDiff < 6), % The probability of this line failing is about 0.000000001 + % for a uniform hash. I've set the probability this "high" for now + % to detect flaws in our make_internal_hash. + % Hard limit is 15 (see hashmap_over_estimated_heap_size). + ok. + +hashmap_nodes(M) -> + Info = erts_debug:map_info(M), + lists:foldl(fun(Tpl,Acc) -> + case element(1,Tpl) of + bitmaps -> Acc + element(2,Tpl); + arrays -> Acc + element(2,Tpl); + _ -> Acc + end + end, + 0, + Info). + +t_erts_internal_order(_Config) when is_list(_Config) -> + + -1 = erts_internal:cmp_term(1,2), + 1 = erts_internal:cmp_term(2,1), + 0 = erts_internal:cmp_term(2,2), + + + -1 = erts_internal:cmp_term(1,a), + 1 = erts_internal:cmp_term(a,1), + 0 = erts_internal:cmp_term(a,a), + + -1 = erts_internal:cmp_term(1,1.0), + 1 = erts_internal:cmp_term(1.0,1), + 0 = erts_internal:cmp_term(1.0,1.0), + + -1 = erts_internal:cmp_term(1,1 bsl 65), + 1 = erts_internal:cmp_term(1 bsl 65,1), + 0 = erts_internal:cmp_term(1 bsl 65, 1 bsl 65), + + -1 = erts_internal:cmp_term(1 bsl 65,float(1)), + 1 = erts_internal:cmp_term(float(1),1 bsl 65), + -1 = erts_internal:cmp_term(1,float(1 bsl 65)), + 1 = erts_internal:cmp_term(float(1 bsl 65),1), + 0 = erts_internal:cmp_term(float(1 bsl 65), float(1 bsl 65)), + + %% reported errors + -1 = erts_internal:cmp_term(0,2147483648), + 0 = erts_internal:cmp_term(2147483648,2147483648), + 1 = erts_internal:cmp_term(2147483648,0), + + M = #{0 => 0,2147483648 => 0}, + true = M =:= binary_to_term(term_to_binary(M)), + + F1 = fun(_, _) -> 0 end, + F2 = fun(_, _) -> 1 end, + M0 = maps:from_list( [{-2147483649, 0}, {0,0}, {97, 0}, {false, 0}, {flower, 0}, {F1, 0}, {F2, 0}, {<<>>, 0}]), + M1 = maps:merge(M0, #{0 => 1}), + 8 = maps:size(M1), + 1 = maps:get(0,M1), + ok. + +t_erts_internal_hash(_Config) when is_list(_Config) -> + K1 = 0.0, + K2 = 0.0/-1, + M = maps:from_list([{I,I}||I<-lists:seq(1,32)]), + + M1 = M#{ K1 => a, K2 => b }, + b = maps:get(K2,M1), + + M2 = M#{ K2 => a, K1 => b }, + b = maps:get(K1,M2), + + %% test previously faulty hash list optimization + + M3 = M#{[0] => a, [0,0] => b, [0,0,0] => c, [0,0,0,0] => d}, + a = maps:get([0],M3), + b = maps:get([0,0],M3), + c = maps:get([0,0,0],M3), + d = maps:get([0,0,0,0],M3), + + M4 = M#{{[0]} => a, {[0,0]} => b, {[0,0,0]} => c, {[0,0,0,0]} => d}, + a = maps:get({[0]},M4), + b = maps:get({[0,0]},M4), + c = maps:get({[0,0,0]},M4), + d = maps:get({[0,0,0,0]},M4), + + M5 = M3#{[0,0,0] => e, [0,0,0,0] => f, [0,0,0,0,0] => g, + [0,0,0,0,0,0] => h, [0,0,0,0,0,0,0] => i, + [0,0,0,0,0,0,0,0] => j, [0,0,0,0,0,0,0,0,0] => k}, + + a = maps:get([0],M5), + b = maps:get([0,0],M5), + e = maps:get([0,0,0],M5), + f = maps:get([0,0,0,0],M5), + g = maps:get([0,0,0,0,0],M5), + h = maps:get([0,0,0,0,0,0],M5), + i = maps:get([0,0,0,0,0,0,0],M5), + j = maps:get([0,0,0,0,0,0,0,0],M5), + k = maps:get([0,0,0,0,0,0,0,0,0],M5), + + M6 = M4#{{[0,0,0]} => e, {[0,0,0,0]} => f, {[0,0,0,0,0]} => g, + {[0,0,0,0,0,0]} => h, {[0,0,0,0,0,0,0]} => i, + {[0,0,0,0,0,0,0,0]} => j, {[0,0,0,0,0,0,0,0,0]} => k}, + + a = maps:get({[0]},M6), + b = maps:get({[0,0]},M6), + e = maps:get({[0,0,0]},M6), + f = maps:get({[0,0,0,0]},M6), + g = maps:get({[0,0,0,0,0]},M6), + h = maps:get({[0,0,0,0,0,0]},M6), + i = maps:get({[0,0,0,0,0,0,0]},M6), + j = maps:get({[0,0,0,0,0,0,0,0]},M6), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M6), + + M7 = maps:merge(M5,M6), + + a = maps:get([0],M7), + b = maps:get([0,0],M7), + e = maps:get([0,0,0],M7), + f = maps:get([0,0,0,0],M7), + g = maps:get([0,0,0,0,0],M7), + h = maps:get([0,0,0,0,0,0],M7), + i = maps:get([0,0,0,0,0,0,0],M7), + j = maps:get([0,0,0,0,0,0,0,0],M7), + k = maps:get([0,0,0,0,0,0,0,0,0],M7), + a = maps:get({[0]},M7), + b = maps:get({[0,0]},M7), + e = maps:get({[0,0,0]},M7), + f = maps:get({[0,0,0,0]},M7), + g = maps:get({[0,0,0,0,0]},M7), + h = maps:get({[0,0,0,0,0,0]},M7), + i = maps:get({[0,0,0,0,0,0,0]},M7), + j = maps:get({[0,0,0,0,0,0,0,0]},M7), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M7), + ok. + t_pdict(_Config) -> put(#{ a => b, b => a},#{ c => d}), @@ -1086,5 +2922,330 @@ trace_collector(Msg,Parent) -> Parent ! Msg, Parent. +t_has_map_fields(Config) when is_list(Config) -> + true = has_map_fields_1(#{one=>1}), + true = has_map_fields_1(#{one=>1,two=>2}), + false = has_map_fields_1(#{two=>2}), + false = has_map_fields_1(#{}), + + true = has_map_fields_2(#{c=>1,b=>2,a=>3}), + true = has_map_fields_2(#{c=>1,b=>2,a=>3,x=>42}), + false = has_map_fields_2(#{b=>2,c=>1}), + false = has_map_fields_2(#{x=>y}), + false = has_map_fields_2(#{}), + + true = has_map_fields_3(#{c=>1,b=>2,a=>3}), + true = has_map_fields_3(#{c=>1,b=>2,a=>3,[]=>42}), + true = has_map_fields_3(#{b=>2,a=>3,[]=>42,42.0=>43}), + true = has_map_fields_3(#{a=>3,[]=>42,42.0=>43}), + true = has_map_fields_3(#{[]=>42,42.0=>43}), + false = has_map_fields_3(#{b=>2,c=>1}), + false = has_map_fields_3(#{[]=>y}), + false = has_map_fields_3(#{42.0=>x,a=>99}), + false = has_map_fields_3(#{}), + + ok. + +has_map_fields_1(#{one:=_}) -> true; +has_map_fields_1(#{}) -> false. + +has_map_fields_2(#{a:=_,b:=_,c:=_}) -> true; +has_map_fields_2(#{}) -> false. + +has_map_fields_3(#{a:=_,b:=_}) -> true; +has_map_fields_3(#{[]:=_,42.0:=_}) -> true; +has_map_fields_3(#{}) -> false. + +y_regs(Config) when is_list(Config) -> + Val = [length(Config)], + Map0 = y_regs_update(#{}, Val), + Map2 = y_regs_update(Map0, Val), + + Map3 = maps:from_list([{I,I*I} || I <- lists:seq(1, 100)]), + Map4 = y_regs_update(Map3, Val), + + true = is_map(Map2) andalso is_map(Map4), + + ok. + +y_regs_update(Map0, Val0) -> + Val1 = {t,Val0}, + K1 = id({key,1}), + K2 = id({key,2}), + Map1 = Map0#{K1=>K1, + a=>Val0,b=>Val0,c=>Val0,d=>Val0,e=>Val0, + f=>Val0,g=>Val0,h=>Val0,i=>Val0,j=>Val0, + k=>Val0,l=>Val0,m=>Val0,n=>Val0,o=>Val0, + p=>Val0,q=>Val0,r=>Val0,s=>Val0,t=>Val0, + u=>Val0,v=>Val0,w=>Val0,x=>Val0,y=>Val0, + z=>Val0, + aa=>Val0,ab=>Val0,ac=>Val0,ad=>Val0,ae=>Val0, + af=>Val0,ag=>Val0,ah=>Val0,ai=>Val0,aj=>Val0, + ak=>Val0,al=>Val0,am=>Val0,an=>Val0,ao=>Val0, + ap=>Val0,aq=>Val0,ar=>Val0,as=>Val0,at=>Val0, + au=>Val0,av=>Val0,aw=>Val0,ax=>Val0,ay=>Val0, + az=>Val0, + K2=>[a,b,c]}, + Map2 = Map1#{K1=>K1, + a:=Val1,b:=Val1,c:=Val1,d:=Val1,e:=Val1, + f:=Val1,g:=Val1,h:=Val1,i:=Val1,j:=Val1, + k:=Val1,l:=Val1,m:=Val1,n:=Val1,o:=Val1, + p:=Val1,q:=Val1,r:=Val1,s:=Val1,t:=Val1, + u:=Val1,v:=Val1,w:=Val1,x:=Val1,y:=Val1, + z:=Val1, + aa:=Val1,ab:=Val1,ac:=Val1,ad:=Val1,ae:=Val1, + af:=Val1,ag:=Val1,ah:=Val1,ai:=Val1,aj:=Val1, + ak:=Val1,al:=Val1,am:=Val1,an:=Val1,ao:=Val1, + ap:=Val1,aq:=Val1,ar:=Val1,as:=Val1,at:=Val1, + au:=Val1,av:=Val1,aw:=Val1,ax:=Val1,ay:=Val1, + az:=Val1, + K2=>[a,b,c]}, + + %% Traverse the maps to validate them. + _ = erlang:phash2({Map1,Map2}, 100000), + + _ = id({K1,K2,Val0,Val1}), %Force use of Y registers. + Map2. + +do_badmap(Test) -> + Terms = [Test,fun erlang:abs/1,make_ref(),self(),0.0/id(-1), + <<0:1024>>,<<1:1>>,<<>>,<<1,2,3>>, + [],{a,b,c},[a,b],atom,10.0,42,(1 bsl 65) + 3], + [Test(T) || T <- Terms]. + +%% Test that a module compiled with the OTP 17 compiler will +%% generate the correct 'badmap' exception. +badmap_17(Config) -> + case ?MODULE of + map_SUITE -> do_badmap_17(Config); + _ -> {skip,"Run in map_SUITE"} + end. + +do_badmap_17(Config) -> + Mod = badmap_17, + DataDir = test_server:lookup_config(data_dir, Config), + Beam = filename:join(DataDir, Mod), + {module,Mod} = code:load_abs(Beam), + do_badmap(fun Mod:update/1). + %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. + + +%% OTP-13763 +t_hash_entropy(Config) when is_list(Config) -> + %% entropy bug in 18.3, 19.0 + M1 = maps:from_list([{#{"id" => I}, ok}||I <- lists:seq(1,50000)]), + + #{ #{"id" => 100} := ok, + #{"id" => 200} := ok, + #{"id" => 300} := ok, + #{"id" => 400} := ok, + #{"id" => 500} := ok, + #{"id" => 600} := ok, + #{"id" => 700} := ok, + #{"id" => 800} := ok, + #{"id" => 900} := ok, + #{"id" => 25061} := ok, + #{"id" => 39766} := ok } = M1, + + M0 = maps:from_list([{I,ok}||I <- lists:seq(1,33)]), + M2 = maps:from_list([{M0#{"id" => I}, ok}||I <- lists:seq(1,50000)]), + + ok = maps:get(M0#{"id" => 100}, M2), + ok = maps:get(M0#{"id" => 200}, M2), + ok = maps:get(M0#{"id" => 300}, M2), + ok = maps:get(M0#{"id" => 400}, M2), + ok = maps:get(M0#{"id" => 500}, M2), + ok = maps:get(M0#{"id" => 600}, M2), + ok = maps:get(M0#{"id" => 700}, M2), + ok = maps:get(M0#{"id" => 800}, M2), + ok = maps:get(M0#{"id" => 900}, M2), + ok = maps:get(M0#{"id" => 25061}, M2), + ok = maps:get(M0#{"id" => 39766}, M2), + ok. + +%% OTP-13146 +%% Provoke major GC with a lot of "fat" maps on external format in msg queue +%% causing heap fragments to be allocated. +t_gc_rare_map_overflow(Config) when is_list(Config) -> + Pa = filename:dirname(code:which(?MODULE)), + {ok, Node} = test_server:start_node(gc_rare_map_overflow, slave, [{args, "-pa \""++Pa++"\""}]), + erts_debug:set_internal_state(available_internal_state, true), + try + Echo = spawn_link(Node, fun Loop() -> receive {From,Msg} -> From ! Msg + end, + Loop() + end), + FatMap = fatmap(34), + false = (flatmap =:= erts_internal:term_type(FatMap)), + + t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> erlang:garbage_collect() end), + + %% Repeat test for minor gc: + t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> minor_collect() end), + + unlink(Echo), + + %% Test fatmap in exit signal + Exiter = spawn_link(Node, fun Loop() -> receive {_From,Msg} -> + "not_a_map" = Msg % badmatch! + end, + Loop() + end), + process_flag(trap_exit, true), + Exiter ! {self(), FatMap}, + {'EXIT', Exiter, {{badmatch,FatMap}, _}} = receive M -> M end, + ok + + after + process_flag(trap_exit, false), + erts_debug:set_internal_state(available_internal_state, false), + test_server:stop_node(Node) + end. + +t_gc_rare_map_overflow_do(Echo, FatMap, GcFun) -> + Master = self(), + true = receive _M -> false after 0 -> true end, % assert empty msg queue + Echo ! {Master, token}, + repeat(1000, fun(_) -> Echo ! {Master, FatMap} end, void), + + timer:sleep(100), % Wait for maps to arrive in our msg queue + token = receive Tok -> Tok end, % and provoke move from outer to inner msg queue + + %% Do GC that will "overflow" and create heap frags due to all the fat maps + GcFun(), + + %% Now check that all maps in msg queueu are intact + %% Will crash emulator in OTP-18.1 + repeat(1000, fun(_) -> FatMap = receive FM -> FM end end, void), + ok. + +minor_collect() -> + Before = minor_gcs(), + erts_debug:set_internal_state(force_gc, self()), + erlang:yield(), + After = minor_gcs(), + io:format("minor_gcs: ~p -> ~p\n", [Before, After]). + +minor_gcs() -> + {garbage_collection, Info} = process_info(self(), garbage_collection), + {minor_gcs, GCS} = lists:keyfind(minor_gcs, 1, Info), + GCS. + +%% Generate a map with N (or N+1) keys that has an abnormal heap demand. +%% Done by finding keys that collide in the first 32-bit hash. +fatmap(N) -> + %%erts_debug:set_internal_state(available_internal_state, true), + Table = ets:new(void, [bag, private]), + + Seed0 = rand:seed_s(exsplus, {4711, 3141592, 2718281}), + Seed1 = fatmap_populate(Table, Seed0, (1 bsl 16)), + Keys = fatmap_generate(Table, Seed1, N, []), + ets:delete(Table), + maps:from_list([{K,K} || K <- Keys]). + +fatmap_populate(_, Seed, 0) -> Seed; +fatmap_populate(Table, Seed, N) -> + {I, NextSeed} = rand:uniform_s(1 bsl 48, Seed), + Hash = internal_hash(I), + ets:insert(Table, [{Hash, I}]), + fatmap_populate(Table, NextSeed, N-1). + + +fatmap_generate(_, _, N, Acc) when N =< 0 -> + Acc; +fatmap_generate(Table, Seed, N0, Acc0) -> + {I, NextSeed} = rand:uniform_s(1 bsl 48, Seed), + Hash = internal_hash(I), + case ets:member(Table, Hash) of + true -> + NewKeys = [I | ets:lookup_element(Table, Hash, 2)], + Acc1 = lists:usort(Acc0 ++ NewKeys), + N1 = N0 - (length(Acc1) - length(Acc0)), + fatmap_generate(Table, NextSeed, N1, Acc1); + false -> + fatmap_generate(Table, NextSeed, N0, Acc0) + end. + +internal_hash(Term) -> + erts_debug:get_internal_state({internal_hash, Term}). + + +%% map external_format (fannerl). +fannerl() -> + <<131,116,0,0,0,28,100,0,13,108,101,97,114,110,105,110,103,95,114, + 97,116,101,70,63,230,102,102,96,0,0,0,100,0,17,108,101,97,114,110,105,110, + 103,95,109,111,109,101,110,116,117,109,70,0,0,0,0,0,0,0,0,100,0, + 18,116,114,97,105,110,105,110,103,95,97,108,103,111,114,105,116,104,109,100,0, + 16,102,97,110,110,95,116,114,97,105,110,95,114,112,114,111,112, + 100,0,17,109,101,97,110,95,115,113,117,97,114,101,95,101,114,114,111,114,70, + 0,0,0,0,0,0,0,0,100,0,8,98,105,116,95,102,97,105,108,97,0,100,0,20, + 116,114,97,105,110,95,101,114,114,111,114,95,102,117,110,99,116,105,111, + 110,100,0,19,102,97,110,110,95,101,114,114,111,114,102,117,110,99, + 95,116,97,110,104,100,0,9,110,117,109,95,105,110,112,117,116,97,5,100,0,10,110, + 117,109,95,111,117,116,112,117,116,97,3,100,0,13,116,111,116,97,108, + 95,110,101,117,114,111,110,115,97,17,100,0,17,116,111,116,97,108,95,99,111,110, + 110,101,99,116,105,111,110,115,97,66,100,0,12,110,101,116,119,111,114,107, + 95,116,121,112,101,100,0,18,102,97,110,110,95,110,101,116,116,121,112,101, + 95,108,97,121,101,114,100,0,15,99,111,110,110,101,99,116,105,111,110,95, + 114,97,116,101,70,63,240,0,0,0,0,0,0,100,0,10,110,117,109,95,108,97,121,101, + 114,115,97,3,100,0,19,116,114,97,105,110,95,115,116,111,112,95,102,117,110, + 99,116,105,111,110,100,0,17,102,97,110,110,95,115,116,111,112,102,117,110, + 99,95,109,115,101,100,0,15,113,117,105,99,107,112,114,111,112,95,100,101,99, + 97,121,70,191,26,54,226,224,0,0,0,100,0,12,113,117,105,99,107,112,114, + 111,112,95,109,117,70,63,252,0,0,0,0,0,0,100,0,21,114,112,114,111,112,95,105, + 110,99,114,101,97,115,101,95,102,97,99,116,111,114,70,63,243,51,51, + 64,0,0,0,100,0,21,114,112,114,111,112,95,100,101,99,114,101,97,115,101, + 95,102,97,99,116,111,114,70,63,224,0,0,0,0,0,0,100,0,15,114,112,114,111,112, + 95,100,101,108,116,97,95,109,105,110,70,0,0,0,0,0,0,0,0,100,0,15,114,112,114, + 111,112,95,100,101,108,116,97,95,109,97,120,70,64,73,0,0,0,0,0,0,100,0, + 16,114,112,114,111,112,95,100,101,108,116,97,95,122,101,114,111,70,63,185,153, + 153,160,0,0,0,100,0,26,115,97,114,112,114,111,112,95,119,101,105,103, + 104,116,95,100,101,99,97,121,95,115,104,105,102,116,70,192,26,147,116,192,0,0,0, + 100,0,35,115,97,114,112,114,111,112,95,115,116,101,112,95,101,114, + 114,111,114,95,116,104,114,101,115,104,111,108,100,95,102,97,99,116,111,114,70, + 63,185,153,153,160,0,0,0,100,0,24,115,97,114,112,114,111,112,95,115, + 116,101,112,95,101,114,114,111,114,95,115,104,105,102,116,70,63,246,40,245, + 192,0,0,0,100,0,19,115,97,114,112,114,111,112,95,116,101,109,112,101,114, + 97,116,117,114,101,70,63,142,184,81,224,0,0,0,100,0,6,108,97,121,101,114,115, + 104,3,97,5,97,7,97,3,100,0,4,98,105,97,115,104,3,97,1,97,1,97,0,100,0,11, + 99,111,110,110,101,99,116,105,111,110,115,116,0,0,0,66,104,2,97,0,97,6,70, + 191,179,51,44,64,0,0,0,104,2,97,1,97,6,70,63,178,130,90,32,0,0,0,104,2,97,2, + 97,6,70,63,82,90,88,0,0,0,0,104,2,97,3,97,6,70,63,162,91,63,192,0,0,0,104,2, + 97,4,97,6,70,191,151,70,169,0,0,0,0,104,2,97,5,97,6,70,191,117,52,222,0,0,0, + 0,104,2,97,0,97,7,70,63,152,240,139,0,0,0,0,104,2,97,1,97,7,70,191,166,31, + 187,160,0,0,0,104,2,97,2,97,7,70,191,150,70,63,0,0,0,0,104,2,97,3,97,7,70, + 63,152,181,126,128,0,0,0,104,2,97,4,97,7,70,63,151,187,162,128,0,0,0,104,2, + 97,5,97,7,70,191,143,161,101,0,0,0,0,104,2,97,0,97,8,70,191,153,102,36,128,0, + 0,0,104,2,97,1,97,8,70,63,160,139,250,64,0,0,0,104,2,97,2,97,8,70,63,164,62, + 196,64,0,0,0,104,2,97,3,97,8,70,191,178,78,209,192,0,0,0,104,2,97,4,97,8,70, + 191,185,19,76,224,0,0,0,104,2,97,5,97,8,70,63,183,142,196,96,0,0,0,104,2,97,0, + 97,9,70,63,150,104,248,0,0,0,0,104,2,97,1,97,9,70,191,164,4,100,224,0,0,0, + 104,2,97,2,97,9,70,191,169,42,42,224,0,0,0,104,2,97,3,97,9,70,63,145,54,78,128,0, + 0,0,104,2,97,4,97,9,70,63,126,243,134,0,0,0,0,104,2,97,5,97,9,70,63,177, + 203,25,96,0,0,0,104,2,97,0,97,10,70,63,172,104,47,64,0,0,0,104,2,97,1,97,10, + 70,63,161,242,193,64,0,0,0,104,2,97,2,97,10,70,63,175,208,241,192,0,0,0,104,2, + 97,3,97,10,70,191,129,202,161,0,0,0,0,104,2,97,4,97,10,70,63,178,151,55,32,0,0,0, + 104,2,97,5,97,10,70,63,137,155,94,0,0,0,0,104,2,97,0,97,11,70,191,179, + 106,160,0,0,0,0,104,2,97,1,97,11,70,63,184,253,164,96,0,0,0,104,2,97,2,97,11, + 70,191,143,30,157,0,0,0,0,104,2,97,3,97,11,70,63,153,225,140,128,0,0,0,104, + 2,97,4,97,11,70,63,161,35,85,192,0,0,0,104,2,97,5,97,11,70,63,175,200,55,192, + 0,0,0,104,2,97,0,97,12,70,191,180,116,132,96,0,0,0,104,2,97,1,97,12,70,191, + 165,151,152,0,0,0,0,104,2,97,2,97,12,70,191,180,197,91,160,0,0,0,104,2,97,3,97,12, + 70,191,91,30,160,0,0,0,0,104,2,97,4,97,12,70,63,180,251,45,32,0,0,0, + 104,2,97,5,97,12,70,63,165,134,77,64,0,0,0,104,2,97,6,97,14,70,63,181,56,242,96, + 0,0,0,104,2,97,7,97,14,70,191,165,239,234,224,0,0,0,104,2,97,8,97,14, + 70,191,154,65,216,128,0,0,0,104,2,97,9,97,14,70,63,150,250,236,0,0,0,0,104,2,97, + 10,97,14,70,191,141,105,108,0,0,0,0,104,2,97,11,97,14,70,191,152,40, + 165,0,0,0,0,104,2,97,12,97,14,70,63,141,159,46,0,0,0,0,104,2,97,13,97,14,70, + 191,183,172,137,32,0,0,0,104,2,97,6,97,15,70,63,163,26,123,192,0,0,0,104, + 2,97,7,97,15,70,63,176,184,106,32,0,0,0,104,2,97,8,97,15,70,63,152,234,144, + 0,0,0,0,104,2,97,9,97,15,70,191,172,58,70,160,0,0,0,104,2,97,10,97,15,70, + 63,161,211,211,192,0,0,0,104,2,97,11,97,15,70,191,148,171,120,128,0,0,0,104, + 2,97,12,97,15,70,63,180,117,214,224,0,0,0,104,2,97,13,97,15,70,191,104, + 230,216,0,0,0,0,104,2,97,6,97,16,70,63,178,53,103,96,0,0,0,104,2,97,7,97,16, + 70,63,170,230,232,64,0,0,0,104,2,97,8,97,16,70,191,183,45,100,192,0,0,0, + 104,2,97,9,97,16,70,63,184,100,97,32,0,0,0,104,2,97,10,97,16,70,63,169,174, + 254,64,0,0,0,104,2,97,11,97,16,70,191,119,121,234,0,0,0,0,104,2,97,12,97, + 16,70,63,149,12,170,128,0,0,0,104,2,97,13,97,16,70,191,144,193,191,0,0,0,0>>. diff --git a/erts/emulator/test/map_SUITE_data/badmap_17.beam b/erts/emulator/test/map_SUITE_data/badmap_17.beam Binary files differnew file mode 100644 index 0000000000..6f79bb8c2c --- /dev/null +++ b/erts/emulator/test/map_SUITE_data/badmap_17.beam diff --git a/erts/emulator/test/map_SUITE_data/badmap_17.erl b/erts/emulator/test/map_SUITE_data/badmap_17.erl new file mode 100644 index 0000000000..887fc2e5e3 --- /dev/null +++ b/erts/emulator/test/map_SUITE_data/badmap_17.erl @@ -0,0 +1,58 @@ +-module(badmap_17). +-export([update/1]). + +%% Compile this source file with OTP 17.0. + +update(Map) -> + try + update_1(Map), + error(update_did_not_fail) + catch + error:{badmap,Map} -> + ok + end, + try + update_2(Map), + error(update_did_not_fail) + catch + error:{badmap,Map} -> + ok + end, + try + update_3(Map), + error(update_did_not_fail) + catch + error:{badmap,Map} -> + ok + end, + ok = update_4(Map), + ok = update_5(Map), + ok. + +update_1(M) -> + M#{a=>42}. + +update_2(M) -> + M#{a:=42}. + +update_3(M) -> + id(M), + M#{a=>42}. + +update_4(M) when M#{a=>b} =:= M -> + did_not_fail; +update_4(_) -> + ok. + +update_5(M) -> + id(M), + case id(true) of + true when M#{a=>b} =:= M -> + did_not_fail; + true -> + ok + end. + +id(I) -> + I. + diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 8038888796..08a7b4560c 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -1,35 +1,36 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(match_spec_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, not_run/1]). --export([test_1/1, test_2/1, test_3/1, bad_match_spec_bin/1, +-export([all/0, suite/0, not_run/1]). +-export([test_1/1, test_2/1, test_3/1, caller_and_return_to/1, bad_match_spec_bin/1, trace_control_word/1, silent/1, silent_no_ms/1, silent_test/1, - ms_trace2/1, ms_trace3/1, boxed_and_small/1, + ms_trace2/1, ms_trace3/1, ms_trace_dead/1, boxed_and_small/1, destructive_in_test_bif/1, guard_exceptions/1, empty_list/1, unary_plus/1, unary_minus/1, moving_labels/1]). -export([fpe/1]). -export([otp_9422/1]). -export([faulty_seq_trace/1, do_faulty_seq_trace/0]). +-export([maps/1]). -export([runner/2, loop_runner/3]). -export([f1/1, f2/2, f3/2, fn/1, fn/2, fn/3]). -export([do_boxed_and_small/0]). @@ -37,193 +38,202 @@ % This test suite assumes that tracing in general works. What we test is % the match spec functionality. --include_lib("test_server/include/test_server.hrl"). - --export([init_per_testcase/2, end_per_testcase/2]). - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:seconds(30)), - [{watchdog, Dog}|Config]. +-include_lib("common_test/include/ct.hrl"). -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> case test_server:is_native(match_spec_SUITE) of false -> - [test_1, test_2, test_3, bad_match_spec_bin, + [test_1, test_2, test_3, caller_and_return_to, bad_match_spec_bin, trace_control_word, silent, silent_no_ms, silent_test, ms_trace2, - ms_trace3, boxed_and_small, destructive_in_test_bif, + ms_trace3, ms_trace_dead, boxed_and_small, destructive_in_test_bif, guard_exceptions, unary_plus, unary_minus, fpe, moving_labels, faulty_seq_trace, empty_list, - otp_9422]; + otp_9422, + maps]; true -> [not_run] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - not_run(Config) when is_list(Config) -> {skipped, "Native Code"}. -test_1(doc) -> - [""]; -test_1(suite) -> []; test_1(Config) when is_list(Config) -> - ?line tr(fun() -> ?MODULE:f1(a) end, - {?MODULE, f1, 1}, - [], - [{call, {?MODULE, f1, [a]}}]), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[]}], - [{call, {?MODULE, f2, [a, a]}}]), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[{message, false}]}], - []), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}]}], - [{call, {?MODULE, f2, [a, a]}, 4711}]), + tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [], + [{call, {?MODULE, f1, [a]}}]), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[]}], + [{call, {?MODULE, f2, [a, a]}}]), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, false}]}], + []), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [a, a]}, 4711}]), Ref = make_ref(), - ?line tr(fun() -> ?MODULE:f2(Ref, Ref) end, - {?MODULE, f2, 2}, - [{[Ref,'$1'],[{is_reference, '$1'}],[{message, 4711}]}], - [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]), - ?line tr(fun() -> ?MODULE:f2(Ref, Ref) end, - {?MODULE, f2, 2}, - [{['$1',Ref],[{is_reference, '$1'}],[{message, 4711}]}], - [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$0','$0'],[{is_atom, '$0'}],[{message, 4711}]}], - [{call, {?MODULE, f2, [a, a]}, 4711}]), - - ?line tr(fun() -> ?MODULE:f2(a, b) end, - {?MODULE, f2, 2}, - [{['_','_'],[],[]}], - [{call, {?MODULE, f2, [a, b]}}]), - - ?line tr(fun() -> ?MODULE:f2(a, b) end, - {?MODULE, f2, 2}, - [{['_','_'],[],[{message, '$_'}]}], - [{call, {?MODULE, f2, [a, b]}, [a, b]}]), - - ?line tr(fun() -> ?MODULE:f2(a, '$_') end, - {?MODULE, f2, 2}, - [{['$1','$_'],[{is_atom, '$1'}],[]}], - [{call, {?MODULE, f2, [a, '$_']}}]), - - ?line tr(fun() -> ?MODULE:f1({a}) end, - {?MODULE, f1, 1}, - [{['$1'],[{'==', '$1', {const, {a}}}],[]}], - [{call, {?MODULE, f1, [{a}]}}]), - - ?line tr(fun() -> ?MODULE:f1({a}) end, - {?MODULE, f1, 1}, - [{['$1'],[{'==', '$1', {{a}}}],[]}], - [{call, {?MODULE, f1, [{a}]}}]), - -%% Undocumented, currently. - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}, - {message, true}]}], - [{call, {?MODULE, f2, [a, a]}}]), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}, - {message, false}]}], - []), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[kakalorum]}], - [{call, {?MODULE, f2, [a, a]}}]), - -% case tr0(fun() -> ?MODULE:f2(a, a) end, -% {?MODULE, f2, 2}, -% [{['$1','$1'],[{is_atom, '$1'}],[{message, {process_dump}}]}]) of -% [{trace, _, call, {?MODULE, f2, [a, a]}, Bin}] -> -% erlang:display(binary_to_list(Bin)) -% end, - -% Error cases - ?line errchk([{['$1','$1'],[{is_atom, '$1'}],[{banka, kanin}]}]), - + tr(fun() -> ?MODULE:f2(Ref, Ref) end, + {?MODULE, f2, 2}, + [{[Ref,'$1'],[{is_reference, '$1'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]), + tr(fun() -> ?MODULE:f2(Ref, Ref) end, + {?MODULE, f2, 2}, + [{['$1',Ref],[{is_reference, '$1'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$0','$0'],[{is_atom, '$0'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [a, a]}, 4711}]), + + tr(fun() -> ?MODULE:f2(a, b) end, + {?MODULE, f2, 2}, + [{['_','_'],[],[]}], + [{call, {?MODULE, f2, [a, b]}}]), + + tr(fun() -> ?MODULE:f2(a, b) end, + {?MODULE, f2, 2}, + [{['_','_'],[],[{message, '$_'}]}], + [{call, {?MODULE, f2, [a, b]}, [a, b]}]), + + tr(fun() -> ?MODULE:f2(a, '$_') end, + {?MODULE, f2, 2}, + [{['$1','$_'],[{is_atom, '$1'}],[]}], + [{call, {?MODULE, f2, [a, '$_']}}]), + + tr(fun() -> ?MODULE:f1({a}) end, + {?MODULE, f1, 1}, + [{['$1'],[{'==', '$1', {const, {a}}}],[]}], + [{call, {?MODULE, f1, [{a}]}}]), + + tr(fun() -> ?MODULE:f1({a}) end, + {?MODULE, f1, 1}, + [{['$1'],[{'==', '$1', {{a}}}],[]}], + [{call, {?MODULE, f1, [{a}]}}]), + + %% Undocumented, currently. + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}, + {message, true}]}], + [{call, {?MODULE, f2, [a, a]}}]), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}, + {message, false}]}], + []), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[kakalorum]}], + [{call, {?MODULE, f2, [a, a]}}]), + + %% Verify that 'process_dump' can handle a matchstate on the stack. + tr(fun() -> fbinmatch(<<0>>, 0) end, + {?MODULE, f1, 1}, + [{['_'],[],[{message, {process_dump}}]}], + [fun({trace, _, call, {?MODULE, f1, [0]}, _Bin}) -> true end]), + + % Error cases + errchk([{['$1','$1'],[{is_atom, '$1'}],[{banka, kanin}]}]), ok. -test_2(doc) -> - [""]; -test_2(suite) -> []; test_2(Config) when is_list(Config) -> - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[{return_trace}]}], - [{call, {?MODULE, f2, [a, a]}}, - {return_from, {?MODULE, f2, 2}, {a, a}}]), + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{return_trace}]}], + [{call, {?MODULE, f2, [a, a]}}, + {return_from, {?MODULE, f2, 2}, {a, a}}]), ok. -test_3(doc) -> - ["Test the enable_trace/2 and caller/0 PAM instructions"]; -test_3(suite) -> []; +%% Test the enable_trace/2 and caller/0 PAM instructions test_3(Config) when is_list(Config) -> - ?line Fun1 = fun() -> + Fun1 = fun() -> register(fnoppelklopfer,self()), ?MODULE:f2(a, b), ?MODULE:f2(a, b) end, - ?line P1 = spawn(?MODULE, runner, [self(), Fun1]), - ?line Pat = [{['$1','$1'],[],[{message, - [{enable_trace, P1, call},{caller}]}]}, - {['_','_'],[],[{message, - [{disable_trace, fnoppelklopfer, call}]}]}], - ?line Fun2 = fun() -> ?MODULE:f3(a, a) end, - ?line P2 = spawn(?MODULE, runner, [self(), Fun2]), - ?line erlang:trace(P2, true, [call]), - ?line erlang:trace_pattern({?MODULE, f2, 2}, Pat), - ?line collect(P2, [{trace, P2, call, {?MODULE, f2, [a, a]}, [true, + P1 = spawn(?MODULE, runner, [self(), Fun1]), + Pat = [{['$1','$1'],[],[{message, + [{enable_trace, P1, call},{caller}]}]}, + {['_','_'],[],[{message, + [{disable_trace, fnoppelklopfer, call}]}]}], + Fun2 = fun() -> ?MODULE:f3(a, a) end, + P2 = spawn(?MODULE, runner, [self(), Fun2]), + erlang:trace(P2, true, [call]), + erlang:trace_pattern({?MODULE, f2, 2}, Pat), + collect(P2, [{trace, P2, call, {?MODULE, f2, [a, a]}, [true, {?MODULE,f3,2}]}]), - ?line collect(P1, [{trace, P1, call, {?MODULE, f2, [a, b]}, [true]}]), - ?line ok. + collect(P1, [{trace, P1, call, {?MODULE, f2, [a, b]}, [true]}]), + ok. + +%% Test that caller and return to work as they should +%% There was a bug where caller would be undefined when return_to was set +%% for r the bif erlang:put(). +caller_and_return_to(Config) -> + tr( + fun do_put_wrapper/0, + fun (Tracee) -> + MsgCaller = [{'_',[],[{message,{caller}}]}], + 1 = erlang:trace(Tracee, true, [call,return_to]), + 1 = erlang:trace_pattern( {?MODULE,do_put,1}, MsgCaller, [local]), + 1 = erlang:trace_pattern( {?MODULE,do_the_put,1}, MsgCaller, [local]), + 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, MsgCaller, [local]), + 1 = erlang:trace_pattern( {erlang,put,2}, MsgCaller, [local]), + + [{trace,Tracee,call,{?MODULE,do_put,[test]},{?MODULE,do_put_wrapper,0}}, + {trace,Tracee,call,{?MODULE,do_the_put,[test]},{?MODULE,do_put,1}}, + {trace,Tracee,call,{erlang,integer_to_list,[1]},{?MODULE,do_the_put,1}}, + {trace,Tracee,return_to,{?MODULE,do_the_put,1}}, + {trace,Tracee,call,{erlang,put,[test,"1"]},{?MODULE,do_put,1}}, + {trace,Tracee,return_to,{?MODULE,do_put,1}}, + + %% These last trace messages are a bit strange... + %% if call tracing had been enabled for do_put_wrapper + %% then caller and return_to would have been {?MODULE,do_put_wrapper,1} + %% but since it is not, they are set to do_put instead, but we still + %% get the do_put_wrapper return_to message... + {trace,Tracee,call,{erlang,integer_to_list,[2]},{?MODULE,do_put,1}}, + {trace,Tracee,return_to,{?MODULE,do_put,1}}, + {trace,Tracee,return_to,{?MODULE,do_put_wrapper,0}} + ] + end), + ok. + +do_put_wrapper() -> + do_put(test), + ok. + +do_put(Var) -> + do_the_put(Var), + erlang:integer_to_list(id(2)). +do_the_put(Var) -> + Lst = erlang:integer_to_list(id(1)), + erlang:put(Var, Lst). -otp_9422(doc) -> []; otp_9422(Config) when is_list(Config) -> Laps = 10000, - ?line Fun1 = fun() -> otp_9422_tracee() end, - ?line P1 = spawn_link(?MODULE, loop_runner, [self(), Fun1, Laps]), + Fun1 = fun() -> otp_9422_tracee() end, + P1 = spawn_link(?MODULE, loop_runner, [self(), Fun1, Laps]), io:format("spawned ~p as tracee\n", [P1]), - ?line erlang:trace(P1, true, [call, silent]), + erlang:trace(P1, true, [call, silent]), - ?line Fun2 = fun() -> otp_9422_trace_changer() end, - ?line P2 = spawn_link(?MODULE, loop_runner, [self(), Fun2, Laps]), + Fun2 = fun() -> otp_9422_trace_changer() end, + P2 = spawn_link(?MODULE, loop_runner, [self(), Fun2, Laps]), io:format("spawned ~p as trace_changer\n", [P2]), start_collect(P1), @@ -242,9 +252,9 @@ otp_9422_tracee() -> otp_9422_trace_changer() -> Pat1 = [{[a], [], [{enable_trace, arity}]}], - ?line erlang:trace_pattern({?MODULE, f1, 1}, Pat1), + erlang:trace_pattern({?MODULE, f1, 1}, Pat1), Pat2 = [{[b], [], [{disable_trace, arity}]}], - ?line erlang:trace_pattern({?MODULE, f1, 1}, Pat2). + erlang:trace_pattern({?MODULE, f1, 1}, Pat2). @@ -259,261 +269,227 @@ bad_match_spec_bin(Config) when is_list(Config) -> -trace_control_word(doc) -> - ["Test the erlang:system_info(trace_control_word) and ", - "erlang:system_flag(trace_control_word, Value) BIFs, ", - "as well as the get_tcw/0 and set_tcw/1 PAM instructions"]; -trace_control_word(suite) -> []; +%% Test the erlang:system_info(trace_control_word) and +%% erlang:system_flag(trace_control_word, Value) BIFs, +%% as well as the get_tcw/0 and set_tcw/1 PAM instructions trace_control_word(Config) when is_list(Config) -> - ?line 32 = Bits = tcw_bits(), - ?line High = 1 bsl (Bits - 1), - ?line erlang:system_flag(trace_control_word, 17), - ?line tr(fun() -> ?MODULE:f1(a) end, - {?MODULE, f1, 1}, - [{'_',[{'=:=', {get_tcw}, 17}],[]}], - [{call, {?MODULE, f1, [a]}}]), - ?line tr(fun() -> ?MODULE:f1(a) end, - {?MODULE, f1, 1}, - [{'_',[{'=:=', {get_tcw}, 18}],[]}], - []), - ?line erlang:system_flag(trace_control_word, High), - ?line tr(fun() -> ?MODULE:f1(a) end, - {?MODULE, f1, 1}, - [{'_',[{'=:=', {get_tcw}, High}],[]}], - [{call, {?MODULE, f1, [a]}}]), - ?line erlang:system_flag(trace_control_word, 0), - ?line tr(fun() -> - ?MODULE:f1(a), - ?MODULE:f1(start), - ?MODULE:f1(b), - ?MODULE:f1(c), - ?MODULE:f1(high), - ?MODULE:f1(d), - ?MODULE:f1(stop), - ?MODULE:f1(e) - end, - {?MODULE, f1, 1}, - [{[start], - [], - [{message, {set_tcw, 17}}]}, - {[stop], - [], - [{message, {set_tcw, 0}}]}, - {[high], - [], - [{message, {set_tcw, High}}]}, - {['_'], - [{'>', {get_tcw}, 0}], - [{set_tcw, {'+', 1, {get_tcw}}}, {message, {get_tcw}}] }], - [{call, {?MODULE, f1, [start]}, 0}, - {call, {?MODULE, f1, [b]}, 18}, - {call, {?MODULE, f1, [c]}, 19}, - {call, {?MODULE, f1, [high]}, 19}, - {call, {?MODULE, f1, [d]}, High + 1}, - {call, {?MODULE, f1, [stop]}, High + 1}]), - ?line 0 = erlang:system_info(trace_control_word), + 32 = Bits = tcw_bits(), + High = 1 bsl (Bits - 1), + erlang:system_flag(trace_control_word, 17), + tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [{'_',[{'=:=', {get_tcw}, 17}],[]}], + [{call, {?MODULE, f1, [a]}}]), + tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [{'_',[{'=:=', {get_tcw}, 18}],[]}], + []), + erlang:system_flag(trace_control_word, High), + tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [{'_',[{'=:=', {get_tcw}, High}],[]}], + [{call, {?MODULE, f1, [a]}}]), + erlang:system_flag(trace_control_word, 0), + tr(fun() -> + ?MODULE:f1(a), + ?MODULE:f1(start), + ?MODULE:f1(b), + ?MODULE:f1(c), + ?MODULE:f1(high), + ?MODULE:f1(d), + ?MODULE:f1(stop), + ?MODULE:f1(e) + end, + {?MODULE, f1, 1}, + [{[start], + [], + [{message, {set_tcw, 17}}]}, + {[stop], + [], + [{message, {set_tcw, 0}}]}, + {[high], + [], + [{message, {set_tcw, High}}]}, + {['_'], + [{'>', {get_tcw}, 0}], + [{set_tcw, {'+', 1, {get_tcw}}}, {message, {get_tcw}}] }], + [{call, {?MODULE, f1, [start]}, 0}, + {call, {?MODULE, f1, [b]}, 18}, + {call, {?MODULE, f1, [c]}, 19}, + {call, {?MODULE, f1, [high]}, 19}, + {call, {?MODULE, f1, [d]}, High + 1}, + {call, {?MODULE, f1, [stop]}, High + 1}]), + 0 = erlang:system_info(trace_control_word), ok. tcw_bits() -> - ?line tcw_bits(erlang:system_flag(trace_control_word, 0), 0, 0). + tcw_bits(erlang:system_flag(trace_control_word, 0), 0, 0). tcw_bits(Save, Prev, Bits) -> - ?line Curr = 1 bsl Bits, - ?line case catch erlang:system_flag(trace_control_word, Curr) of - {'EXIT' , {badarg, _}} -> - ?line Prev = erlang:system_flag(trace_control_word, Save), - Bits; - Prev -> - ?line Curr = erlang:system_info(trace_control_word), - tcw_bits(Save, Curr, Bits+1) - end. - - - -silent(doc) -> - ["Test the erlang:trace(_, _, [silent]) flag ", - "as well as the silent/0 PAM instruction"]; -silent(suite) -> []; + Curr = 1 bsl Bits, + case catch erlang:system_flag(trace_control_word, Curr) of + {'EXIT' , {badarg, _}} -> + Prev = erlang:system_flag(trace_control_word, Save), + Bits; + Prev -> + Curr = erlang:system_info(trace_control_word), + tcw_bits(Save, Curr, Bits+1) + end. + + +%% Test the erlang:trace(_, _, [silent]) flag +%% as well as the silent/0 PAM instruction silent(Config) when is_list(Config) -> %% Global call trace - ?line tr(fun() -> - ?MODULE:f1(a), % No trace - not active - ?MODULE:f1(miss), % No trace - no activation - ?MODULE:f1(b), % No trace - still not active - ?MODULE:f1(start), % Trace - activation - ?MODULE:f1(c), % Trace - active - f1(d), % No trace - local call - ?MODULE:f1(miss), % Trace - no inactivation - ?MODULE:f1(e), % Trace - still active - ?MODULE:f1(stop), % No trace - inactivation - ?MODULE:f1(f) % No trace - not active - end, - {?MODULE, f1, 1}, - [call, silent], - [{[start], - [], - [{silent, false}, {message, start}]}, - {[stop], - [], - [{silent, true}, {message, stop}]}, - {[miss], - [], - [{silent, neither_true_nor_false}, {message, miss}]}, - {['$1'], - [], - [{message, '$1'}] }], - [global], - [{call, {?MODULE, f1, [start]}, start}, - {call, {?MODULE, f1, [c]}, c}, - {call, {?MODULE, f1, [miss]}, miss}, - {call, {?MODULE, f1, [e]}, e} ]), + tr(fun() -> + ?MODULE:f1(a), % No trace - not active + ?MODULE:f1(miss), % No trace - no activation + ?MODULE:f1(b), % No trace - still not active + ?MODULE:f1(start), % Trace - activation + ?MODULE:f1(c), % Trace - active + f1(d), % No trace - local call + ?MODULE:f1(miss), % Trace - no inactivation + ?MODULE:f1(e), % Trace - still active + ?MODULE:f1(stop), % No trace - inactivation + ?MODULE:f1(f) % No trace - not active + end, + {?MODULE, f1, 1}, + [call, silent], + [{[start], + [], + [{silent, false}, {message, start}]}, + {[stop], + [], + [{silent, true}, {message, stop}]}, + {[miss], + [], + [{silent, neither_true_nor_false}, {message, miss}]}, + {['$1'], + [], + [{message, '$1'}] }], + [global], + [{call, {?MODULE, f1, [start]}, start}, + {call, {?MODULE, f1, [c]}, c}, + {call, {?MODULE, f1, [miss]}, miss}, + {call, {?MODULE, f1, [e]}, e} ]), %% Local call trace - ?line tr(fun() -> - ?MODULE:f1(a), % No trace - not active - f1(b), % No trace - not active - ?MODULE:f1(start), % Trace - activation - ?MODULE:f1(c), % Trace - active - f1(d), % Trace - active - f1(stop), % No trace - inactivation - ?MODULE:f1(e), % No trace - not active - f1(f) % No trace - not active - end, - {?MODULE, f1, 1}, - [call, silent], - [{[start], - [], - [{silent, false}, {message, start}]}, - {[stop], - [], - [{silent, true}, {message, stop}]}, - {['$1'], - [], - [{message, '$1'}] }], - [local], - [{call, {?MODULE, f1, [start]}, start}, - {call, {?MODULE, f1, [c]}, c}, - {call, {?MODULE, f1, [d]}, d} ]), + tr(fun() -> + ?MODULE:f1(a), % No trace - not active + f1(b), % No trace - not active + ?MODULE:f1(start), % Trace - activation + ?MODULE:f1(c), % Trace - active + f1(d), % Trace - active + f1(stop), % No trace - inactivation + ?MODULE:f1(e), % No trace - not active + f1(f) % No trace - not active + end, + {?MODULE, f1, 1}, + [call, silent], + [{[start], + [], + [{silent, false}, {message, start}]}, + {[stop], + [], + [{silent, true}, {message, stop}]}, + {['$1'], + [], + [{message, '$1'}] }], + [local], + [{call, {?MODULE, f1, [start]}, start}, + {call, {?MODULE, f1, [c]}, c}, + {call, {?MODULE, f1, [d]}, d} ]), ok. -silent_no_ms(doc) -> - ["Test the erlang:trace(_, _, [silent]) flag without match specs"]; -silent_no_ms(suite) -> []; +%% Test the erlang:trace(_, _, [silent]) flag without match specs silent_no_ms(Config) when is_list(Config) -> %% Global call trace %% %% Trace f2/2 and erlang:integer_to_list/1 without match spec %% and use match spec on f1/1 to control silent flag. - ?line tr( - fun () -> - ?MODULE:f1(a), - ?MODULE:f2(b, c), - _ = erlang:integer_to_list(id(1)), - ?MODULE:f3(d, e), - ?MODULE:f1(start), - ?MODULE:f2(f, g), - _ = erlang:integer_to_list(id(2)), - ?MODULE:f3(h, i), - ?MODULE:f1(stop), - ?MODULE:f2(j, k), - _ = erlang:integer_to_list(id(3)), - ?MODULE:f3(l, m) - end, - fun (Tracee) -> - ?line 1 = - erlang:trace(Tracee, true, - [call,silent,return_to]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f2,2}, - [], - [global]), - ?line 1 = - erlang:trace_pattern( - {erlang,integer_to_list,1}, - [], - [global]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f1,1}, - [{[start],[],[{silent,false}]}, - {[stop],[],[{silent,true}]}], - [global]), - %% - %% Expected: (no return_to for global call trace) - %% - ?line - [{trace,Tracee,call,{?MODULE,f1,[start]}}, - {trace,Tracee,call,{?MODULE,f2,[f,g]}}, - {trace,Tracee,call,{erlang,integer_to_list,[2]}}, - {trace,Tracee,call,{?MODULE,f2,[h,i]}}] - end), + tr( + fun () -> + ?MODULE:f1(a), + ?MODULE:f2(b, c), + _ = erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + ?MODULE:f1(start), + ?MODULE:f2(f, g), + _ = erlang:integer_to_list(id(2)), + ?MODULE:f3(h, i), + ?MODULE:f1(stop), + ?MODULE:f2(j, k), + _ = erlang:integer_to_list(id(3)), + ?MODULE:f3(l, m) + end, + fun (Tracee) -> + 1 = erlang:trace(Tracee, true, [call,silent,return_to]), + 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [global]), + 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [global]), + 1 = erlang:trace_pattern( + {?MODULE,f1,1}, + [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true}]}], + [global]), + %% + %% Expected: (no return_to for global call trace) + %% + [{trace,Tracee,call,{?MODULE,f1,[start]}}, + {trace,Tracee,call,{?MODULE,f2,[f,g]}}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,call,{?MODULE,f2,[h,i]}}] + end), %% Local call trace %% %% Trace f2/2 and erlang:integer_to_list/1 without match spec %% and use match spec on f1/1 to control silent flag. - ?line tr( - fun () -> - ?MODULE:f1(a), - ?MODULE:f2(b, c), - _ = erlang:integer_to_list(id(1)), - ?MODULE:f3(d, e), - ?MODULE:f1(start), - ?MODULE:f2(f, g), - _ = erlang:integer_to_list(id(2)), - ?MODULE:f3(h, i), - ?MODULE:f1(stop), - ?MODULE:f2(j, k), - _ = erlang:integer_to_list(id(3)), - ?MODULE:f3(l, m) - end, - fun (Tracee) -> - ?line 1 = - erlang:trace(Tracee, true, - [call,silent,return_to]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f2,2}, - [], - [local]), - ?line 1 = - erlang:trace_pattern( - {erlang,integer_to_list,1}, - [], - [local]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f1,1}, - [{[start],[],[{silent,false}]}, - {[stop],[],[{silent,true}]}], - [local]), - %% - %% Expected: - %% - ?line - [{trace,Tracee,call,{?MODULE,f1,[start]}}, - {trace,Tracee,return_to, - {?MODULE,'-silent_no_ms/1-fun-2-',0}}, - {trace,Tracee,call,{?MODULE,f2,[f,g]}}, - {trace,Tracee,return_to, - {?MODULE,'-silent_no_ms/1-fun-2-',0}}, - {trace,Tracee,call,{erlang,integer_to_list,[2]}}, - {trace,Tracee,return_to, - {?MODULE,'-silent_no_ms/1-fun-2-',0}}, - {trace,Tracee,call,{?MODULE,f2,[h,i]}}, - {trace,Tracee,return_to,{?MODULE,f3,2}}] - end). - -silent_test(doc) -> - ["Test that match_spec_test does not activate silent"]; + tr( + fun () -> + ?MODULE:f1(a), + ?MODULE:f2(b, c), + _ = erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + ?MODULE:f1(start), + ?MODULE:f2(f, g), + _ = erlang:integer_to_list(id(2)), + ?MODULE:f3(h, i), + ?MODULE:f1(stop), + ?MODULE:f2(j, k), + _ = erlang:integer_to_list(id(3)), + ?MODULE:f3(l, m) + end, + fun (Tracee) -> + 1 = erlang:trace(Tracee, true, [call,silent,return_to]), + 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [local]), + 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [local]), + 1 = erlang:trace_pattern( + {?MODULE,f1,1}, + [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true}]}], + [local]), + %% + %% Expected: + %% + [{trace,Tracee,call,{?MODULE,f1,[start]}}, + {trace,Tracee,return_to, + {?MODULE,'-silent_no_ms/1-fun-3-',0}}, + {trace,Tracee,call,{?MODULE,f2,[f,g]}}, + {trace,Tracee,return_to, + {?MODULE,'-silent_no_ms/1-fun-3-',0}}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,return_to, + {?MODULE,'-silent_no_ms/1-fun-3-',0}}, + {trace,Tracee,call,{?MODULE,f2,[h,i]}}, + {trace,Tracee,return_to,{?MODULE,f3,2}}] + end). + +%% Test that match_spec_test does not activate silent silent_test(_Config) -> {flags,[]} = erlang:trace_info(self(),flags), erlang:match_spec_test([],[{'_',[],[{silent,true}]}],trace), {flags,[]} = erlang:trace_info(self(),flags). -ms_trace2(doc) -> - ["Test the match spec functions {trace/2}"]; -ms_trace2(suite) -> []; +%% Test the match spec functions {trace/2} ms_trace2(Config) when is_list(Config) -> Tracer = self(), %% Meta trace init @@ -521,75 +497,60 @@ ms_trace2(Config) when is_list(Config) -> %% Trace global f1/1, local f2/2, global erlang:integer_to_list/1 %% without match spec. Use match spec functions %% {trace/2} to control trace through fn/2,3. - ?line tr( - fun () -> - ?MODULE:f1(a), - ?MODULE:f2(b, c), - _ = erlang:integer_to_list(id(1)), - ?MODULE:f3(d, e), - fn([all], [call,return_to,{tracer,Tracer}]), - ?MODULE:f1(f), - f2(g, h), - f1(i), - _ = erlang:integer_to_list(id(2)), - ?MODULE:f3(j, k), - fn([call,return_to], []), - ?MODULE:f1(l), - ?MODULE:f2(m, n), - _ = erlang:integer_to_list(id(3)), - ?MODULE:f3(o, p) - end, - fun (Tracee) -> - ?line 1 = - erlang:trace(Tracee, false, [all]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f1,1}, - [], - [global]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f2,2}, - [], - [local]), - ?line 1 = - erlang:trace_pattern( - {erlang,integer_to_list,1}, - [], - [global]), - ?line 3 = - erlang:trace_pattern( - {?MODULE,fn,'_'}, - [{['$1','$2'],[], - [{trace,'$1','$2'},{message,ms_trace2}]}], - [meta]), - %% - %% Expected: (no return_to for global call trace) - %% - ?line Origin = {match_spec_SUITE,'-ms_trace2/1-fun-0-',1}, - ?line - [{trace_ts,Tracee,call, - {?MODULE,fn, - [[all],[call,return_to,{tracer,Tracer}]]}, - ms_trace2}, - {trace,Tracee,call,{?MODULE,f1,[f]}}, - {trace,Tracee,call,{?MODULE,f2,[g,h]}}, - {trace,Tracee,return_to,Origin}, - {trace,Tracee,call,{erlang,integer_to_list,[2]}}, - {trace,Tracee,call,{?MODULE,f2,[j,k]}}, - {trace,Tracee,return_to,{?MODULE,f3,2}}, - {trace_ts,Tracee,call, - {?MODULE,fn, - [[call,return_to],[]]}, - ms_trace2}] - end), + tr( + fun () -> + ?MODULE:f1(a), + ?MODULE:f2(b, c), + _ = erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + fn([all], [call,return_to,{tracer,Tracer}]), + ?MODULE:f1(f), + f2(g, h), + f1(i), + _ = erlang:integer_to_list(id(2)), + ?MODULE:f3(j, k), + fn([call,return_to], []), + ?MODULE:f1(l), + ?MODULE:f2(m, n), + _ = erlang:integer_to_list(id(3)), + ?MODULE:f3(o, p) + end, + fun (Tracee) -> + 1 = erlang:trace(Tracee, false, [all]), + 1 = erlang:trace_pattern( {?MODULE,f1,1}, [], [global]), + 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [local]), + 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [global]), + 3 = erlang:trace_pattern( + {?MODULE,fn,'_'}, + [{['$1','$2'],[], + [{trace,'$1','$2'},{message,ms_trace2}]}], + [meta]), + %% + %% Expected: (no return_to for global call trace) + %% + Origin = {match_spec_SUITE,'-ms_trace2/1-fun-1-',1}, + [{trace_ts,Tracee,call, + {?MODULE,fn, + [[all],[call,return_to,{tracer,Tracer}]]}, + ms_trace2}, + {trace,Tracee,call,{?MODULE,f1,[f]}}, + {trace,Tracee,call,{?MODULE,f2,[g,h]}}, + {trace,Tracee,return_to,Origin}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,call,{?MODULE,f2,[j,k]}}, + {trace,Tracee,return_to,{?MODULE,f3,2}}, + {trace_ts,Tracee,call, + {?MODULE,fn, + [[call,return_to],[]]}, + ms_trace2}] + end), + %% Silence valgrind + erlang:trace_pattern({?MODULE,fn,'_'},[],[]), ok. -ms_trace3(doc) -> - ["Test the match spec functions {trace/3}"]; -ms_trace3(suite) -> []; +%% Test the match spec functions {trace/3} ms_trace3(Config) when is_list(Config) -> TraceeName = 'match_spec_SUITE:ms_trace3', Tracer = self(), @@ -600,134 +561,140 @@ ms_trace3(Config) when is_list(Config) -> %% {trace/2} to control trace through fn/2,3. Tag = make_ref(), Controller = - spawn_link( - fun () -> - receive - {Tracee,Tag,start} -> - fn(TraceeName, [all], - [call,return_to,send,'receive', - {tracer,Tracer}]), - Tracee ! {self(),Tag,started}, - receive {Tracee,Tag,stop_1} -> ok end, - fn(Tracee, [call,return_to], []), - Tracee ! {self(),Tag,stopped_1}, - receive {Tracee,Tag,stop_2} -> ok end, - fn(Tracee, [all], []), - Tracee ! {self(),Tag,stopped_2} - end - end), - ?line tr( - fun () -> %% Action - register(TraceeName, self()), - ?MODULE:f1(a), - ?MODULE:f2(b, c), - _ = erlang:integer_to_list(id(1)), - ?MODULE:f3(d, e), - Controller ! {self(),Tag,start}, - receive {Controller,Tag,started} -> ok end, - ?MODULE:f1(f), - f2(g, h), - f1(i), - _ = erlang:integer_to_list(id(2)), - ?MODULE:f3(j, k), - Controller ! {self(),Tag,stop_1}, - receive {Controller,Tag,stopped_1} -> ok end, - ?MODULE:f1(l), - ?MODULE:f2(m, n), - _ = erlang:integer_to_list(id(3)), - ?MODULE:f3(o, p), - Controller ! {self(),Tag,stop_2}, - receive {Controller,Tag,stopped_2} -> ok end, - ?MODULE:f1(q), - ?MODULE:f2(r, s), - _ = erlang:integer_to_list(id(4)), - ?MODULE:f3(t, u) - end, - - fun (Tracee) -> %% Startup - ?line 1 = - erlang:trace(Tracee, false, [all]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f1,1}, - [], - [global]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f2,2}, - [], - [local]), - ?line 1 = - erlang:trace_pattern( - {erlang,integer_to_list,1}, - [], - [global]), - ?line 3 = - erlang:trace_pattern( - {?MODULE,fn,'_'}, - [{['$1','$2','$3'],[], - [{trace,'$1','$2','$3'},{message,Tag}]}], - [meta]), - %% - %% Expected: (no return_to for global call trace) - %% - ?line Origin = {match_spec_SUITE,'-ms_trace3/1-fun-1-',2}, - ?line - [{trace_ts,Controller,call, - {?MODULE,fn,[TraceeName,[all], - [call,return_to,send,'receive', - {tracer,Tracer}]]}, - Tag}, - {trace,Tracee,'receive',{Controller,Tag,started}}, - {trace,Tracee,call,{?MODULE,f1,[f]}}, - {trace,Tracee,call,{?MODULE,f2,[g,h]}}, - {trace,Tracee,return_to,Origin}, - {trace,Tracee,call,{erlang,integer_to_list,[2]}}, - {trace,Tracee,call,{?MODULE,f2,[j,k]}}, - {trace,Tracee,return_to,{?MODULE,f3,2}}, - {trace,Tracee,send,{Tracee,Tag,stop_1},Controller}, - {trace_ts,Controller,call, - {?MODULE,fn,[Tracee,[call,return_to],[]]}, - Tag}, - {trace_ts,Controller,call, - {?MODULE,fn,[Tracee,[all],[]]}, - Tag}] - end), + spawn_link( + fun () -> + receive + {Tracee,Tag,start} -> + fn(TraceeName, [all], + [call,return_to,send,'receive', + {tracer,Tracer}]), + Tracee ! {self(),Tag,started}, + receive {Tracee,Tag,stop_1} -> ok end, + fn(Tracee, [call,return_to], []), + Tracee ! {self(),Tag,stopped_1}, + receive {Tracee,Tag,stop_2} -> ok end, + fn(Tracee, [all], []), + Tracee ! {self(),Tag,stopped_2} + end + end), + tr( + fun () -> %% Action + register(TraceeName, self()), + ?MODULE:f1(a), + ?MODULE:f2(b, c), + _ = erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + Controller ! {self(),Tag,start}, + receive {Controller,Tag,started} -> ok end, + ?MODULE:f1(f), + f2(g, h), + f1(i), + _ = erlang:integer_to_list(id(2)), + ?MODULE:f3(j, k), + Controller ! {self(),Tag,stop_1}, + receive {Controller,Tag,stopped_1} -> ok end, + ?MODULE:f1(l), + ?MODULE:f2(m, n), + _ = erlang:integer_to_list(id(3)), + ?MODULE:f3(o, p), + Controller ! {self(),Tag,stop_2}, + receive {Controller,Tag,stopped_2} -> ok end, + ?MODULE:f1(q), + ?MODULE:f2(r, s), + _ = erlang:integer_to_list(id(4)), + ?MODULE:f3(t, u) + end, + + fun (Tracee) -> %% Startup + 1 = erlang:trace(Tracee, false, [all]), + 1 = erlang:trace_pattern( {?MODULE,f1,1}, [], [global]), + 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [local]), + 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [global]), + 3 = erlang:trace_pattern( + {?MODULE,fn,'_'}, + [{['$1','$2','$3'],[], + [{trace,'$1','$2','$3'},{message,Tag}]}], + [meta]), + %% + %% Expected: (no return_to for global call trace) + %% + Origin = {match_spec_SUITE,'-ms_trace3/1-fun-2-',2}, + [{trace_ts,Controller,call, + {?MODULE,fn,[TraceeName,[all], + [call,return_to,send,'receive', + {tracer,Tracer}]]}, + Tag}, + {trace,Tracee,'receive',{Controller,Tag,started}}, + {trace,Tracee,call,{?MODULE,f1,[f]}}, + {trace,Tracee,call,{?MODULE,f2,[g,h]}}, + {trace,Tracee,return_to,Origin}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,call,{?MODULE,f2,[j,k]}}, + {trace,Tracee,return_to,{?MODULE,f3,2}}, + {trace,Tracee,send,{Tracee,Tag,stop_1},Controller}, + {trace_ts,Controller,call, + {?MODULE,fn,[Tracee,[call,return_to],[]]}, + Tag}, + {trace_ts,Controller,call, + {?MODULE,fn,[Tracee,[all],[]]}, + Tag}] + end), ok. - - -destructive_in_test_bif(doc) -> - ["Test that destructive operations in test bif does not really happen"]; -destructive_in_test_bif(suite) -> []; +%% Test that a dead tracer is removed using ms +ms_trace_dead(_Config) -> + Self = self(), + TFun = fun F() -> receive M -> Self ! M, F() end end, + {Tracer, MRef} = spawn_monitor(TFun), + MetaTracer = spawn_link(TFun), + erlang:trace_pattern({?MODULE, f1, '_'}, + [{'_',[],[{message, false}, + {trace,[], + [call,{const,{tracer,Tracer}}]}]}], + [{meta, MetaTracer}]), + erlang:trace_pattern({?MODULE, f2, '_'}, []), + ?MODULE:f2(1,2), + ?MODULE:f1(1), + {tracer,Tracer} = erlang:trace_info(self(), tracer), + {flags,[call]} = erlang:trace_info(self(), flags), + ?MODULE:f2(2,3), + receive {trace, Self, call, {?MODULE, f2, _}} -> ok end, + exit(Tracer, stop), + receive {'DOWN',MRef,_,_,_} -> ok end, + ?MODULE:f1(2), + {tracer,[]} = erlang:trace_info(self(), tracer), + ?MODULE:f2(3,4), + TRef = erlang:trace_delivered(all), + receive {trace_delivered, _, TRef} -> ok end, + receive M -> ct:fail({unexpected, M}) after 10 -> ok end. + +%% Test that destructive operations in test bif does not really happen destructive_in_test_bif(Config) when is_list(Config) -> - ?line {ok,OldToken,_,_} = erlang:match_spec_test + {ok,OldToken,_,_} = erlang:match_spec_test ([], [{'_',[],[{message,{get_seq_token}}]}],trace), - ?line {ok,_,_,_} = erlang:match_spec_test + {ok,_,_,_} = erlang:match_spec_test ([], [{'_',[],[{message,{set_seq_token, label, 1}}]}], trace), - ?line {ok,OldToken,_,_} = erlang:match_spec_test + {ok,OldToken,_,_} = erlang:match_spec_test ([], [{'_',[],[{message,{get_seq_token}}]}],trace), - ?line {ok, OldTCW,_,_} = erlang:match_spec_test + {ok, OldTCW,_,_} = erlang:match_spec_test ([],[{'_',[],[{message,{get_tcw}}]}],trace), - ?line {ok,OldTCW,_,_} = erlang:match_spec_test + {ok,OldTCW,_,_} = erlang:match_spec_test ([], [{'_',[],[{message,{set_tcw, OldTCW+1}}]}], trace), - ?line {ok, OldTCW,_,_} = erlang:match_spec_test + {ok, OldTCW,_,_} = erlang:match_spec_test ([],[{'_',[],[{message,{get_tcw}}]}],trace), ok. -boxed_and_small(doc) -> - ["Test that the comparision between boxed and small does not crash emulator"]; -boxed_and_small(suite) -> []; +%% Test that the comparison between boxed and small does not crash emulator boxed_and_small(Config) when is_list(Config) -> - ?line {ok, Node} = start_node(match_spec_suite_other), - ?line ok = rpc:call(Node,?MODULE,do_boxed_and_small,[]), - ?line stop_node(Node), + {ok, Node} = start_node(match_spec_suite_other), + ok = rpc:call(Node,?MODULE,do_boxed_and_small,[]), + stop_node(Node), ok. do_boxed_and_small() -> @@ -737,13 +704,11 @@ do_boxed_and_small() -> {ok, false, _, _} = erlang:match_spec_test({0,3},[{{make_ref(),'_'},[],['$_']}],table), ok. -faulty_seq_trace(doc) -> - ["Test that faulty seq_trace_call does not crash emulator"]; -faulty_seq_trace(suite) -> []; +%% Test that faulty seq_trace_call does not crash emulator faulty_seq_trace(Config) when is_list(Config) -> - ?line {ok, Node} = start_node(match_spec_suite_other), - ?line ok = rpc:call(Node,?MODULE,do_faulty_seq_trace,[]), - ?line stop_node(Node), + {ok, Node} = start_node(match_spec_suite_other), + ok = rpc:call(Node,?MODULE,do_faulty_seq_trace,[]), + stop_node(Node), ok. do_faulty_seq_trace() -> @@ -755,63 +720,58 @@ errchk(Pat) -> {'EXIT', {badarg, _}} -> ok; Other -> - test_server:fail({noerror, Other}) + ct:fail({noerror, Other}) end. -unary_minus(suite) -> - []; -unary_minus(doc) -> - ["Checks that unary minus works"]; +%% Checks that unary minus works unary_minus(Config) when is_list(Config) -> - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'<',{'-','$1'},-4}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'<',{'-','$1'},-6}], [true]}], table), - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'=:=',{'-','$1',2},3}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (hej, [{'$1', [{'=/=',{'-','$1'},0}], [true]}], table), ok. -unary_plus(suite) -> - []; -unary_plus(doc) -> - ["Checks that unary plus works"]; + +%% Checks that unary plus works unary_plus(Config) when is_list(Config) -> - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'<',{'+','$1'},6}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'<',{'+','$1'},4}], [true]}], table), - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'=:=',{'+','$1',2},7}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (hej, [{'$1', [{'=/=',{'+','$1'},0}], @@ -822,53 +782,50 @@ unary_plus(Config) when is_list(Config) -> -guard_exceptions(suite) -> - []; -guard_exceptions(doc) -> - ["Checks that exceptions in guards are handled correctly"]; +%% Checks that exceptions in guards are handled correctly guard_exceptions(Config) when is_list(Config) -> - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'},{'or','$1','$1'}}], [true]}], table), - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'orelse',{is_integer,'$1'}, {'or','$1','$1'}}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'orelse',{'or','$1',true}, {is_integer,'$1'}}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'}, {'orelse','$1',true}}], [true]}], table), - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'}, {'orelse',true,'$1'}}], [true]}], table), - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'}, {'andalso',false,'$1'}}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'}, @@ -876,7 +833,7 @@ guard_exceptions(Config) when is_list(Config) -> [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'}, @@ -886,19 +843,84 @@ guard_exceptions(Config) when is_list(Config) -> ok. -fpe(suite) -> - []; -fpe(doc) -> - ["Checks floating point exceptions in match-specs"]; +%% Checks floating point exceptions in match-specs fpe(Config) when is_list(Config) -> MS = [{{'$1'},[],[{'/','$1',0}]}], case catch (['EXIT','EXIT'] = ets:match_spec_run([{1},{2}],ets:match_spec_compile(MS))) of - {'EXIT',_} -> test_server:fail({error, - "Floating point exceptions faulty"}); + {'EXIT',_} -> ct:fail({error, "Floating point exceptions faulty"}); _ -> ok end. +%% Test maps in match-specs +maps(Config) when is_list(Config) -> + {ok,#{},[],[]} = erlang:match_spec_test(#{}, [{'_',[],['$_']}], table), + {ok,#{},[],[]} = erlang:match_spec_test(#{}, [{#{},[],['$_']}], table), + {ok,false,[],[]} = + erlang:match_spec_test(#{}, [{not_a_map,[],['$_']}], table), + {ok,bar,[],[]} = + erlang:match_spec_test(#{foo => bar}, + [{#{foo => '$1'},[],['$1']}], + table), + {ok,false,[],[]} = + erlang:match_spec_test(#{foo => bar}, + [{#{foo => qux},[],[qux]}], + table), + {ok,false,[],[]} = + erlang:match_spec_test(#{}, [{#{foo => '_'},[],[foo]}], table), + {error,_} = + erlang:match_spec_test(#{}, [{#{'$1' => '_'},[],[foo]}], table), + {ok,bar,[],[]} = + erlang:match_spec_test({#{foo => bar}}, + [{{#{foo => '$1'}},[],['$1']}], + table), + {ok,#{foo := 3},[],[]} = + erlang:match_spec_test({}, [{{},[],[#{foo => {'+',1,2}}]}], table), + + {ok,"camembert",[],[]} = + erlang:match_spec_test(#{b => "camembert",c => "cabécou"}, + [{#{b => '$1',c => "cabécou"},[],['$1']}], table), + + {ok,#{a :="camembert",b := "hi"},[],[]} = + erlang:match_spec_test(#{<<"b">> =>"camembert","c"=>"cabécou", "wat"=>"hi", b=><<"other">>}, + [{#{<<"b">> => '$1',"wat" => '$2'},[],[#{a=>'$1',b=>'$2'}]}], + table), + %% large maps + + Ls0 = [{I,<<I:32>>}||I <- lists:seq(1,415)], + M0 = maps:from_list(Ls0), + M1 = #{a=>1,b=>2,c=>3,d=>4}, + + R1 = M0#{263 := #{ a=> 3 }}, + Ms1 = [{M1#{c:='$1'},[],[M0#{263 := #{a => '$1'}}]}], + + {ok,R1,[],[]} = erlang:match_spec_test(M1,Ms1,table), + + Ms2 = [{M0#{63:='$1', 19:='$2'},[],[M0#{19:='$1', 63:='$2'}]}], + R2 = M0#{63 := maps:get(19,M0), 19 := maps:get(63,M0) }, + {ok,R2,[],[]} = erlang:match_spec_test(M0,Ms2,table), + + ok = maps_check_loop(M1), + ok = maps_check_loop(M0), + M2 = maps:from_list([{integer_to_list(K),V} || {K,V} <- Ls0]), + ok = maps_check_loop(M2), + ok. + +maps_check_loop(M) -> + Ks = maps:keys(M), + maps_check_loop(M,M,M,M,Ks,lists:reverse(Ks),1). + +maps_check_loop(Orig,M0,MsM0,Rm0,[K|Ks],[Rk|Rks],Ix) -> + MsK = list_to_atom([$$]++integer_to_list(Ix)), + MsM1 = MsM0#{K := MsK}, + Rm1 = Rm0#{Rk := MsK}, + M1 = M0#{Rk := maps:get(K,MsM0)}, + Ms = [{MsM1,[],[Rm1]}], + {ok,M1,[],[]} = erlang:match_spec_test(Orig,Ms,table), + maps_check_loop(Orig,M1,MsM1,Rm1,Ks,Rks,Ix+1); +maps_check_loop(_,_,_,_,[],[],_) -> ok. + + empty_list(Config) when is_list(Config) -> Val=[{'$1',[], [{message,'$1'},{message,{caller}},{return_trace}]}], %% Did crash debug VM in faulty assert: @@ -910,11 +932,11 @@ moving_labels(Config) when is_list(Config) -> %% point at their correct target. %% Ms = [{{'$1','$2'},[],[{{ok,{'andalso','$1','$2'},[1,2,3]}}]}], - ?line {ok,{ok,false,[1,2,3]},[],[]} = + {ok,{ok,false,[1,2,3]},[],[]} = erlang:match_spec_test({true,false}, Ms, table), Ms2 = [{{'$1','$2'},[],[{{ok,{'orelse','$1','$2'},[1,2,3]}}]}], - ?line {ok,{ok,true,[1,2,3]},[],[]} = + {ok,{ok,true,[1,2,3]},[],[]} = erlang:match_spec_test({true,false}, Ms2, table), ok. @@ -925,17 +947,17 @@ tr(Fun, MFA, Pat, Expected) -> tr(Fun, MFA, TraceFlags, Pat, PatFlags, Expected0) -> tr(Fun, fun(P) -> - erlang:trace(P, true, TraceFlags), - erlang:trace_pattern(MFA, Pat, PatFlags), - lists:map( - fun(X) -> - list_to_tuple([trace, P | tuple_to_list(X)]) - end, - Expected0) + erlang:trace(P, true, TraceFlags), + erlang:trace_pattern(MFA, Pat, PatFlags), + lists:map( + fun(X) when is_function(X,1) -> X; + (X) -> list_to_tuple([trace, P | tuple_to_list(X)]) + end, + Expected0) end). tr(RunFun, ControlFun) -> - P = spawn(?MODULE, runner, [self(), RunFun]), + P = spawn_link(?MODULE, runner, [self(), RunFun]), collect(P, ControlFun(P)). collect(P, TMs) -> @@ -946,36 +968,57 @@ collect(P, TMs) -> collect([]) -> receive M -> - ?t:format("Got unexpected: ~p~n", [M]), + io:format("Got unexpected: ~p~n", [M]), flush({got_unexpected,M}) after 17 -> ok end; collect([TM | TMs]) -> - ?t:format( "Expecting: ~p~n", [TM]), + io:format( "Expecting: ~p~n", [TM]), receive - M -> - case if element(1, M) == trace_ts -> - list_to_tuple(lists:reverse( - tl(lists:reverse(tuple_to_list(M))))); - true -> M - end of - TM -> - ?t:format("Got: ~p~n", [M]), - collect(TMs); - _ -> - ?t:format("Got unexpected: ~p~n", [M]), - flush({got_unexpected,M}) + %% We only look at trace messages with the same tracee + %% as the message we are looking for. This because + %% the order of trace messages is only guaranteed from + %% within a single process. + M0 when element(2, M0) =:= element(2, TM); is_function(TM, 1) -> + M = case element(1, M0) of + trace_ts -> + list_to_tuple(lists:reverse( + tl(lists:reverse(tuple_to_list(M0))))); + _ -> M0 + end, + case is_function(TM,1) of + true -> + case (catch TM(M)) of + true -> + io:format("Got: ~p~n", [M]), + collect(TMs); + _ -> + io:format("Got unexpected: ~p~n", [M]), + flush({got_unexpected,M}) + end; + + false -> + case M of + TM -> + io:format("Got: ~p~n", [M]), + collect(TMs); + _ -> + io:format("Got unexpected: ~p~n", [M]), + flush({got_unexpected,M}) + end end + after 15000 -> + flush(timeout) end. flush(Reason) -> receive - M -> - ?t:format("In queue: ~p~n", [M]), - flush(Reason) + M -> + io:format("In queue: ~p~n", [M]), + flush(Reason) after 17 -> - ?t:fail(Reason) + ct:fail(Reason) end. start_collect(P) -> @@ -986,43 +1029,45 @@ stop_collect(P) -> stop_collect(P, Order) -> P ! {Order, self()}, receive - {gone, P} -> - ok + {gone, P} -> + ok end. runner(Collector, Fun) -> receive - {go, Collector} -> - go + {go, Collector} -> + go end, Fun(), receive - {done, Collector} -> - Collector ! {gone, self()} + {done, Collector} -> + Collector ! {gone, self()} end. loop_runner(Collector, Fun, Laps) -> receive - {go, Collector} -> - go + {go, Collector} -> + go end, loop_runner_cont(Collector, Fun, 0, Laps). -loop_runner_cont(_Collector, _Fun, Laps, Laps) -> +loop_runner_cont(Collector, _Fun, Laps, Laps) -> receive - {done, Collector} -> - io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]), - Collector ! {gone, self()} - end; + {done, Collector} -> ok; + {abort, Collector} -> ok + end, + io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]), + Collector ! {gone, self()}; + loop_runner_cont(Collector, Fun, N, Laps) -> Fun(), receive - {abort, Collector} -> - io:format("loop_runner ~p aborted after ~p of ~p laps\n", [self(), N+1, Laps]), - Collector ! {gone, self()} + {abort, Collector} -> + io:format("loop_runner ~p aborted after ~p of ~p laps\n", [self(), N+1, Laps]), + Collector ! {gone, self()} after 0 -> - loop_runner_cont(Collector, Fun, N+1, Laps) + loop_runner_cont(Collector, Fun, N+1, Laps) end. @@ -1043,6 +1088,10 @@ fn(X, Y) -> fn(X, Y, Z) -> [X, Y, Z]. +fbinmatch(<<Int, Rest/binary>>, Acc) -> + fbinmatch(Rest, [?MODULE:f1(Int) | Acc]); +fbinmatch(<<>>, Acc) -> Acc. + id(X) -> X. @@ -1050,7 +1099,7 @@ start_node(Name) -> Pa = filename:dirname(code:which(?MODULE)), Cookie = atom_to_list(erlang:get_cookie()), test_server:start_node(Name, slave, - [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). + [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). stop_node(Node) -> test_server:stop_node(Node). diff --git a/erts/emulator/test/message_queue_data_SUITE.erl b/erts/emulator/test/message_queue_data_SUITE.erl new file mode 100644 index 0000000000..7f0cbdd885 --- /dev/null +++ b/erts/emulator/test/message_queue_data_SUITE.erl @@ -0,0 +1,207 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(message_queue_data_SUITE). + +-export([all/0, suite/0]). +-export([basic/1, process_info_messages/1, total_heap_size/1]). + +-export([basic_test/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. + +all() -> + [basic, process_info_messages, total_heap_size]. + +%% +%% +%% Test cases +%% +%% + +basic(Config) when is_list(Config) -> + + basic_test(erlang:system_info(message_queue_data)), + + {ok, Node1} = start_node(Config, "+hmqd off_heap"), + ok = rpc:call(Node1, ?MODULE, basic_test, [off_heap]), + stop_node(Node1), + + {ok, Node2} = start_node(Config, "+hmqd on_heap"), + ok = rpc:call(Node2, ?MODULE, basic_test, [on_heap]), + stop_node(Node2), + + ok. + +is_valid_mqd_value(off_heap) -> + true; +is_valid_mqd_value(on_heap) -> + true; +is_valid_mqd_value(_) -> + false. + + +basic_test(Default) -> + + Default = erlang:system_info(message_queue_data), + true = is_valid_mqd_value(Default), + + {message_queue_data, Default} = process_info(self(), message_queue_data), + Default = process_flag(message_queue_data, off_heap), + {message_queue_data, off_heap} = process_info(self(), message_queue_data), + off_heap = process_flag(message_queue_data, on_heap), + {message_queue_data, on_heap} = process_info(self(), message_queue_data), + {'EXIT', _} = (catch process_flag(message_queue_data, blupp)), + + P1 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link]), + {message_queue_data, Default} = process_info(P1, message_queue_data), + unlink(P1), + exit(P1, bye), + + P2 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, off_heap}]), + {message_queue_data, off_heap} = process_info(P2, message_queue_data), + unlink(P2), + exit(P2, bye), + + P3 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, on_heap}]), + {message_queue_data, on_heap} = process_info(P3, message_queue_data), + unlink(P3), + exit(P3, bye), + + {'EXIT', _} = (catch spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, blapp}])), + + ok. + +process_info_messages(Config) when is_list(Config) -> + Tester = self(), + P1 = spawn_opt(fun () -> + receive after 500 -> ok end, + on_heap = process_flag(message_queue_data, off_heap), + Tester ! first, + receive after 500 -> ok end, + off_heap = process_flag(message_queue_data, on_heap), + Tester ! second, + receive after 500 -> ok end, + on_heap = process_flag(message_queue_data, off_heap), + Tester ! third, + + receive after infinity -> ok end + end, + [link, {message_queue_data, on_heap}]), + + P1 ! "A", + receive first -> ok end, + P1 ! "B", + receive second -> ok end, + P1 ! "C", + receive third -> ok end, + P1 ! "D", + + {messages, ["A", "B", "C", "D"]} = process_info(P1, messages), + + P2 = spawn_opt(fun () -> + receive after 500 -> ok end, + on_heap = process_flag(message_queue_data, off_heap), + Tester ! first, + receive after 500 -> ok end, + off_heap = process_flag(message_queue_data, on_heap), + Tester ! second, + receive after 500 -> ok end, + on_heap = process_flag(message_queue_data, off_heap), + Tester ! third, + receive after 500 -> ok end, + + Tester ! process_info(self(), messages), + + receive M1 -> M1 = "A" end, + receive M2 -> M2 = "B" end, + receive M3 -> M3 = "C" end, + receive M4 -> M4 = "D" end, + + Tester ! self() + end, + [link, {message_queue_data, on_heap}]), + + P2 ! "A", + receive first -> ok end, + P2 ! "B", + receive second -> ok end, + P2 ! "C", + receive third -> ok end, + P2 ! "D", + + receive + Msg -> + {messages, ["A", "B", "C", "D"]} = Msg + end, + + receive P2 -> ok end, + + ok. + +total_heap_size(_Config) -> + + Fun = fun F() -> receive Pid when is_pid(Pid) -> Pid ! ok,F() end end, + + %% Test that on_heap messages grow the heap even if they are not received + OnPid = spawn_opt(Fun, [{message_queue_data, on_heap},link]), + {total_heap_size, OnSize} = erlang:process_info(OnPid, total_heap_size), + [OnPid ! lists:duplicate(N,N) || N <- lists:seq(1,100)], + OnPid ! self(), receive ok -> ok end, + {total_heap_size, OnSizeAfter} = erlang:process_info(OnPid, total_heap_size), + ct:log("OnSize = ~p, OnSizeAfter = ~p",[OnSize, OnSizeAfter]), + true = OnSize < OnSizeAfter, + + %% Test that off_heap messages do not grow the heap if they are not received + OffPid = spawn_opt(Fun, [{message_queue_data, off_heap},link]), + {total_heap_size, OffSize} = erlang:process_info(OffPid, total_heap_size), + [OffPid ! lists:duplicate(N,N) || N <- lists:seq(1,100)], + OffPid ! self(), receive ok -> ok end, + {total_heap_size, OffSizeAfter} = erlang:process_info(OffPid, total_heap_size), + ct:log("OffSize = ~p, OffSizeAfter = ~p",[OffSize, OffSizeAfter]), + true = OffSize == OffSizeAfter. + +%% +%% +%% helpers +%% +%% + +start_node(Config, Opts) when is_list(Config), is_list(Opts) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + +stop_node(Node) -> + test_server:stop_node(Node). diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl index 8a63d9fe3e..ba9b564fdc 100644 --- a/erts/emulator/test/module_info_SUITE.erl +++ b/erts/emulator/test/module_info_SUITE.erl @@ -1,77 +1,52 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(module_info_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - exports/1,functions/1,native/1]). +-export([all/0, suite/0, + exports/1,functions/1,deleted/1,native/1,info/1]). %%-compile(native). %% Helper. -export([native_proj/1,native_filter/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> modules(). -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -modules() -> - [exports, functions, native]. - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(3)), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). +modules() -> + [exports, functions, deleted, native, info]. %% Should return all functions exported from this module. (local) all_exported() -> All = add_arity(modules()), - lists:sort([{all,0},{suite,0},{groups,0}, - {init_per_suite,1},{end_per_suite,1}, - {init_per_group,2},{end_per_group,2}, - {init_per_testcase,2},{end_per_testcase,2}, - {module_info,0},{module_info,1},{native_proj,1}, - {native_filter,1}|All]). + lists:sort([{all,0},{suite,0}, + {module_info,0},{module_info,1}, + {native_proj,1}, + {native_filter,1}|All]). %% Should return all functions in this module. (local) all_functions() -> @@ -81,40 +56,66 @@ all_functions() -> %% Test that the list of exported functions from this module is correct. exports(Config) when is_list(Config) -> - ?line All = all_exported(), - ?line All = lists:sort(?MODULE:module_info(exports)), - ?line (catch ?MODULE:foo()), - ?line All = lists:sort(?MODULE:module_info(exports)), + All = all_exported(), + All = lists:sort(?MODULE:module_info(exports)), + (catch ?MODULE:foo()), + All = lists:sort(?MODULE:module_info(exports)), ok. %% Test that the list of exported functions from this module is correct. functions(Config) when is_list(Config) -> - ?line All = all_functions(), - ?line All = lists:sort(?MODULE:module_info(functions)), + All = all_functions(), + All = lists:sort(?MODULE:module_info(functions)), + ok. + +%% Test that deleted modules cause badarg +deleted(Config) when is_list(Config) -> + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "module_info_test"), + {ok,module_info_test,Code} = compile:file(File, [binary]), + {module,module_info_test} = erlang:load_module(module_info_test, Code), + 17 = module_info_test:f(), + [_|_] = erlang:get_module_info(module_info_test, attributes), + [_|_] = erlang:get_module_info(module_info_test), + + %% first delete it + true = erlang:delete_module(module_info_test), + {'EXIT',{undef, _}} = (catch module_info_test:f()), + {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test,attributes)), + {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test)), + + %% then purge it + true = erlang:purge_module(module_info_test), + {'EXIT',{undef, _}} = (catch module_info_test:f()), + {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test,attributes)), + {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test)), ok. %% Test that the list of exported functions from this module is correct. +%% Verify that module_info(native) works. native(Config) when is_list(Config) -> - ?line All = all_functions(), - ?line case ?MODULE:module_info(native_addresses) of - [] -> - {comment,"no native functions"}; - L -> - %% Verify that all functions have unique addresses. - ?line S0 = sofs:set(L, [{name,arity,addr}]), - ?line S1 = sofs:projection({external,fun ?MODULE:native_proj/1}, S0), - ?line S2 = sofs:relation_to_family(S1), - ?line S3 = sofs:family_specification(fun ?MODULE:native_filter/1, S2), - ?line 0 = sofs:no_elements(S3), - ?line S4 = sofs:range(S1), - - %% Verify that the set of function with native addresses - %% is a subset of all functions in the module. - ?line AllSet = sofs:set(All, [{name,arity}]), - ?line true = sofs:is_subset(S4, AllSet), - - {comment,integer_to_list(sofs:no_elements(S0))++" native functions"} - end. + All = all_functions(), + case ?MODULE:module_info(native_addresses) of + [] -> + false = ?MODULE:module_info(native), + {comment,"no native functions"}; + L -> + true = ?MODULE:module_info(native), + %% Verify that all functions have unique addresses. + S0 = sofs:set(L, [{name,arity,addr}]), + S1 = sofs:projection({external,fun ?MODULE:native_proj/1}, S0), + S2 = sofs:relation_to_family(S1), + S3 = sofs:family_specification(fun ?MODULE:native_filter/1, S2), + 0 = sofs:no_elements(S3), + S4 = sofs:range(S1), + + %% Verify that the set of function with native addresses + %% is a subset of all functions in the module. + AllSet = sofs:set(All, [{name,arity}]), + true = sofs:is_subset(S4, AllSet), + + {comment,integer_to_list(sofs:no_elements(S0))++" native functions"} + end. native_proj({Name,Arity,Addr}) -> {Addr,{Name,Arity}}. @@ -122,6 +123,22 @@ native_proj({Name,Arity,Addr}) -> native_filter(Set) -> sofs:no_elements(Set) =/= 1. +%% Test that the module info of this module is correct. Use +%% erlang:get_module_info(?MODULE) to avoid compiler optimization tricks. +info(Config) when is_list(Config) -> + Info = erlang:get_module_info(?MODULE), + All = all_exported(), + {ok,{?MODULE,MD5}} = beam_lib:md5(code:which(?MODULE)), + {module, ?MODULE} = lists:keyfind(module, 1, Info), + {md5, MD5} = lists:keyfind(md5, 1, Info), + {exports, Exports} = lists:keyfind(exports, 1, Info), + All = lists:sort(Exports), + {attributes, Attrs} = lists:keyfind(attributes, 1, Info), + {vsn,_} = lists:keyfind(vsn, 1, Attrs), + {compile, Compile} = lists:keyfind(compile, 1, Info), + {options,_} = lists:keyfind(options, 1, Compile), + ok. + %% Helper functions (local). add_arity(L) -> diff --git a/erts/emulator/test/module_info_SUITE_data/module_info_test.erl b/erts/emulator/test/module_info_SUITE_data/module_info_test.erl new file mode 100644 index 0000000000..6eaf21b9c9 --- /dev/null +++ b/erts/emulator/test/module_info_SUITE_data/module_info_test.erl @@ -0,0 +1,24 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %CopyrightEnd% +%% + +-module(module_info_test). +-export([f/0]). + +f() -> + 17. diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl index aec59867d8..9d772480d9 100644 --- a/erts/emulator/test/monitor_SUITE.erl +++ b/erts/emulator/test/monitor_SUITE.erl @@ -1,175 +1,149 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(monitor_SUITE). --include_lib("test_server/include/test_server.hrl"). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - case_1/1, case_1a/1, case_2/1, case_2a/1, mon_e_1/1, demon_e_1/1, demon_1/1, - demon_2/1, demon_3/1, demonitor_flush/1, - local_remove_monitor/1, remote_remove_monitor/1, mon_1/1, mon_2/1, - large_exit/1, list_cleanup/1, mixer/1, named_down/1, otp_5827/1]). +-include_lib("common_test/include/ct.hrl"). +-include_lib("eunit/include/eunit.hrl"). --export([init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, groups/0, + case_1/1, case_1a/1, case_2/1, case_2a/1, mon_e_1/1, demon_e_1/1, demon_1/1, + demon_2/1, demon_3/1, demonitor_flush/1, + local_remove_monitor/1, remote_remove_monitor/1, mon_1/1, mon_2/1, + large_exit/1, list_cleanup/1, mixer/1, named_down/1, otp_5827/1, + monitor_time_offset/1]). -export([y2/1, g/1, g0/0, g1/0, large_exit_sub/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 15}}]. all() -> [case_1, case_1a, case_2, case_2a, mon_e_1, demon_e_1, demon_1, mon_1, mon_2, demon_2, demon_3, demonitor_flush, {group, remove_monitor}, large_exit, - list_cleanup, mixer, named_down, otp_5827]. + list_cleanup, mixer, named_down, otp_5827, + monitor_time_offset]. groups() -> [{remove_monitor, [], [local_remove_monitor, remote_remove_monitor]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(15)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -case_1(doc) -> - "A monitors B, B kills A and then exits (yielded core dump)"; -case_1(suite) -> []; +%% A monitors B, B kills A and then exits (yielded core dump) case_1(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line spawn_link(?MODULE, g0, []), - ?line receive _ -> ok end, + process_flag(trap_exit, true), + spawn_link(?MODULE, g0, []), + receive _ -> ok end, ok. -case_1a(doc) -> - "A monitors B, B kills A and then exits (yielded core dump)"; +%% A monitors B, B kills A and then exits (yielded core dump) case_1a(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line spawn_link(?MODULE, g1, []), - ?line receive _ -> ok end, + process_flag(trap_exit, true), + spawn_link(?MODULE, g1, []), + receive _ -> ok end, ok. g0() -> - ?line B = spawn(?MODULE, g, [self()]), - ?line erlang:monitor(process, B), - ?line B ! ok, - ?line receive ok -> ok end, + B = spawn(?MODULE, g, [self()]), + erlang:monitor(process, B), + B ! ok, + receive ok -> ok end, ok. g1() -> - ?line {B,_} = spawn_monitor(?MODULE, g, [self()]), - ?line B ! ok, - ?line receive ok -> ok end, + {B,_} = spawn_monitor(?MODULE, g, [self()]), + B ! ok, + receive ok -> ok end, ok. g(Parent) -> - ?line receive ok -> ok end, - ?line exit(Parent, foo), - ?line ok. + receive ok -> ok end, + exit(Parent, foo), + ok. -case_2(doc) -> - "A monitors B, B demonitors A (yielded core dump)"; +%% A monitors B, B demonitors A (yielded core dump) case_2(Config) when is_list(Config) -> - ?line B = spawn(?MODULE, y2, [self()]), - ?line R = erlang:monitor(process, B), - ?line B ! R, - ?line receive - {'EXIT', _} -> ok; - Other -> - test_server:fail({rec, Other}) - end, - ?line expect_down(R, B, normal), + B = spawn(?MODULE, y2, [self()]), + R = erlang:monitor(process, B), + B ! R, + receive + {'EXIT', _} -> ok; + Other -> + ct:fail({rec, Other}) + end, + expect_down(R, B, normal), ok. -case_2a(doc) -> - "A monitors B, B demonitors A (yielded core dump)"; +%% A monitors B, B demonitors A (yielded core dump) case_2a(Config) when is_list(Config) -> - ?line {B,R} = spawn_monitor(?MODULE, y2, [self()]), - ?line B ! R, - ?line receive - {'EXIT', _} -> ok; - Other -> - test_server:fail({rec, Other}) - end, - ?line expect_down(R, B, normal), + {B,R} = spawn_monitor(?MODULE, y2, [self()]), + B ! R, + receive + {'EXIT', _} -> ok; + Other -> + ct:fail({rec, Other}) + end, + expect_down(R, B, normal), ok. y2(Parent) -> - ?line R = receive T -> T end, - ?line Parent ! (catch erlang:demonitor(R)), + R = receive T -> T end, + Parent ! (catch erlang:demonitor(R)), ok. expect_down(Ref, P) -> receive - {'DOWN', Ref, process, P, Reason} -> - Reason; - Other -> - test_server:fail({rec, Other}) + {'DOWN', Ref, process, P, Reason} -> + Reason; + Other -> + ct:fail({rec, Other}) end. expect_down(Ref, P, Reason) -> receive - {'DOWN', Ref, process, P, Reason} -> - ok; - Other -> - test_server:fail({rec, Other}) + {'DOWN', Ref, process, P, Reason} -> + ok; + Other -> + ct:fail({rec, Other}) end. expect_no_msg() -> receive - Msg -> - test_server:fail({msg, Msg}) + Msg -> + ct:fail({msg, Msg}) after 0 -> - ok + ok end. %%% Error cases for monitor/2 -mon_e_1(doc) -> - "Error cases for monitor/2"; -mon_e_1(suite) -> []; mon_e_1(Config) when is_list(Config) -> - ?line {ok, N} = test_server:start_node(hej, slave, []), - ?line mon_error(plutt, self()), - ?line mon_error(process, [bingo]), - ?line mon_error(process, {rex, N, junk}), - ?line mon_error(process, 1), + {ok, N} = test_server:start_node(hej, slave, []), + mon_error(plutt, self()), + mon_error(process, [bingo]), + mon_error(process, {rex, N, junk}), + mon_error(process, 1), - ?line true = test_server:stop_node(N), + true = test_server:stop_node(N), ok. %%% We would also like to have a test case that tries to monitor something @@ -182,155 +156,142 @@ mon_e_1(Config) when is_list(Config) -> mon_error(Type, Item) -> case catch erlang:monitor(Type, Item) of - {'EXIT', _} -> - ok; - Other -> - test_server:fail({err, Other}) + {'EXIT', _} -> + ok; + Other -> + ct:fail({err, Other}) end. %%% Error cases for demonitor/1 -demon_e_1(doc) -> - "Error cases for demonitor/1"; -demon_e_1(suite) -> []; demon_e_1(Config) when is_list(Config) -> - ?line {ok, N} = test_server:start_node(hej, slave, []), - ?line demon_error(plutt, badarg), - ?line demon_error(1, badarg), + {ok, N} = test_server:start_node(hej, slave, []), + demon_error(plutt, badarg), + demon_error(1, badarg), %% Demonitor with ref created at other node - ?line R1 = rpc:call(N, erlang, make_ref, []), - ?line demon_error(R1, badarg), + R1 = rpc:call(N, erlang, make_ref, []), + demon_error(R1, badarg), %% Demonitor with ref created at wrong monitor link end - ?line P0 = self(), - ?line P2 = spawn( - fun() -> - P0 ! {self(), ref, erlang:monitor(process,P0)}, - receive {P0, stop} -> ok end - end ), - ?line receive - {P2, ref, R2} -> - ?line demon_error(R2, badarg), - ?line P2 ! {self(), stop}; - Other2 -> - test_server:fail({rec, Other2}) - end, - - ?line true = test_server:stop_node(N), + P0 = self(), + P2 = spawn( + fun() -> + P0 ! {self(), ref, erlang:monitor(process,P0)}, + receive {P0, stop} -> ok end + end ), + receive + {P2, ref, R2} -> + demon_error(R2, badarg), + P2 ! {self(), stop}; + Other2 -> + ct:fail({rec, Other2}) + end, + + true = test_server:stop_node(N), ok. demon_error(Ref, Reason) -> case catch erlang:demonitor(Ref) of - {'EXIT', {Reason, _}} -> - ok; - Other -> - test_server:fail({err, Other}) + {'EXIT', {Reason, _}} -> + ok; + Other -> + ct:fail({err, Other}) end. %%% No-op cases for demonitor/1 -demon_1(doc) -> - "demonitor/1"; -demon_1(suite) -> []; demon_1(Config) when is_list(Config) -> - ?line true = erlang:demonitor(make_ref()), + true = erlang:demonitor(make_ref()), ok. %%% Cases for demonitor/1 -demon_2(doc) -> - "Cases for demonitor/1"; -demon_2(suite) -> []; demon_2(Config) when is_list(Config) -> - ?line R1 = erlang:monitor(process, self()), - ?line true = erlang:demonitor(R1), + R1 = erlang:monitor(process, self()), + true = erlang:demonitor(R1), %% Extra demonitor - ?line true = erlang:demonitor(R1), - ?line expect_no_msg(), + true = erlang:demonitor(R1), + expect_no_msg(), %% Normal 'DOWN' - ?line P2 = spawn(timer, sleep, [1]), - ?line R2 = erlang:monitor(process, P2), - ?line case expect_down(R2, P2) of - normal -> ?line ok; - noproc -> ?line ok; - BadReason -> ?line ?t:fail({bad_reason, BadReason}) - end, - -%% OTP-5772 -% %% 'DOWN' before demonitor -% ?line P3 = spawn(timer, sleep, [100000]), -% ?line R3 = erlang:monitor(process, P3), -% ?line exit(P3, frop), -% ?line erlang:demonitor(R3), -% ?line expect_down(R3, P3, frop), + P2 = spawn(timer, sleep, [1]), + R2 = erlang:monitor(process, P2), + case expect_down(R2, P2) of + normal -> ok; + noproc -> ok; + BadReason -> ct:fail({bad_reason, BadReason}) + end, + + %% OTP-5772 + % %% 'DOWN' before demonitor + % P3 = spawn(timer, sleep, [100000]), + % R3 = erlang:monitor(process, P3), + % exit(P3, frop), + % erlang:demonitor(R3), + % expect_down(R3, P3, frop), %% Demonitor before 'DOWN' - ?line P4 = spawn(timer, sleep, [100000]), - ?line R4 = erlang:monitor(process, P4), - ?line erlang:demonitor(R4), - ?line exit(P4, frop), - ?line expect_no_msg(), + P4 = spawn(timer, sleep, [100000]), + R4 = erlang:monitor(process, P4), + erlang:demonitor(R4), + exit(P4, frop), + expect_no_msg(), ok. -demon_3(doc) -> - "Distributed case for demonitor/1 (OTP-3499)"; -demon_3(suite) -> []; +%% Distributed case for demonitor/1 (OTP-3499) demon_3(Config) when is_list(Config) -> - ?line {ok, N} = test_server:start_node(hej, slave, []), + {ok, N} = test_server:start_node(hej, slave, []), %% 'DOWN' before demonitor - ?line P2 = spawn(N, timer, sleep, [100000]), - ?line R2 = erlang:monitor(process, P2), - ?line true = test_server:stop_node(N), - ?line true = erlang:demonitor(R2), - ?line expect_down(R2, P2, noconnection), + P2 = spawn(N, timer, sleep, [100000]), + R2 = erlang:monitor(process, P2), + true = test_server:stop_node(N), + true = erlang:demonitor(R2), + expect_down(R2, P2, noconnection), - ?line {ok, N2} = test_server:start_node(hej, slave, []), + {ok, N2} = test_server:start_node(hej, slave, []), %% Demonitor before 'DOWN' - ?line P3 = spawn(N2, timer, sleep, [100000]), - ?line R3 = erlang:monitor(process, P3), - ?line true = erlang:demonitor(R3), - ?line true = test_server:stop_node(N2), - ?line expect_no_msg(), + P3 = spawn(N2, timer, sleep, [100000]), + R3 = erlang:monitor(process, P3), + true = erlang:demonitor(R3), + true = test_server:stop_node(N2), + expect_no_msg(), ok. -demonitor_flush(suite) -> []; -demonitor_flush(doc) -> []; demonitor_flush(Config) when is_list(Config) -> - ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), flush)), - ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), [flus])), - ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(x, [flush])), - ?line {ok, N} = test_server:start_node(demonitor_flush, slave, []), - ?line ok = demonitor_flush_test(N), - ?line true = test_server:stop_node(N), - ?line ok = demonitor_flush_test(node()). - + {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), flush)), + {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), [flus])), + {'EXIT', {badarg, _}} = (catch erlang:demonitor(x, [flush])), + {ok, N} = test_server:start_node(demonitor_flush, slave, []), + ok = demonitor_flush_test(N), + true = test_server:stop_node(N), + ok = demonitor_flush_test(node()). + demonitor_flush_test(Node) -> - ?line P = spawn(Node, timer, sleep, [100000]), - ?line M1 = erlang:monitor(process, P), - ?line M2 = erlang:monitor(process, P), - ?line M3 = erlang:monitor(process, P), - ?line M4 = erlang:monitor(process, P), - ?line true = erlang:demonitor(M1, [flush, flush]), - ?line exit(P, bang), - ?line receive {'DOWN', M2, process, P, bang} -> ok end, - ?line receive after 100 -> ok end, - ?line true = erlang:demonitor(M3, [flush]), - ?line true = erlang:demonitor(M4, []), - ?line receive {'DOWN', M4, process, P, bang} -> ok end, - ?line receive - {'DOWN', M, _, _, _} =DM when M == M1, - M == M3 -> - ?line ?t:fail({unexpected_down_message, DM}) - after 100 -> - ?line ok - end. + P = spawn(Node, timer, sleep, [100000]), + M1 = erlang:monitor(process, P), + M2 = erlang:monitor(process, P), + M3 = erlang:monitor(process, P), + M4 = erlang:monitor(process, P), + true = erlang:demonitor(M1, [flush, flush]), + exit(P, bang), + receive {'DOWN', M2, process, P, bang} -> ok end, + receive after 100 -> ok end, + true = erlang:demonitor(M3, [flush]), + true = erlang:demonitor(M4, []), + receive {'DOWN', M4, process, P, bang} -> ok end, + receive + {'DOWN', M, _, _, _} =DM when M == M1, + M == M3 -> + ct:fail({unexpected_down_message, DM}) + after 100 -> + ok + end. -define(RM_MON_GROUPS, 100). -define(RM_MON_GPROCS, 100). @@ -338,33 +299,33 @@ demonitor_flush_test(Node) -> local_remove_monitor(Config) when is_list(Config) -> Gs = generate(fun () -> start_remove_monitor_group(node()) end, - ?RM_MON_GROUPS), + ?RM_MON_GROUPS), {True, False} = lists:foldl(fun (G, {T, F}) -> - receive - {rm_mon_res, G, {GT, GF}} -> - {T+GT, F+GF} - end - end, - {0, 0}, - Gs), + receive + {rm_mon_res, G, {GT, GF}} -> + {T+GT, F+GF} + end + end, + {0, 0}, + Gs), erlang:display({local_remove_monitor, True, False}), {comment, "True = "++integer_to_list(True)++"; False = "++integer_to_list(False)}. - + remote_remove_monitor(Config) when is_list(Config) -> - ?line {ok, N} = test_server:start_node(demonitor_flush, slave, []), + {ok, N} = test_server:start_node(demonitor_flush, slave, []), Gs = generate(fun () -> start_remove_monitor_group(node()) end, - ?RM_MON_GROUPS), + ?RM_MON_GROUPS), {True, False} = lists:foldl(fun (G, {T, F}) -> - receive - {rm_mon_res, G, {GT, GF}} -> - {T+GT, F+GF} - end - end, - {0, 0}, - Gs), + receive + {rm_mon_res, G, {GT, GF}} -> + {T+GT, F+GF} + end + end, + {0, 0}, + Gs), erlang:display({remote_remove_monitor, True, False}), - ?line true = test_server:stop_node(N), + true = test_server:stop_node(N), {comment, "True = "++integer_to_list(True)++"; False = "++integer_to_list(False)}. @@ -372,161 +333,153 @@ start_remove_monitor_group(Node) -> Master = self(), spawn_link( fun () -> - Ms = generate(fun () -> - P = spawn(Node, fun () -> ok end), - erlang:monitor(process, P) - end, ?RM_MON_GPROCS), - Res = lists:foldl(fun (M, {T, F}) -> - case erlang:demonitor(M, [info]) of - true -> - receive - {'DOWN', M, _, _, _} -> - exit(down_msg_found) - after 0 -> - ok - end, - {T+1, F}; - false -> - receive - {'DOWN', M, _, _, _} -> - ok - after 0 -> - exit(no_down_msg_found) - end, - {T, F+1} - end - end, - {0,0}, - Ms), - Master ! {rm_mon_res, self(), Res} + Ms = generate(fun () -> + P = spawn(Node, fun () -> ok end), + erlang:monitor(process, P) + end, ?RM_MON_GPROCS), + Res = lists:foldl(fun (M, {T, F}) -> + case erlang:demonitor(M, [info]) of + true -> + receive + {'DOWN', M, _, _, _} -> + exit(down_msg_found) + after 0 -> + ok + end, + {T+1, F}; + false -> + receive + {'DOWN', M, _, _, _} -> + ok + after 0 -> + exit(no_down_msg_found) + end, + {T, F+1} + end + end, + {0,0}, + Ms), + Master ! {rm_mon_res, self(), Res} end). - - + + %%% Cases for monitor/2 -mon_1(doc) -> - "Cases for monitor/2"; -mon_1(suite) -> []; mon_1(Config) when is_list(Config) -> %% Normal case - ?line P2 = spawn(timer, sleep, [1]), - ?line R2 = erlang:monitor(process, P2), - ?line case expect_down(R2, P2) of - normal -> ?line ok; - noproc -> ?line ok; - BadReason -> ?line ?t:fail({bad_reason, BadReason}) - end, - ?line {P2A,R2A} = spawn_monitor(timer, sleep, [1]), - ?line expect_down(R2A, P2A, normal), + P2 = spawn(timer, sleep, [1]), + R2 = erlang:monitor(process, P2), + case expect_down(R2, P2) of + normal -> ok; + noproc -> ok; + BadReason -> ct:fail({bad_reason, BadReason}) + end, + {P2A,R2A} = spawn_monitor(timer, sleep, [1]), + expect_down(R2A, P2A, normal), %% 'DOWN' with other reason - ?line P3 = spawn(timer, sleep, [100000]), - ?line R3 = erlang:monitor(process, P3), - ?line exit(P3, frop), - ?line expect_down(R3, P3, frop), - ?line {P3A,R3A} = spawn_monitor(timer, sleep, [100000]), - ?line exit(P3A, frop), - ?line expect_down(R3A, P3A, frop), + P3 = spawn(timer, sleep, [100000]), + R3 = erlang:monitor(process, P3), + exit(P3, frop), + expect_down(R3, P3, frop), + {P3A,R3A} = spawn_monitor(timer, sleep, [100000]), + exit(P3A, frop), + expect_down(R3A, P3A, frop), %% Monitor fails because process is dead - ?line R4 = erlang:monitor(process, P3), - ?line expect_down(R4, P3, noproc), + R4 = erlang:monitor(process, P3), + expect_down(R4, P3, noproc), %% Normal case (named process) - ?line P5 = start_jeeves(jeeves), - ?line R5 = erlang:monitor(process, jeeves), - ?line tell_jeeves(P5, stop), - ?line expect_down(R5, {jeeves, node()}, normal), + P5 = start_jeeves(jeeves), + R5 = erlang:monitor(process, jeeves), + tell_jeeves(P5, stop), + expect_down(R5, {jeeves, node()}, normal), %% 'DOWN' with other reason and node explicit activation - ?line P6 = start_jeeves(jeeves), - ?line R6 = erlang:monitor(process, {jeeves, node()}), - ?line tell_jeeves(P6, {exit, frop}), - ?line expect_down(R6, {jeeves, node()}, frop), + P6 = start_jeeves(jeeves), + R6 = erlang:monitor(process, {jeeves, node()}), + tell_jeeves(P6, {exit, frop}), + expect_down(R6, {jeeves, node()}, frop), %% Monitor (named process) fails because process is dead - ?line R7 = erlang:monitor(process, {jeeves, node()}), - ?line expect_down(R7, {jeeves, node()}, noproc), + R7 = erlang:monitor(process, {jeeves, node()}), + expect_down(R7, {jeeves, node()}, noproc), ok. -mon_2(doc) -> - "Distributed cases for monitor/2"; -mon_2(suite) -> []; +%% Distributed cases for monitor/2 mon_2(Config) when is_list(Config) -> - ?line {ok, N1} = test_server:start_node(hej1, slave, []), + {ok, N1} = test_server:start_node(hej1, slave, []), %% Normal case - ?line P2 = spawn(N1, timer, sleep, [4000]), - ?line R2 = erlang:monitor(process, P2), - ?line expect_down(R2, P2, normal), + P2 = spawn(N1, timer, sleep, [4000]), + R2 = erlang:monitor(process, P2), + expect_down(R2, P2, normal), %% 'DOWN' with other reason - ?line P3 = spawn(N1, timer, sleep, [100000]), - ?line R3 = erlang:monitor(process, P3), - ?line exit(P3, frop), - ?line expect_down(R3, P3, frop), + P3 = spawn(N1, timer, sleep, [100000]), + R3 = erlang:monitor(process, P3), + exit(P3, frop), + expect_down(R3, P3, frop), %% Monitor fails because process is dead - ?line R4 = erlang:monitor(process, P3), - ?line expect_down(R4, P3, noproc), + R4 = erlang:monitor(process, P3), + expect_down(R4, P3, noproc), %% Other node goes down - ?line P5 = spawn(N1, timer, sleep, [100000]), - ?line R5 = erlang:monitor(process, P5), + P5 = spawn(N1, timer, sleep, [100000]), + R5 = erlang:monitor(process, P5), - ?line true = test_server:stop_node(N1), + true = test_server:stop_node(N1), - ?line expect_down(R5, P5, noconnection), + expect_down(R5, P5, noconnection), %% Monitor fails because other node is dead - ?line P6 = spawn(N1, timer, sleep, [100000]), - ?line R6 = erlang:monitor(process, P6), - ?line R6_Reason = expect_down(R6, P6), - ?line true = (R6_Reason == noconnection) orelse (R6_Reason == noproc), + P6 = spawn(N1, timer, sleep, [100000]), + R6 = erlang:monitor(process, P6), + R6_Reason = expect_down(R6, P6), + true = (R6_Reason == noconnection) orelse (R6_Reason == noproc), %% Start a new node that can load code in this module - ?line PA = filename:dirname(code:which(?MODULE)), - ?line {ok, N2} = test_server:start_node - (hej2, slave, [{args, "-pa " ++ PA}]), + PA = filename:dirname(code:which(?MODULE)), + {ok, N2} = test_server:start_node + (hej2, slave, [{args, "-pa " ++ PA}]), %% Normal case (named process) - ?line P7 = start_jeeves({jeeves, N2}), - ?line R7 = erlang:monitor(process, {jeeves, N2}), - ?line tell_jeeves(P7, stop), - ?line expect_down(R7, {jeeves, N2}, normal), + P7 = start_jeeves({jeeves, N2}), + R7 = erlang:monitor(process, {jeeves, N2}), + tell_jeeves(P7, stop), + expect_down(R7, {jeeves, N2}, normal), %% 'DOWN' with other reason (named process) - ?line P8 = start_jeeves({jeeves, N2}), - ?line R8 = erlang:monitor(process, {jeeves, N2}), - ?line tell_jeeves(P8, {exit, frop}), - ?line expect_down(R8, {jeeves, N2}, frop), + P8 = start_jeeves({jeeves, N2}), + R8 = erlang:monitor(process, {jeeves, N2}), + tell_jeeves(P8, {exit, frop}), + expect_down(R8, {jeeves, N2}, frop), %% Monitor (named process) fails because process is dead - ?line R9 = erlang:monitor(process, {jeeves, N2}), - ?line expect_down(R9, {jeeves, N2}, noproc), + R9 = erlang:monitor(process, {jeeves, N2}), + expect_down(R9, {jeeves, N2}, noproc), %% Other node goes down (named process) - ?line _P10 = start_jeeves({jeeves, N2}), - ?line R10 = erlang:monitor(process, {jeeves, N2}), + _P10 = start_jeeves({jeeves, N2}), + R10 = erlang:monitor(process, {jeeves, N2}), - ?line true = test_server:stop_node(N2), + true = test_server:stop_node(N2), - ?line expect_down(R10, {jeeves, N2}, noconnection), + expect_down(R10, {jeeves, N2}, noconnection), %% Monitor (named process) fails because other node is dead - ?line R11 = erlang:monitor(process, {jeeves, N2}), - ?line expect_down(R11, {jeeves, N2}, noconnection), + R11 = erlang:monitor(process, {jeeves, N2}), + expect_down(R11, {jeeves, N2}, noconnection), ok. %%% Large exit reason. Crashed first attempt to release R5B. -large_exit(doc) -> - "Large exit reason"; -large_exit(suite) -> []; large_exit(Config) when is_list(Config) -> - ?line f(100), + f(100), ok. f(0) -> @@ -536,23 +489,23 @@ f(N) -> f(N-1). f() -> - ?line S0 = {big, tuple, with, [list, 4563784278]}, - ?line S = {S0, term_to_binary(S0)}, - ?line P = spawn(?MODULE, large_exit_sub, [S]), - ?line R = erlang:monitor(process, P), - ?line P ! hej, + S0 = {big, tuple, with, [list, 4563784278]}, + S = {S0, term_to_binary(S0)}, + P = spawn(?MODULE, large_exit_sub, [S]), + R = erlang:monitor(process, P), + P ! hej, receive - {'DOWN', R, process, P, X} -> - ?line io:format(" -> ~p~n", [X]), - if - X == S -> - ok; - true -> - test_server:fail({X, S}) - end; - Other -> - ?line io:format(" -> ~p~n", [Other]), - exit({answer, Other}) + {'DOWN', R, process, P, X} -> + io:format(" -> ~p~n", [X]), + if + X == S -> + ok; + true -> + ct:fail({X, S}) + end; + Other -> + io:format(" -> ~p~n", [Other]), + exit({answer, Other}) end. large_exit_sub(S) -> @@ -563,280 +516,341 @@ large_exit_sub(S) -> %%% by using erlang:process_info(self(), monitors) %%% and erlang:process_info(self(), monitored_by) -list_cleanup(doc) -> - "Testing of monitor link list cleanup by using " ++ - "erlang:process_info/2"; -list_cleanup(suite) -> []; list_cleanup(Config) when is_list(Config) -> - ?line P0 = self(), - ?line M = node(), - ?line PA = filename:dirname(code:which(?MODULE)), - ?line true = register(master_bertie, self()), + P0 = self(), + M = node(), + PA = filename:dirname(code:which(?MODULE)), + true = register(master_bertie, self()), %% Normal local case, monitor and demonitor - ?line P1 = start_jeeves(jeeves), - ?line {[], []} = monitors(), - ?line expect_jeeves(P1, monitors, {monitors, {[], []}}), - ?line R1a = erlang:monitor(process, P1), - ?line {[{process, P1}], []} = monitors(), - ?line expect_jeeves(P1, monitors, {monitors, {[], [P0]}}), - ?line true = erlang:demonitor(R1a), - ?line expect_no_msg(), - ?line {[], []} = monitors(), - ?line expect_jeeves(P1, monitors, {monitors, {[], []}}), + P1 = start_jeeves(jeeves), + {[], []} = monitors(), + expect_jeeves(P1, monitors, {monitors, {[], []}}), + R1a = erlang:monitor(process, P1), + {[{process, P1}], []} = monitors(), + expect_jeeves(P1, monitors, {monitors, {[], [P0]}}), + true = erlang:demonitor(R1a), + expect_no_msg(), + {[], []} = monitors(), + expect_jeeves(P1, monitors, {monitors, {[], []}}), %% Remonitor named and try again, now exiting the monitored process - ?line R1b = erlang:monitor(process, jeeves), - ?line {[{process, {jeeves, M}}], []} = monitors(), - ?line expect_jeeves(P1, monitors, {monitors, {[], [P0]}}), - ?line tell_jeeves(P1, stop), - ?line expect_down(R1b, {jeeves, node()}, normal), - ?line {[], []} = monitors(), + R1b = erlang:monitor(process, jeeves), + {[{process, {jeeves, M}}], []} = monitors(), + expect_jeeves(P1, monitors, {monitors, {[], [P0]}}), + tell_jeeves(P1, stop), + expect_down(R1b, {jeeves, node()}, normal), + {[], []} = monitors(), %% Slightly weird local case - the monitoring process crashes - ?line P2 = start_jeeves(jeeves), - ?line {[], []} = monitors(), - ?line expect_jeeves(P2, monitors, {monitors, {[], []}}), - ?line {monitor_process, _R2} = - ask_jeeves(P2, {monitor_process, master_bertie}), - ?line {[], [P2]} = monitors(), - ?line expect_jeeves(P2, monitors, - {monitors, {[{process, {master_bertie, node()}}], []}}), - ?line tell_jeeves(P2, {exit, frop}), + P2 = start_jeeves(jeeves), + {[], []} = monitors(), + expect_jeeves(P2, monitors, {monitors, {[], []}}), + {monitor_process, _R2} = + ask_jeeves(P2, {monitor_process, master_bertie}), + {[], [P2]} = monitors(), + expect_jeeves(P2, monitors, + {monitors, {[{process, {master_bertie, node()}}], []}}), + tell_jeeves(P2, {exit, frop}), timer:sleep(2000), - ?line {[], []} = monitors(), + {[], []} = monitors(), %% Start a new node that can load code in this module - ?line {ok, J} = test_server:start_node - (jeeves, slave, [{args, "-pa " ++ PA}]), + {ok, J} = test_server:start_node + (jeeves, slave, [{args, "-pa " ++ PA}]), %% Normal remote case, monitor and demonitor - ?line P3 = start_jeeves({jeeves, J}), - ?line {[], []} = monitors(), - ?line expect_jeeves(P3, monitors, {monitors, {[], []}}), - ?line R3a = erlang:monitor(process, P3), - ?line {[{process, P3}], []} = monitors(), - ?line expect_jeeves(P3, monitors, {monitors, {[], [P0]}}), - ?line true = erlang:demonitor(R3a), - ?line expect_no_msg(), - ?line {[], []} = monitors(), - ?line expect_jeeves(P3, monitors, {monitors, {[], []}}), + P3 = start_jeeves({jeeves, J}), + {[], []} = monitors(), + expect_jeeves(P3, monitors, {monitors, {[], []}}), + R3a = erlang:monitor(process, P3), + {[{process, P3}], []} = monitors(), + expect_jeeves(P3, monitors, {monitors, {[], [P0]}}), + true = erlang:demonitor(R3a), + expect_no_msg(), + {[], []} = monitors(), + expect_jeeves(P3, monitors, {monitors, {[], []}}), %% Remonitor named and try again, now exiting the monitored process - ?line R3b = erlang:monitor(process, {jeeves, J}), - ?line {[{process, {jeeves, J}}], []} = monitors(), - ?line expect_jeeves(P3, monitors, {monitors, {[], [P0]}}), - ?line tell_jeeves(P3, stop), - ?line expect_down(R3b, {jeeves, J}, normal), - ?line {[], []} = monitors(), + R3b = erlang:monitor(process, {jeeves, J}), + {[{process, {jeeves, J}}], []} = monitors(), + expect_jeeves(P3, monitors, {monitors, {[], [P0]}}), + tell_jeeves(P3, stop), + expect_down(R3b, {jeeves, J}, normal), + {[], []} = monitors(), %% Slightly weird remote case - the monitoring process crashes - ?line P4 = start_jeeves({jeeves, J}), - ?line {[], []} = monitors(), - ?line expect_jeeves(P4, monitors, {monitors, {[], []}}), - ?line {monitor_process, _R4} = - ask_jeeves(P4, {monitor_process, {master_bertie, M}}), - ?line {[], [P4]} = monitors(), - ?line expect_jeeves(P4, monitors, - {monitors, {[{process, {master_bertie, M}}], []}} ), - ?line tell_jeeves(P4, {exit, frop}), + P4 = start_jeeves({jeeves, J}), + {[], []} = monitors(), + expect_jeeves(P4, monitors, {monitors, {[], []}}), + {monitor_process, _R4} = + ask_jeeves(P4, {monitor_process, {master_bertie, M}}), + {[], [P4]} = monitors(), + expect_jeeves(P4, monitors, + {monitors, {[{process, {master_bertie, M}}], []}} ), + tell_jeeves(P4, {exit, frop}), timer:sleep(2000), - ?line {[], []} = monitors(), - + {[], []} = monitors(), + %% Now, the monitoring remote node crashes - ?line P5 = start_jeeves({jeeves, J}), - ?line {[], []} = monitors(), - ?line expect_jeeves(P5, monitors, {monitors, {[], []}}), - ?line {monitor_process, _R5} = - ask_jeeves(P5, {monitor_process, P0}), - ?line {[], [P5]} = monitors(), - ?line expect_jeeves(P5, monitors, - {monitors, {[{process, P0}], []}} ), - ?line test_server:stop_node(J), + P5 = start_jeeves({jeeves, J}), + {[], []} = monitors(), + expect_jeeves(P5, monitors, {monitors, {[], []}}), + {monitor_process, _R5} = + ask_jeeves(P5, {monitor_process, P0}), + {[], [P5]} = monitors(), + expect_jeeves(P5, monitors, + {monitors, {[{process, P0}], []}} ), + test_server:stop_node(J), timer:sleep(4000), - ?line {[], []} = monitors(), - - ?line true = unregister(master_bertie), + {[], []} = monitors(), + + true = unregister(master_bertie), ok. - + %%% Mixed internal and external monitors -mixer(doc) -> - "Test mixing of internal and external monitors."; mixer(Config) when is_list(Config) -> - ?line PA = filename:dirname(code:which(?MODULE)), - ?line NN = [j0,j1,j2,j3], -% ?line NN = [j0,j1], - ?line NL0 = [begin - {ok, J} = test_server:start_node - (X, slave, [{args, "-pa " ++ PA}]), - J - end || X <- NN], - ?line NL1 = lists:duplicate(2,node()) ++ NL0, - ?line Perm = perm(NL1), - ?line lists:foreach( - fun(NL) -> - ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], - ?line [ask_jeeves(P,{monitor_process,self()}) || P <- Js], - ?line {monitored_by,MB} = - process_info(self(),monitored_by), - ?line MBL = lists:sort(MB), - ?line JsL = lists:sort(Js), - ?line MBL = JsL, - ?line {monitors,[]} = process_info(self(),monitors), - ?line [tell_jeeves(P,{exit,flaff}) || P <- Js], - ?line wait_for_m([],[],200) - end, - Perm), - ?line lists:foreach( - fun(NL) -> - ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], - ?line Rs = [begin - {monitor_process,Ref} = - ask_jeeves(P,{monitor_process,self()}), - {P,Ref} - end - || P <- Js], - ?line {monitored_by,MB} = - process_info(self(),monitored_by), - ?line MBL = lists:sort(MB), - ?line JsL = lists:sort(Js), - ?line MBL = JsL, - ?line {monitors,[]} = process_info(self(),monitors), - ?line [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs], - ?line wait_for_m([],[],200), - ?line [tell_jeeves(P,{exit,flaff}) || P <- Js] - end, - Perm), - ?line lists:foreach( - fun(NL) -> - ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], - ?line [ask_jeeves(P,{monitor_process,self()}) || P <- Js], - ?line [erlang:monitor(process,P) || P <- Js], - ?line {monitored_by,MB} = - process_info(self(),monitored_by), - ?line MBL = lists:sort(MB), - ?line JsL = lists:sort(Js), - ?line MBL = JsL, - ?line {monitors,M} = - process_info(self(),monitors), - ?line ML = lists:sort([P||{process,P} <- M]), - ?line ML = JsL, - ?line [begin - tell_jeeves(P,{exit,flaff}), - receive {'DOWN',_,process,P,_} -> ok end - end || P <- Js], - ?line wait_for_m([],[],200) - end, - Perm), - ?line lists:foreach( - fun(NL) -> - ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], - ?line Rs = [begin - {monitor_process,Ref} = - ask_jeeves(P,{monitor_process,self()}), - {P,Ref} - end - || P <- Js], - ?line R2s = [{P,erlang:monitor(process,P)} || P <- Js], - ?line {monitored_by,MB} = - process_info(self(),monitored_by), - ?line MBL = lists:sort(MB), - ?line JsL = lists:sort(Js), - ?line MBL = JsL, - ?line {monitors,M} = - process_info(self(),monitors), - ?line ML = lists:sort([P||{process,P} <- M]), - ?line ML = JsL, - ?line [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs], - ?line wait_for_m(lists:sort(M),[],200), - ?line [erlang:demonitor(Ref) || {_P,Ref} <- R2s], - ?line wait_for_m([],[],200), - ?line [tell_jeeves(P,{exit,flaff}) || P <- Js] - end, - Perm), - [test_server:stop_node(K) || K <- NL0 ], + PA = filename:dirname(code:which(?MODULE)), + NN = [j0,j1,j2], + NL0 = [begin + {ok, J} = test_server:start_node(X,slave,[{args, "-pa " ++ PA}]), + J + end || X <- NN], + NL1 = lists:duplicate(2,node()) ++ NL0, + Perm = perm(NL1), + lists:foreach( + fun(NL) -> + Js = [start_jeeves({[],M}) || M <- (NL ++ NL)], + [ask_jeeves(P,{monitor_process,self()}) || P <- Js], + {monitored_by,MB} = process_info(self(),monitored_by), + MBL = lists:sort(MB), + JsL = lists:sort(Js), + MBL = JsL, + {monitors,[]} = process_info(self(),monitors), + [tell_jeeves(P,{exit,flaff}) || P <- Js], + wait_for_m([],[],200) + end, + Perm), + lists:foreach( + fun(NL) -> + Js = [start_jeeves({[],M}) || M <- (NL ++ NL)], + Rs = [begin + {monitor_process,Ref} = ask_jeeves(P,{monitor_process,self()}), + {P,Ref} + end || P <- Js], + {monitored_by,MB} = process_info(self(),monitored_by), + MBL = lists:sort(MB), + JsL = lists:sort(Js), + MBL = JsL, + {monitors,[]} = process_info(self(),monitors), + [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs], + wait_for_m([],[],200), + [tell_jeeves(P,{exit,flaff}) || P <- Js] + end, + Perm), + lists:foreach( + fun(NL) -> + Js = [start_jeeves({[],M}) || M <- (NL ++ NL)], + [ask_jeeves(P,{monitor_process,self()}) || P <- Js], + [erlang:monitor(process,P) || P <- Js], + {monitored_by,MB} = process_info(self(),monitored_by), + MBL = lists:sort(MB), + JsL = lists:sort(Js), + MBL = JsL, + {monitors,M} = process_info(self(),monitors), + ML = lists:sort([P||{process,P} <- M]), + ML = JsL, + [begin + tell_jeeves(P,{exit,flaff}), + receive {'DOWN',_,process,P,_} -> ok end + end || P <- Js], + wait_for_m([],[],200) + end, + Perm), + lists:foreach( + fun(NL) -> + Js = [start_jeeves({[],M}) || M <- (NL ++ NL)], + Rs = [begin + {monitor_process,Ref} = ask_jeeves(P,{monitor_process,self()}), + {P,Ref} + end || P <- Js], + R2s = [{P,erlang:monitor(process,P)} || P <- Js], + {monitored_by,MB} = process_info(self(),monitored_by), + MBL = lists:sort(MB), + JsL = lists:sort(Js), + MBL = JsL, + {monitors,M} = process_info(self(),monitors), + ML = lists:sort([P||{process,P} <- M]), + ML = JsL, + [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs], + wait_for_m(lists:sort(M),[],200), + [erlang:demonitor(Ref) || {_P,Ref} <- R2s], + wait_for_m([],[],200), + [tell_jeeves(P,{exit,flaff}) || P <- Js] + end, + Perm), + [test_server:stop_node(K) || K <- NL0], ok. -named_down(doc) -> ["Test that DOWN message for a named monitor isn't" - " delivered until name has been unregistered"]; -named_down(suite) -> []; +%% Test that DOWN message for a named monitor isn't +%% delivered until name has been unregistered named_down(Config) when is_list(Config) -> - ?line {A,B,C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-named_down-" - ++ integer_to_list(A) - ++ "-" ++ integer_to_list(B) - ++ "-" ++ integer_to_list(C)), - ?line Prio = process_flag(priority,high), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-named_down-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), + Prio = process_flag(priority,high), %% Spawn a bunch of high prio cpu bound processes to prevent %% normal prio processes from terminating during the next %% 500 ms... - ?line Self = self(), - ?line spawn_opt(fun () -> - WFun = fun - (F, hej) -> F(F, hopp); - (F, hopp) -> F(F, hej) - end, - NoSchedulers = erlang:system_info(schedulers_online), - lists:foreach(fun (_) -> - spawn_opt(fun () -> - WFun(WFun, - hej) - end, - [{priority,high}, - link]) - end, - lists:seq(1, NoSchedulers)), - receive after 500 -> ok end, - unlink(Self), - exit(bang) - end, - [{priority,high}, link]), - ?line NamedProc = spawn_link(fun () -> - receive after infinity -> ok end - end), - ?line true = register(Name, NamedProc), - ?line unlink(NamedProc), - ?line exit(NamedProc, bang), - ?line Mon = erlang:monitor(process, Name), - ?line receive {'DOWN',Mon, _, _, _} -> ok end, - ?line true = register(Name, self()), - ?line true = unregister(Name), - ?line process_flag(priority,Prio), + Self = self(), + spawn_opt(fun () -> + WFun = fun + (F, hej) -> F(F, hopp); + (F, hopp) -> F(F, hej) + end, + NoSchedulers = erlang:system_info(schedulers_online), + lists:foreach(fun (_) -> + spawn_opt(fun () -> + WFun(WFun, + hej) + end, + [{priority,high}, + link]) + end, + lists:seq(1, NoSchedulers)), + receive after 500 -> ok end, + unlink(Self), + exit(bang) + end, + [{priority,high}, link]), + NamedProc = spawn_link(fun () -> + receive after infinity -> ok end + end), + ?assertEqual(true, register(Name, NamedProc)), + unlink(NamedProc), + exit(NamedProc, bang), + Mon = erlang:monitor(process, Name), + receive {'DOWN',Mon, _, _, bang} -> ok + after 3000 -> ?assert(false) end, + ?assertEqual(true, register(Name, self())), + ?assertEqual(true, unregister(Name)), + process_flag(priority,Prio), ok. -otp_5827(doc) -> []; -otp_5827(suite) -> []; otp_5827(Config) when is_list(Config) -> %% Make a pid with the same nodename but with another creation - ?line [CreEnd | RPTail] - = lists:reverse(binary_to_list(term_to_binary(self()))), - ?line NewCreEnd = case CreEnd of - 0 -> 1; - 1 -> 2; - _ -> CreEnd - 1 - end, - ?line OtherCreationPid - = binary_to_term(list_to_binary(lists:reverse([NewCreEnd | RPTail]))), + [CreEnd | RPTail] + = lists:reverse(binary_to_list(term_to_binary(self()))), + NewCreEnd = case CreEnd of + 0 -> 1; + 1 -> 2; + _ -> CreEnd - 1 + end, + OtherCreationPid + = binary_to_term(list_to_binary(lists:reverse([NewCreEnd | RPTail]))), %% If the bug is present erlang:monitor(process, OtherCreationPid) %% will hang... - ?line Parent = self(), - ?line Ok = make_ref(), - ?line spawn(fun () -> - Mon = erlang:monitor(process, OtherCreationPid), - % Should get the DOWN message right away - receive - {'DOWN', Mon, process, OtherCreationPid, noproc} -> - Parent ! Ok - end - end), - ?line receive - Ok -> - ?line ok - after 1000 -> - ?line ?t:fail("erlang:monitor/2 hangs") - end. + Parent = self(), + Ok = make_ref(), + spawn(fun () -> + Mon = erlang:monitor(process, OtherCreationPid), + % Should get the DOWN message right away + receive + {'DOWN', Mon, process, OtherCreationPid, noproc} -> + Parent ! Ok + end + end), + receive + Ok -> + ok + after 1000 -> + ct:fail("erlang:monitor/2 hangs") + end. + +monitor_time_offset(Config) when is_list(Config) -> + {ok, Node} = start_node(Config, "+C single_time_warp"), + Me = self(), + PMs = lists:map(fun (_) -> + Pid = spawn(Node, + fun () -> + check_monitor_time_offset(Me) + end), + {Pid, erlang:monitor(process, Pid)} + end, + lists:seq(1, 100)), + lists:foreach(fun ({P, _M}) -> + P ! check_no_change_message + end, PMs), + lists:foreach(fun ({P, M}) -> + receive + {no_change_message_received, P} -> + ok; + {'DOWN', M, process, P, Reason} -> + ct:fail(Reason) + end + end, PMs), + preliminary = rpc:call(Node, erlang, system_flag, [time_offset, finalize]), + lists:foreach(fun ({P, M}) -> + receive + {change_messages_received, P} -> + erlang:demonitor(M, [flush]); + {'DOWN', M, process, P, Reason} -> + ct:fail(Reason) + end + end, PMs), + stop_node(Node), + ok. + +check_monitor_time_offset(Leader) -> + Mon1 = erlang:monitor(time_offset, clock_service), + Mon2 = erlang:monitor(time_offset, clock_service), + Mon3 = erlang:monitor(time_offset, clock_service), + Mon4 = erlang:monitor(time_offset, clock_service), + + erlang:demonitor(Mon2, [flush]), + + Mon5 = erlang:monitor(time_offset, clock_service), + Mon6 = erlang:monitor(time_offset, clock_service), + Mon7 = erlang:monitor(time_offset, clock_service), + + receive check_no_change_message -> ok end, + receive + {'CHANGE', _, time_offset, clock_service, _} -> + exit(unexpected_change_message_received) + after 0 -> + Leader ! {no_change_message_received, self()} + end, + receive after 100 -> ok end, + erlang:demonitor(Mon4, [flush]), + receive + {'CHANGE', Mon3, time_offset, clock_service, _} -> + ok + end, + receive + {'CHANGE', Mon6, time_offset, clock_service, _} -> + ok + end, + erlang:demonitor(Mon5, [flush]), + receive + {'CHANGE', Mon7, time_offset, clock_service, _} -> + ok + end, + receive + {'CHANGE', Mon1, time_offset, clock_service, _} -> + ok + end, + receive + {'CHANGE', _, time_offset, clock_service, _} -> + exit(unexpected_change_message_received) + after 1000 -> + ok + end, + Leader ! {change_messages_received, self()}. +%% +%% ... +%% wait_for_m(_,_,0) -> exit(monitor_wait_timeout); @@ -844,17 +858,17 @@ wait_for_m(Monitors, MonitoredBy, N) -> {monitors,M0} = process_info(self(),monitors), {monitored_by,MB0} = process_info(self(),monitored_by), case lists:sort(M0) of - Monitors -> - case lists:sort(MB0) of - MonitoredBy -> - ok; - _ -> - receive after 100 -> ok end, - wait_for_m(Monitors,MonitoredBy,N-1) - end; - _ -> - receive after 100 -> ok end, - wait_for_m(Monitors,MonitoredBy,N-1) + Monitors -> + case lists:sort(MB0) of + MonitoredBy -> + ok; + _ -> + receive after 100 -> ok end, + wait_for_m(Monitors,MonitoredBy,N-1) + end; + _ -> + receive after 100 -> ok end, + wait_for_m(Monitors,MonitoredBy,N-1) end. % All permutations of a list... @@ -878,32 +892,32 @@ jeeves(Parent, Name, Ref) when is_pid(Parent), (is_atom(Name) or (Name =:= [])), is_reference(Ref) -> %%io:format("monitor_SUITE:jeeves(~p, ~p)~n", [Parent, Name]), case Name of - Atom when is_atom(Atom) -> - register(Name, self()); - [] -> - ok + Atom when is_atom(Atom) -> + register(Name, self()); + [] -> + ok end, Parent ! {self(), Ref}, jeeves_loop(Parent). jeeves_loop(Parent) -> receive - {Parent, monitors} -> - Parent ! {self(), {monitors, monitors()}}, - jeeves_loop(Parent); - {Parent, {monitor_process, P}} -> - Parent ! {self(), {monitor_process, - catch erlang:monitor(process, P) }}, - jeeves_loop(Parent); - {Parent, {demonitor, Ref}} -> - Parent ! {self(), {demonitor, catch erlang:demonitor(Ref)}}, - jeeves_loop(Parent); - {Parent, stop} -> - ok; - {Parent, {exit, Reason}} -> - exit(Reason); - Other -> - io:format("~p:jeeves_loop received ~p~n", [?MODULE, Other]) + {Parent, monitors} -> + Parent ! {self(), {monitors, monitors()}}, + jeeves_loop(Parent); + {Parent, {monitor_process, P}} -> + Parent ! {self(), {monitor_process, + catch erlang:monitor(process, P) }}, + jeeves_loop(Parent); + {Parent, {demonitor, Ref}} -> + Parent ! {self(), {demonitor, catch erlang:demonitor(Ref)}}, + jeeves_loop(Parent); + {Parent, stop} -> + ok; + {Parent, {exit, Reason}} -> + exit(Reason); + Other -> + io:format("~p:jeeves_loop received ~p~n", [?MODULE, Other]) end. @@ -913,10 +927,10 @@ start_jeeves({Name, Node}) Ref = make_ref(), Pid = spawn(Node, fun() -> jeeves(Parent, Name, Ref) end), receive - {Pid, Ref} -> - ok; - Other -> - test_server:fail({rec, Other}) + {Pid, Ref} -> + ok; + Other -> + ct:fail({rec, Other}) end, Pid; start_jeeves(Name) when is_atom(Name) -> @@ -930,20 +944,20 @@ tell_jeeves(Pid, What) when is_pid(Pid) -> ask_jeeves(Pid, Request) when is_pid(Pid) -> Pid ! {self(), Request}, receive - {Pid, Response} -> - Response; - Other -> - test_server:fail({rec, Other}) + {Pid, Response} -> + Response; + Other -> + ct:fail({rec, Other}) end. expect_jeeves(Pid, Request, Response) when is_pid(Pid) -> Pid ! {self(), Request}, receive - {Pid, Response} -> - ok; - Other -> - test_server:fail({rec, Other}) + {Pid, Response} -> + ok; + Other -> + ct:fail({rec, Other}) end. @@ -959,3 +973,22 @@ generate(_Fun, 0) -> []; generate(Fun, N) -> [Fun() | generate(Fun, N-1)]. + +start_node(Config, Args) -> + TestCase = proplists:get_value(testcase, Config), + PA = filename:dirname(code:which(?MODULE)), + ESTime = erlang:monotonic_time(1) + erlang:time_offset(1), + Unique = erlang:unique_integer([positive]), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(TestCase) + ++ "-" + ++ integer_to_list(ESTime) + ++ "-" + ++ integer_to_list(Unique)), + test_server:start_node(Name, + slave, + [{args, "-pa " ++ PA ++ " " ++ Args}]). + +stop_node(Node) -> + test_server:stop_node(Node). diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl index a492501959..843e917dfc 100644 --- a/erts/emulator/test/mtx_SUITE.erl +++ b/erts/emulator/test/mtx_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -28,9 +29,8 @@ -include_lib("common_test/include/ct.hrl"). --export([all/0,suite/0,groups/0, - init_per_group/2,end_per_group/2, init_per_suite/1, - end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). +-export([all/0,suite/0, init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). -export([long_rwlock/1, hammer_ets_rwlock/1, @@ -55,8 +55,30 @@ hammer_sched_freqread_tryrwlock/1, hammer_sched_freqread_tryrwlock_check/1]). +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 15}}]. + +all() -> + [long_rwlock, hammer_rwlock_check, hammer_rwlock, + hammer_tryrwlock_check, hammer_tryrwlock, + hammer_ets_rwlock, hammer_sched_long_rwlock_check, + hammer_sched_long_rwlock, + hammer_sched_long_freqread_rwlock_check, + hammer_sched_long_freqread_rwlock, + hammer_sched_long_tryrwlock_check, + hammer_sched_long_tryrwlock, + hammer_sched_long_freqread_tryrwlock_check, + hammer_sched_long_freqread_tryrwlock, + hammer_sched_rwlock_check, hammer_sched_rwlock, + hammer_sched_freqread_rwlock_check, + hammer_sched_freqread_rwlock, + hammer_sched_tryrwlock_check, hammer_sched_tryrwlock, + hammer_sched_freqread_tryrwlock_check, + hammer_sched_freqread_tryrwlock]. + init_per_suite(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Lib = filename:join([DataDir, atom_to_list(?MODULE)]), case {erlang:load_nif(Lib, none),erlang:system_info(threads)} of {{error,_},false} -> @@ -70,15 +92,13 @@ end_per_suite(Config) when is_list(Config) -> Config. init_per_testcase(_Case, Config) -> - Dog = ?t:timetrap(?t:minutes(15)), %% Wait for deallocations to complete since we measure %% runtime in test cases. wait_deallocations(), - [{watchdog, Dog}|Config]. + Config. -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). +end_per_testcase(_Func, _Config) -> + ok. wait_deallocations() -> try @@ -89,45 +109,15 @@ wait_deallocations() -> wait_deallocations() end. -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [long_rwlock, hammer_rwlock_check, hammer_rwlock, - hammer_tryrwlock_check, hammer_tryrwlock, - hammer_ets_rwlock, hammer_sched_long_rwlock_check, - hammer_sched_long_rwlock, - hammer_sched_long_freqread_rwlock_check, - hammer_sched_long_freqread_rwlock, - hammer_sched_long_tryrwlock_check, - hammer_sched_long_tryrwlock, - hammer_sched_long_freqread_tryrwlock_check, - hammer_sched_long_freqread_tryrwlock, - hammer_sched_rwlock_check, hammer_sched_rwlock, - hammer_sched_freqread_rwlock_check, - hammer_sched_freqread_rwlock, - hammer_sched_tryrwlock_check, hammer_sched_tryrwlock, - hammer_sched_freqread_tryrwlock_check, - hammer_sched_freqread_tryrwlock]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - long_rwlock(Config) when is_list(Config) -> statistics(runtime), LLRes = long_rw_test(), {_, RunTime} = statistics(runtime), %% A very short run time is expected, since %% threads in the test mostly wait - ?t:format("RunTime=~p~n", [RunTime]), - ?line true = RunTime < 400, - ?line RunTimeStr = "Run-time during test was "++integer_to_list(RunTime)++" ms.", + io:format("RunTime=~p~n", [RunTime]), + true = RunTime < 400, + RunTimeStr = "Run-time during test was "++integer_to_list(RunTime)++" ms.", case LLRes of ok -> {comment, RunTimeStr}; @@ -197,100 +187,100 @@ hammer_sched_long_freqread_tryrwlock_check(Config) when is_list(Config) -> hammer_sched_rwlock_test(FreqRead, LockCheck, Blocking, WaitLocked, WaitUnlocked) -> case create_rwlock(FreqRead, LockCheck) of - enotsup -> - {skipped, "Not supported."}; - RWLock -> - Onln = erlang:system_info(schedulers_online), - NWPs = case Onln div 3 of - 1 -> case Onln < 4 of - true -> 1; - false -> 2 - end; - X -> X - end, - NRPs = Onln - NWPs, - NoLockOps = ((((50000000 div Onln) - div case {Blocking, WaitLocked} of - {false, 0} -> 1; - _ -> 10 - end) - div (case WaitLocked == 0 of - true -> 1; - false -> WaitLocked*250 - end)) - div handicap()), - ?t:format("NoLockOps=~p~n", [NoLockOps]), - Sleep = case Blocking of - true -> NoLockOps; - false -> NoLockOps div 10 - end, - WPs = lists:map( - fun (Sched) -> - spawn_opt( - fun () -> - io:format("Writer on scheduler ~p.~n", - [Sched]), - Sched = erlang:system_info(scheduler_id), - receive go -> gone end, - hammer_sched_rwlock_proc(RWLock, - Blocking, - true, - WaitLocked, - WaitUnlocked, - NoLockOps, - Sleep), - Sched = erlang:system_info(scheduler_id) - end, - [link, {scheduler, Sched}]) - end, - lists:seq(1, NWPs)), - RPs = lists:map( - fun (Sched) -> - spawn_opt( - fun () -> - io:format("Reader on scheduler ~p.~n", - [Sched]), - Sched = erlang:system_info(scheduler_id), - receive go -> gone end, - hammer_sched_rwlock_proc(RWLock, - Blocking, - false, - WaitLocked, - WaitUnlocked, - NoLockOps, - Sleep), - Sched = erlang:system_info(scheduler_id) - end, - [link, {scheduler, Sched}]) - end, - lists:seq(NWPs + 1, NWPs + NRPs)), - Procs = WPs ++ RPs, - case {Blocking, WaitLocked} of - {_, 0} -> ok; - {false, _} -> ok; - _ -> statistics(runtime) - end, - lists:foreach(fun (P) -> P ! go end, Procs), - lists:foreach(fun (P) -> - M = erlang:monitor(process, P), - receive - {'DOWN', M, process, P, _} -> - ok - end - end, - Procs), - case {Blocking, WaitLocked} of - {_, 0} -> ok; - {false, _} -> ok; - _ -> - {_, RunTime} = statistics(runtime), - ?t:format("RunTime=~p~n", [RunTime]), - ?line true = RunTime < 700, - {comment, - "Run-time during test was " - ++ integer_to_list(RunTime) - ++ " ms."} - end + enotsup -> + {skipped, "Not supported."}; + RWLock -> + Onln = erlang:system_info(schedulers_online), + NWPs = case Onln div 3 of + 1 -> case Onln < 4 of + true -> 1; + false -> 2 + end; + X -> X + end, + NRPs = Onln - NWPs, + NoLockOps = ((((50000000 div Onln) + div case {Blocking, WaitLocked} of + {false, 0} -> 1; + _ -> 10 + end) + div (case WaitLocked == 0 of + true -> 1; + false -> WaitLocked*250 + end)) + div handicap()), + io:format("NoLockOps=~p~n", [NoLockOps]), + Sleep = case Blocking of + true -> NoLockOps; + false -> NoLockOps div 10 + end, + WPs = lists:map( + fun (Sched) -> + spawn_opt( + fun () -> + io:format("Writer on scheduler ~p.~n", + [Sched]), + Sched = erlang:system_info(scheduler_id), + receive go -> gone end, + hammer_sched_rwlock_proc(RWLock, + Blocking, + true, + WaitLocked, + WaitUnlocked, + NoLockOps, + Sleep), + Sched = erlang:system_info(scheduler_id) + end, + [link, {scheduler, Sched}]) + end, + lists:seq(1, NWPs)), + RPs = lists:map( + fun (Sched) -> + spawn_opt( + fun () -> + io:format("Reader on scheduler ~p.~n", + [Sched]), + Sched = erlang:system_info(scheduler_id), + receive go -> gone end, + hammer_sched_rwlock_proc(RWLock, + Blocking, + false, + WaitLocked, + WaitUnlocked, + NoLockOps, + Sleep), + Sched = erlang:system_info(scheduler_id) + end, + [link, {scheduler, Sched}]) + end, + lists:seq(NWPs + 1, NWPs + NRPs)), + Procs = WPs ++ RPs, + case {Blocking, WaitLocked} of + {_, 0} -> ok; + {false, _} -> ok; + _ -> statistics(runtime) + end, + lists:foreach(fun (P) -> P ! go end, Procs), + lists:foreach(fun (P) -> + M = erlang:monitor(process, P), + receive + {'DOWN', M, process, P, _} -> + ok + end + end, + Procs), + case {Blocking, WaitLocked} of + {_, 0} -> ok; + {false, _} -> ok; + _ -> + {_, RunTime} = statistics(runtime), + io:format("RunTime=~p~n", [RunTime]), + true = RunTime < 700, + {comment, + "Run-time during test was " + ++ integer_to_list(RunTime) + ++ " ms."} + end end. hammer_sched_rwlock_proc(_RWLock, @@ -342,9 +332,9 @@ hammer_ets_rwlock(Config) when is_list(Config) -> 3 -> {2000, 50}; _ -> {200, 50} end, - ?t:format("Procs=~p~nOps=~p~n", [Procs, Ops]), + io:format("Procs=~p~nOps=~p~n", [Procs, Ops]), lists:foreach(fun (XOpts) -> - ?t:format("Running with extra opts: ~p", [XOpts]), + io:format("Running with extra opts: ~p", [XOpts]), hammer_ets_rwlock_test(XOpts, true, 2, Ops, Procs, false) end, @@ -407,65 +397,65 @@ hammer_ets_rwlock_init(_T, _N) -> hammer_ets_rwlock_test(XOpts, UW, C, N, NP, SC) -> receive after 100 -> ok end, {TP, TM} = spawn_monitor( - fun () -> - _L = repeat_list( - fun () -> - Caller = self(), - T = fun () -> - Parent = self(), - hammer_ets_rwlock_put_data(), - T=ets:new(x, [public | XOpts]), - hammer_ets_rwlock_init(T, 0), - Ps0 = repeat_list( - fun () -> - spawn_link( - fun () -> - hammer_ets_rwlock_put_data(), - receive go -> ok end, - hammer_ets_rwlock_ops(T, UW, N, C, C, N), - Parent ! {done, self()}, - receive after infinity -> ok end - end) - end, - NP - case SC of - false -> 0; - _ -> 1 - end), - Ps = case SC of - false -> Ps0; - _ -> [spawn_link(fun () -> - hammer_ets_rwlock_put_data(), - receive go -> ok end, - hammer_ets_rwlock_ops(T, UW, N, SC, SC, N), - Parent ! {done, self()}, - receive after infinity -> ok end - end) | Ps0] - end, - Start = now(), - lists:foreach(fun (P) -> P ! go end, Ps), - lists:foreach(fun (P) -> receive {done, P} -> ok end end, Ps), - Stop = now(), - lists:foreach(fun (P) -> - unlink(P), - exit(P, bang), - M = erlang:monitor(process, P), - receive - {'DOWN', M, process, P, _} -> ok - end - end, Ps), - Res = timer:now_diff(Stop, Start)/1000000, - Caller ! {?MODULE, self(), Res} - end, - TP = spawn_link(T), - receive - {?MODULE, TP, Res} -> - Res - end - end, - ?HAMMER_ETS_RWLOCK_REPEAT_TIMES) - end), + fun () -> + _L = repeat_list( + fun () -> + Caller = self(), + T = fun () -> + Parent = self(), + hammer_ets_rwlock_put_data(), + T=ets:new(x, [public | XOpts]), + hammer_ets_rwlock_init(T, 0), + Ps0 = repeat_list( + fun () -> + spawn_link( + fun () -> + hammer_ets_rwlock_put_data(), + receive go -> ok end, + hammer_ets_rwlock_ops(T, UW, N, C, C, N), + Parent ! {done, self()}, + receive after infinity -> ok end + end) + end, + NP - case SC of + false -> 0; + _ -> 1 + end), + Ps = case SC of + false -> Ps0; + _ -> [spawn_link(fun () -> + hammer_ets_rwlock_put_data(), + receive go -> ok end, + hammer_ets_rwlock_ops(T, UW, N, SC, SC, N), + Parent ! {done, self()}, + receive after infinity -> ok end + end) | Ps0] + end, + Start = erlang:monotonic_time(), + lists:foreach(fun (P) -> P ! go end, Ps), + lists:foreach(fun (P) -> receive {done, P} -> ok end end, Ps), + Stop = erlang:monotonic_time(), + lists:foreach(fun (P) -> + unlink(P), + exit(P, bang), + M = erlang:monitor(process, P), + receive + {'DOWN', M, process, P, _} -> ok + end + end, Ps), + Res = (Stop-Start)/erlang:convert_time_unit(1,second,native), + Caller ! {?MODULE, self(), Res} + end, + TP = spawn_link(T), + receive + {?MODULE, TP, Res} -> + Res + end + end, + ?HAMMER_ETS_RWLOCK_REPEAT_TIMES) + end), receive - {'DOWN', TM, process, TP, _} -> ok + {'DOWN', TM, process, TP, _} -> ok end. repeat_list(Fun, N) -> @@ -479,18 +469,17 @@ repeat_list(Fun, N, Acc) -> handicap() -> X0 = case catch (erlang:system_info(logical_processors_available) >= - erlang:system_info(schedulers_online)) of - true -> 1; - _ -> 2 - end, + erlang:system_info(schedulers_online)) of + true -> 1; + _ -> 2 + end, case erlang:system_info(build_type) of - opt -> - X0; - ReallySlow when ReallySlow == debug; - ReallySlow == valgrind; - ReallySlow == purify -> - X0*3; - _Slow -> - X0*2 + opt -> + X0; + ReallySlow when ReallySlow == debug; + ReallySlow == valgrind; + ReallySlow == purify -> + X0*3; + _Slow -> + X0*2 end. - diff --git a/erts/emulator/test/mtx_SUITE_data/Makefile.src b/erts/emulator/test/mtx_SUITE_data/Makefile.src index 04412280c0..1816dc6798 100644 --- a/erts/emulator/test/mtx_SUITE_data/Makefile.src +++ b/erts/emulator/test/mtx_SUITE_data/Makefile.src @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2013. All Rights Reserved. +# Copyright Ericsson AB 2010-2016. 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. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # diff --git a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c index 7c8137dc83..46ee8b5540 100644 --- a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c +++ b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ @@ -23,7 +24,7 @@ * Author: Rickard Green */ -#include "erl_nif.h" +#include <erl_nif.h> #ifdef __WIN32__ # ifndef WIN32_LEAN_AND_MEAN diff --git a/erts/emulator/test/multi_load_SUITE.erl b/erts/emulator/test/multi_load_SUITE.erl new file mode 100644 index 0000000000..edf3205812 --- /dev/null +++ b/erts/emulator/test/multi_load_SUITE.erl @@ -0,0 +1,181 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(multi_load_SUITE). +-export([all/0, suite/0, many/1, on_load/1, errors/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [many,on_load,errors]. + +many(_Config) -> + Ms = make_modules(100, fun many_module/1), + + io:put_chars("Light load\n" + "=========="), + many_measure(Ms), + + _ = [spawn_link(fun many_worker/0) || _ <- lists:seq(1, 8)], + erlang:yield(), + io:put_chars("Heavy load\n" + "=========="), + many_measure(Ms), + ok. + +many_module(M) -> + ["-module("++M++").", + "-compile(export_all).", + "f1() -> ok.", + "f2() -> ok.", + "f3() -> ok.", + "f4() -> ok."]. + +many_measure(Ms) -> + many_purge(Ms), + MsPrep1 = prepare_modules(Ms), + Us1 = ms(fun() -> many_load_seq(MsPrep1) end), + many_try_call(Ms), + many_purge(Ms), + MsPrep2 = prepare_modules(Ms), + Us2 = ms(fun() -> many_load_par(MsPrep2) end), + many_try_call(Ms), + io:format("# modules: ~9w\n" + "Sequential: ~9w µs\n" + "Parallel: ~9w µs\n" + "Ratio: ~9w\n", + [length(Ms),Us1,Us2,divide(Us1,Us2)]), + ok. + +divide(A,B) when B > 0 -> A div B; +divide(_,_) -> inf. + +many_load_seq(Ms) -> + [erlang:finish_loading([M]) || M <- Ms], + ok. + +many_load_par(Ms) -> + erlang:finish_loading(Ms). + +many_purge(Ms) -> + _ = [catch erlang:purge_module(M) || {M,_} <- Ms], + ok. + +many_try_call(Ms) -> + _ = [begin + ok = M:f1(), + ok = M:f2(), + ok = M:f3(), + ok = M:f4() + end || {M,_} <- Ms], + ok. + +many_worker() -> + many_worker(lists:seq(1, 100)). + +many_worker(L) -> + N0 = length(L), + N1 = N0 * N0 * N0, + N2 = N1 div (N0 * N0), + N3 = N2 + 10, + _ = N3 - 10, + many_worker(L). + + +on_load(_Config) -> + On = make_modules(2, fun on_load_module/1), + OnPrep = prepare_modules(On), + {'EXIT',{system_limit,_}} = (catch erlang:finish_loading(OnPrep)), + + Normal = make_modules(1, fun on_load_normal/1), + Mixed = Normal ++ tl(On), + MixedPrep = prepare_modules(Mixed), + {'EXIT',{system_limit,_}} = (catch erlang:finish_loading(MixedPrep)), + + [false,true] = [erlang:has_prepared_code_on_load(Code) || + Code <- MixedPrep], + {'EXIT',{badarg,_}} = (catch erlang:has_prepared_code_on_load(<<1,2,3>>)), + Magic = ets:match_spec_compile([{'_',[true],['$_']}]), + {'EXIT',{badarg,_}} = (catch erlang:has_prepared_code_on_load(Magic)), + + SingleOnPrep = tl(OnPrep), + {on_load,[OnLoadMod]} = erlang:finish_loading(SingleOnPrep), + ok = erlang:call_on_load_function(OnLoadMod), + ok. + +on_load_module(M) -> + ["-module("++M++").", + "-on_load(f/0).", + "f() -> ok."]. + +on_load_normal(M) -> + ["-module("++M++")."]. + + +errors(_Config) -> + finish_loading_badarg(x), + finish_loading_badarg([x|y]), + finish_loading_badarg([x]), + finish_loading_badarg([<<>>]), + + Mods = make_modules(2, fun errors_module/1), + Ms = lists:sort([M || {M,_} <- Mods]), + Prep = prepare_modules(Mods), + {duplicated,Dups} = erlang:finish_loading(Prep ++ Prep), + Ms = lists:sort(Dups), + ok. + +finish_loading_badarg(Arg) -> + {'EXIT',{badarg,[{erlang,finish_loading,[Arg],_}|_]}} = + (catch erlang:finish_loading(Arg)). + +errors_module(M) -> + ["-module("++M++").", + "-export([f/0]).", + "f() -> ok."]. + +%%% +%%% Common utilities +%%% + +ms(Fun) -> + {Ms,ok} = timer:tc(Fun), + Ms. + +make_modules(0, _) -> + []; +make_modules(N, Fun) -> + U = erlang:unique_integer([positive]), + M0 = "m__" ++ integer_to_list(N) ++ "_" ++ integer_to_list(U), + Contents = Fun(M0), + Forms = [make_form(S) || S <- Contents], + {ok,M,Code} = compile:forms(Forms), + [{M,Code}|make_modules(N-1, Fun)]. + +make_form(S) -> + {ok,Toks,_} = erl_scan:string(S), + {ok,Form} = erl_parse:parse_form(Toks), + Form. + +prepare_modules(Ms) -> + [erlang:prepare_loading(M, Code) || {M,Code} <- Ms]. diff --git a/erts/emulator/test/nested_SUITE.erl b/erts/emulator/test/nested_SUITE.erl index 2cd67ebaae..f1b4c03ae4 100644 --- a/erts/emulator/test/nested_SUITE.erl +++ b/erts/emulator/test/nested_SUITE.erl @@ -1,108 +1,93 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(nested_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]). +-export([all/0, suite/0, + case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [case_in_case, case_in_after, catch_in_catch, bif_in_bif]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - case_in_case(suite) -> []; case_in_case(Config) when is_list(Config) -> - ?line done = search_any([a], [{a, 1}]), - ?line done = search_any([x], [{a, 1}]), + done = search_any([a], [{a, 1}]), + done = search_any([x], [{a, 1}]), ok. search_any([Key|Rest], List) -> - ?line case case lists:keysearch(Key, 1, List) of - {value, _} -> - true; - _ -> - false - end of - true -> - ok; - false -> - error; - Other -> - test_server:fail({other_result, Other}) - end, - ?line search_any(Rest, List); + case case lists:keysearch(Key, 1, List) of + {value, _} -> + true; + _ -> + false + end of + true -> + ok; + false -> + error; + Other -> + ct:fail({other_result, Other}) + end, + search_any(Rest, List); search_any([], _) -> done. case_in_after(suite) -> []; case_in_after(Config) when is_list(Config) -> receive - after case {x, y, z} of - {x, y, z} -> 0 - end -> - ok - end, + after case {x, y, z} of + {x, y, z} -> 0 + end -> + ok + end, ok. -catch_in_catch(doc) -> "Test a catch within a catch in the same function."; -catch_in_catch(suite) -> []; +%% Test a catch within a catch in the same function. catch_in_catch(Config) when is_list(Config) -> - ?line {outer, inner_exit} = catcher(), + {outer, inner_exit} = catcher(), ok. catcher() -> case (catch - case (catch ?MODULE:non_existing()) of % bogus function - {'EXIT', _} -> - inner_exit; - Res1 -> - {inner, Res1} - end) of - {'EXIT', _} -> - outer_exit; - Res2 -> - {outer, Res2} + case (catch ?MODULE:non_existing()) of % bogus function + {'EXIT', _} -> + inner_exit; + Res1 -> + {inner, Res1} + end) of + {'EXIT', _} -> + outer_exit; + Res2 -> + {outer, Res2} end. -bif_in_bif(doc) -> "Test a BIF call within a BIF call."; -bif_in_bif(suite) -> []; +%% Test a BIF call within a BIF call. bif_in_bif(Config) when is_list(Config) -> Self = self(), put(pid, Self), diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index b2da6f58af..bec2291867 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -20,226 +21,919 @@ -module(nif_SUITE). %%-define(line_trace,true). --define(CHECK(Exp,Got), check(Exp,Got,?LINE)). -%%-define(CHECK(Exp,Got), ?line Exp = Got). - --include_lib("test_server/include/test_server.hrl"). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1, +-define(CHECK(Exp,Got), Exp = check(Exp,Got,?LINE)). +%%-define(CHECK(Exp,Got), Exp = Got). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("stdlib/include/assert.hrl"). + +-export([all/0, suite/0, groups/0, + init_per_group/2, end_per_group/2, + init_per_testcase/2, end_per_testcase/2, + basic/1, reload_error/1, upgrade/1, heap_frag/1, + t_on_load/1, + select/1, select_steal/1, + monitor_process_a/1, + monitor_process_b/1, + monitor_process_c/1, + monitor_process_d/1, + demonitor_process/1, + monitor_frenzy/1, + hipe/1, types/1, many_args/1, binaries/1, get_string/1, get_atom/1, maps/1, api_macros/1, - from_array/1, iolist_as_binary/1, resource/1, resource_binary/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, + 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, reverse_list_test/1, - otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1 + otp_9828/1, + otp_9668/1, consume_timeslice/1, nif_schedule/1, + nif_exception/1, call_nif_exception/1, + nif_nan_and_inf/1, nif_atom_too_long/1, + nif_monotonic_time/1, nif_time_offset/1, nif_convert_time_unit/1, + nif_now_time/1, nif_cpu_time/1, nif_unique_integer/1, + nif_is_process_alive/1, nif_is_port_alive/1, + nif_term_to_binary/1, nif_binary_to_term/1, + nif_port_command/1, + nif_snprintf/1, + nif_internal_hash/1, + nif_internal_hash_salted/1, + nif_phash2/1, + nif_whereis/1, nif_whereis_parallel/1, + nif_whereis_threaded/1, nif_whereis_proxy/1, + nif_ioq/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, suite/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)). +-define(is_resource, is_reference). + suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> - [basic, reload, upgrade, heap_frag, types, many_args, +all() -> + [basic] + ++ + [{group, G} || G <- api_groups()] + ++ + [reload_error, heap_frag, types, many_args, + select, select_steal, + {group, monitor}, + monitor_frenzy, + hipe, binaries, get_string, get_atom, maps, api_macros, from_array, iolist_as_binary, resource, resource_binary, - resource_takeover, threading, send, send2, send3, + threading, send, send2, send3, send_threaded, neg, is_checks, get_length, make_atom, make_string,reverse_list_test, - otp_9668, consume_timeslice, dirty_nif, dirty_nif_send - ]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - + otp_9828, + otp_9668, consume_timeslice, + nif_schedule, nif_exception, nif_nan_and_inf, nif_atom_too_long, + nif_monotonic_time, nif_time_offset, nif_convert_time_unit, + nif_now_time, nif_cpu_time, nif_unique_integer, + nif_is_process_alive, nif_is_port_alive, + nif_term_to_binary, nif_binary_to_term, + nif_port_command, + nif_snprintf, + nif_internal_hash, + nif_internal_hash_salted, + nif_phash2, + nif_whereis, nif_whereis_parallel, nif_whereis_threaded, + nif_ioq]. + +groups() -> + [{G, [], api_repeaters()} || G <- api_groups()] + ++ + [{monitor, [], [monitor_process_a, + monitor_process_b, + monitor_process_c, + monitor_process_d, + demonitor_process]}]. + + +api_groups() -> [api_latest, api_2_4, api_2_0]. + +api_repeaters() -> [upgrade, resource_takeover, t_on_load]. + +init_per_group(api_2_4, Config) -> + [{nif_api_version, ".2_4"} | Config]; +init_per_group(api_2_0, Config) -> + case {os:type(),erlang:system_info({wordsize, internal})} of + {{win32,_}, 8} -> + %% ERL_NIF_TERM was declared as 32-bit 'long' until 2.3 + {skip, "API 2.0 buggy on Windows 64-bit"}; + _ -> + [{nif_api_version, ".2_0"} | Config] + end; +init_per_group(_, Config) -> Config. + +end_per_group(_,_) -> ok. + +init_per_testcase(t_on_load, Config) -> + ets:new(nif_SUITE, [named_table]), + Config; +init_per_testcase(hipe, Config) -> + case erlang:system_info(hipe_architecture) of + undefined -> {skip, "HiPE is disabled"}; + _ -> Config + end; +init_per_testcase(nif_whereis_threaded, Config) -> + case erlang:system_info(threads) of + true -> Config; + false -> {skip, "No thread support"} + end; +init_per_testcase(Select, Config) when Select =:= select; + Select =:= select_steal -> + case os:type() of + {win32,_} -> + {skip, "Test not yet implemented for windows"}; + _ -> + Config + end; init_per_testcase(_Case, Config) -> -% ?line Dog = ?t:timetrap(?t:seconds(60*60*24)), + %% Clear any resource dtor data before test starts in case another tc + %% left it in a bad state + catch last_resource_dtor_call(), Config. +end_per_testcase(t_on_load, _Config) -> + ets:delete(nif_SUITE), + testcase_cleanup(); end_per_testcase(_Func, _Config) -> - %%Dog = ?config(watchdog, Config), - %%?t:timetrap_cancel(Dog), + testcase_cleanup(). + +testcase_cleanup() -> P1 = code:purge(nif_mod), Del = code:delete(nif_mod), P2 = code:purge(nif_mod), io:format("fin purged=~p, deleted=~p and then purged=~p\n",[P1,Del,P2]). -basic(doc) -> ["Basic smoke test of load_nif and a simple NIF call"]; -basic(suite) -> []; +%% Basic smoke test of load_nif and a simple NIF call basic(Config) when is_list(Config) -> ensure_lib_loaded(Config), - ?line true = (lib_version() =/= undefined), - ?line [{load,1,1,101},{lib_version,1,2,102}] = call_history(), - ?line [] = call_history(), - ?line true = lists:member(?MODULE, erlang:system_info(taints)), + true = (lib_version() =/= undefined), + [{load,1,1,101},{lib_version,1,2,102}] = call_history(), + [] = call_history(), + true = lists:member(?MODULE, erlang:system_info(taints)), ok. -reload(doc) -> ["Test reload callback in nif lib"]; -reload(suite) -> []; -reload(Config) when is_list(Config) -> +%% Test old reload feature now always fails +reload_error(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "nif_mod"), - ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "nif_mod"), + {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), + {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line ok = nif_mod:load_nif_lib(Config, 1), + ok = nif_mod:load_nif_lib(Config, 1), - ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), - ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), - ?line ok = nif_mod:load_nif_lib(Config, 2), - ?line 2 = nif_mod:lib_version(), - ?line [{reload,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(), + {error, {reload, _}} = nif_mod:load_nif_lib(Config, 2), + 1 = nif_mod:lib_version(), + [{lib_version,1,3,103}] = nif_mod_call_history(), - ?line ok = nif_mod:load_nif_lib(Config, 1), - ?line 1 = nif_mod:lib_version(), - ?line [{reload,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(), + {error, {reload, _}} = nif_mod:load_nif_lib(Config, 1), + 1 = nif_mod:lib_version(), + [{lib_version,1,4,104}] = nif_mod_call_history(), - ?line true = erlang:delete_module(nif_mod), - ?line [] = nif_mod_call_history(), + true = erlang:delete_module(nif_mod), + [] = nif_mod_call_history(), - %%?line false= check_process_code(Pid, nif_mod), - ?line true = erlang:purge_module(nif_mod), - ?line [{unload,1,3,103}] = nif_mod_call_history(), + %%false= check_process_code(Pid, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,1,5,105}] = nif_mod_call_history(), - ?line true = lists:member(?MODULE, erlang:system_info(taints)), - ?line true = lists:member(nif_mod, erlang:system_info(taints)), - ?line verify_tmpmem(TmpMem), + true = lists:member(?MODULE, erlang:system_info(taints)), + true = lists:member(nif_mod, erlang:system_info(taints)), + verify_tmpmem(TmpMem), ok. -upgrade(doc) -> ["Test upgrade callback in nif lib"]; -upgrade(suite) -> []; -upgrade(Config) when is_list(Config) -> +%% Test upgrade callback in nif lib +upgrade(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "nif_mod"), - ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "nif_mod"), + {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), + {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line ok = nif_mod:load_nif_lib(Config, 1), - ?line {Pid,MRef} = nif_mod:start(), - ?line 1 = call(Pid,lib_version), + ok = nif_mod:load_nif_lib(Config, 1), + {Pid,MRef} = nif_mod:start(), + 1 = call(Pid,lib_version), - ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), - ?line [{load,1,1,101},{lib_version,1,2,102},{get_priv_data_ptr,1,3,103}] = nif_mod_call_history(), + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + [{load,1,1,101},{lib_version,1,2,102},{get_priv_data_ptr,1,3,103}] = nif_mod_call_history(), %% Module upgrade with same lib-version - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line undefined = nif_mod:lib_version(), - ?line 1 = call(Pid,lib_version), - ?line [{lib_version,1,4,104}] = nif_mod_call_history(), + {module,nif_mod} = erlang:load_module(nif_mod,Bin), + undefined = nif_mod:lib_version(), + 1 = call(Pid,lib_version), + [{lib_version,1,4,104}] = nif_mod_call_history(), + + ok = nif_mod:load_nif_lib(Config, 1), + 1 = nif_mod:lib_version(), + [{upgrade,1,5,105},{lib_version,1,6,106}] = nif_mod_call_history(), + + upgraded = call(Pid,upgrade), + false = check_process_code(Pid, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,1,7,107}] = nif_mod_call_history(), + + 1 = nif_mod:lib_version(), + [{lib_version,1,8,108}] = nif_mod_call_history(), + + true = erlang:delete_module(nif_mod), + [] = nif_mod_call_history(), + + %% Repeat upgrade again but from old (deleted) instance + {module,nif_mod} = erlang:load_module(nif_mod,Bin), + undefined = nif_mod:lib_version(), + 1 = call(Pid,lib_version), + [{lib_version,1,9,109}] = nif_mod_call_history(), + + ok = nif_mod:load_nif_lib(Config, 1), + 1 = nif_mod:lib_version(), + [{upgrade,1,10,110},{lib_version,1,11,111}] = nif_mod_call_history(), + + upgraded = call(Pid,upgrade), + false = check_process_code(Pid, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,1,12,112}] = nif_mod_call_history(), + + 1 = nif_mod:lib_version(), + [{lib_version,1,13,113}] = nif_mod_call_history(), + + true = erlang:delete_module(nif_mod), + [] = nif_mod_call_history(), + + + Pid ! die, + {'DOWN', MRef, process, Pid, normal} = receive_any(), + false = check_process_code(Pid, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,1,14,114}] = nif_mod_call_history(), + + %% Module upgrade with different lib version + {module,nif_mod} = erlang:load_module(nif_mod,Bin), + undefined = nif_mod:lib_version(), + {Pid2,MRef2} = nif_mod:start(), + undefined = call(Pid2,lib_version), + + ok = nif_mod:load_nif_lib(Config, 1), + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + 1 = call(Pid2,lib_version), + [{load,1,1,101},{get_priv_data_ptr,1,2,102},{lib_version,1,3,103}] = nif_mod_call_history(), + + {module,nif_mod} = erlang:load_module(nif_mod,Bin), + undefined = nif_mod:lib_version(), + [] = nif_mod_call_history(), + 1 = call(Pid2,lib_version), + [{lib_version,1,4,104}] = nif_mod_call_history(), + + ok = nif_mod:load_nif_lib(Config, 2), + 2 = nif_mod:lib_version(), + [{upgrade,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(), + + 1 = call(Pid2,lib_version), + [{lib_version,1,5,105}] = nif_mod_call_history(), + + upgraded = call(Pid2,upgrade), + false = check_process_code(Pid2, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,1,6,106}] = nif_mod_call_history(), + + 2 = nif_mod:lib_version(), + [{lib_version,2,3,203}] = nif_mod_call_history(), + + true = erlang:delete_module(nif_mod), + [] = nif_mod_call_history(), + + + %% Reverse upgrade but from old (deleted) instance + {module,nif_mod} = erlang:load_module(nif_mod,Bin), + undefined = nif_mod:lib_version(), + [] = nif_mod_call_history(), + 2 = call(Pid2,lib_version), + [{lib_version,2,4,204}] = nif_mod_call_history(), + + ok = nif_mod:load_nif_lib(Config, 1), + 1 = nif_mod:lib_version(), + [{upgrade,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(), + + 2 = call(Pid2,lib_version), + [{lib_version,2,5,205}] = nif_mod_call_history(), + + upgraded = call(Pid2,upgrade), + false = check_process_code(Pid2, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,2,6,206}] = nif_mod_call_history(), + + 1 = nif_mod:lib_version(), + [{lib_version,1,3,103}] = nif_mod_call_history(), + + true = erlang:delete_module(nif_mod), + [] = nif_mod_call_history(), + + + Pid2 ! die, + {'DOWN', MRef2, process, Pid2, normal} = receive_any(), + false= check_process_code(Pid2, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,1,4,104}] = nif_mod_call_history(), + + true = lists:member(?MODULE, erlang:system_info(taints)), + true = lists:member(nif_mod, erlang:system_info(taints)), + verify_tmpmem(TmpMem), + ok. + +%% Test loading/upgrade in on_load +t_on_load(Config) when is_list(Config) -> + TmpMem = tmpmem(), + ensure_lib_loaded(Config), + + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "nif_mod"), + {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors, + {d,'USE_ON_LOAD'}]), + + %% Use ETS to tell nif_mod:on_load what to do + ets:insert(nif_SUITE, {data_dir, Data}), + ets:insert(nif_SUITE, {lib_version, 1}), + API = proplists:get_value(nif_api_version, Config, ""), + ets:insert(nif_SUITE, {nif_api_version, API}), + {module,nif_mod} = code:load_binary(nif_mod,File,Bin), + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + + {Pid,MRef} = nif_mod:start(), + 1 = call(Pid,lib_version), + [{lib_version,1,3,103}] = nif_mod_call_history(), + + %% Module upgrade with same lib-version + {module,nif_mod} = code:load_binary(nif_mod,File,Bin), + 1 = nif_mod:lib_version(), + 1 = call(Pid,lib_version), + [{upgrade,1,4,104},{lib_version,1,5,105},{lib_version,1,6,106}] = nif_mod_call_history(), - ?line ok = nif_mod:load_nif_lib(Config, 1), - ?line 1 = nif_mod:lib_version(), - ?line [{upgrade,1,5,105},{lib_version,1,6,106}] = nif_mod_call_history(), + upgraded = call(Pid,upgrade), + false = check_process_code(Pid, nif_mod), + true = code:soft_purge(nif_mod), + [{unload,1,7,107}] = nif_mod_call_history(), - ?line upgraded = call(Pid,upgrade), - ?line false = check_process_code(Pid, nif_mod), - ?line true = erlang:purge_module(nif_mod), - ?line [{unload,1,7,107}] = nif_mod_call_history(), + 1 = nif_mod:lib_version(), + [{lib_version,1,8,108}] = nif_mod_call_history(), - ?line 1 = nif_mod:lib_version(), - ?line [{lib_version,1,8,108}] = nif_mod_call_history(), + true = code:delete(nif_mod), + [] = nif_mod_call_history(), + + %% Repeat upgrade again but from old (deleted) instance + {module,nif_mod} = code:load_binary(nif_mod,File,Bin), + [{upgrade,1,9,109}] = nif_mod_call_history(), + 1 = nif_mod:lib_version(), + 1 = call(Pid,lib_version), + [{lib_version,1,10,110},{lib_version,1,11,111}] = nif_mod_call_history(), + + upgraded = call(Pid,upgrade), + false = check_process_code(Pid, nif_mod), + true = code:soft_purge(nif_mod), + [{unload,1,12,112}] = nif_mod_call_history(), - ?line true = erlang:delete_module(nif_mod), - ?line [] = nif_mod_call_history(), + 1 = nif_mod:lib_version(), + [{lib_version,1,13,113}] = nif_mod_call_history(), + + true = code:delete(nif_mod), + [] = nif_mod_call_history(), - ?line Pid ! die, - ?line {'DOWN', MRef, process, Pid, normal} = receive_any(), - ?line false = check_process_code(Pid, nif_mod), - ?line true = erlang:purge_module(nif_mod), - ?line [{unload,1,9,109}] = nif_mod_call_history(), + + Pid ! die, + {'DOWN', MRef, process, Pid, normal} = receive_any(), + false = check_process_code(Pid, nif_mod), + true = code:soft_purge(nif_mod), + [{unload,1,14,114}] = nif_mod_call_history(), %% Module upgrade with different lib version - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line undefined = nif_mod:lib_version(), - ?line {Pid2,MRef2} = nif_mod:start(), - ?line undefined = call(Pid2,lib_version), - - ?line ok = nif_mod:load_nif_lib(Config, 1), - ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), - ?line 1 = call(Pid2,lib_version), - ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102},{lib_version,1,3,103}] = nif_mod_call_history(), - - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line undefined = nif_mod:lib_version(), - ?line [] = nif_mod_call_history(), - ?line 1 = call(Pid2,lib_version), - ?line [{lib_version,1,4,104}] = nif_mod_call_history(), - - ?line ok = nif_mod:load_nif_lib(Config, 2), - ?line 2 = nif_mod:lib_version(), - ?line [{upgrade,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(), - - ?line 1 = call(Pid2,lib_version), - ?line [{lib_version,1,5,105}] = nif_mod_call_history(), - - ?line upgraded = call(Pid2,upgrade), - ?line false = check_process_code(Pid2, nif_mod), - ?line true = erlang:purge_module(nif_mod), - ?line [{unload,1,6,106}] = nif_mod_call_history(), - - ?line 2 = nif_mod:lib_version(), - ?line [{lib_version,2,3,203}] = nif_mod_call_history(), - - ?line true = erlang:delete_module(nif_mod), - ?line [] = nif_mod_call_history(), - - ?line Pid2 ! die, - ?line {'DOWN', MRef2, process, Pid2, normal} = receive_any(), - ?line false= check_process_code(Pid2, nif_mod), - ?line true = erlang:purge_module(nif_mod), - ?line [{unload,2,4,204}] = nif_mod_call_history(), - - ?line true = lists:member(?MODULE, erlang:system_info(taints)), - ?line true = lists:member(nif_mod, erlang:system_info(taints)), - ?line verify_tmpmem(TmpMem), + {module,nif_mod} = code:load_binary(nif_mod,File,Bin), + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + + 1 = nif_mod:lib_version(), + {Pid2,MRef2} = nif_mod:start(), + 1 = call(Pid2,lib_version), + [{lib_version,1,3,103},{lib_version,1,4,104}] = nif_mod_call_history(), + + true = ets:insert(nif_SUITE,{lib_version,2}), + {module,nif_mod} = code:load_binary(nif_mod,File,Bin), + [{upgrade,2,1,201}] = nif_mod_call_history(), + + 2 = nif_mod:lib_version(), + 1 = call(Pid2,lib_version), + [{lib_version,2,2,202},{lib_version,1,5,105}] = nif_mod_call_history(), + + upgraded = call(Pid2,upgrade), + false = check_process_code(Pid2, nif_mod), + true = code:soft_purge(nif_mod), + [{unload,1,6,106}] = nif_mod_call_history(), + + 2 = nif_mod:lib_version(), + 2 = call(Pid2,lib_version), + [{lib_version,2,3,203},{lib_version,2,4,204}] = nif_mod_call_history(), + + true = code:delete(nif_mod), + [] = nif_mod_call_history(), + + %% Reverse upgrade but from old (deleted) instance + ets:insert(nif_SUITE,{lib_version,1}), + {module,nif_mod} = code:load_binary(nif_mod,File,Bin), + [{upgrade,1,1,101}] = nif_mod_call_history(), + + 1 = nif_mod:lib_version(), + 2 = call(Pid2,lib_version), + [{lib_version,1,2,102},{lib_version,2,5,205}] = nif_mod_call_history(), + + upgraded = call(Pid2,upgrade), + false = check_process_code(Pid2, nif_mod), + true = code:soft_purge(nif_mod), + [{unload,2,6,206}] = nif_mod_call_history(), + + 1 = nif_mod:lib_version(), + [{lib_version,1,3,103}] = nif_mod_call_history(), + + true = code:delete(nif_mod), + [] = nif_mod_call_history(), + + + Pid2 ! die, + {'DOWN', MRef2, process, Pid2, normal} = receive_any(), + false= check_process_code(Pid2, nif_mod), + true = code:soft_purge(nif_mod), + [{unload,1,4,104}] = nif_mod_call_history(), + + true = lists:member(?MODULE, erlang:system_info(taints)), + true = lists:member(nif_mod, erlang:system_info(taints)), + verify_tmpmem(TmpMem), ok. -heap_frag(doc) -> ["Test NIF building heap fragments"]; -heap_frag(suite) -> []; +-define(ERL_NIF_SELECT_READ, (1 bsl 0)). +-define(ERL_NIF_SELECT_WRITE, (1 bsl 1)). +-define(ERL_NIF_SELECT_STOP, (1 bsl 2)). + +-define(ERL_NIF_SELECT_STOP_CALLED, (1 bsl 0)). +-define(ERL_NIF_SELECT_STOP_SCHEDULED, (1 bsl 1)). +-define(ERL_NIF_SELECT_INVALID_EVENT, (1 bsl 2)). +-define(ERL_NIF_SELECT_FAILED, (1 bsl 3)). + + +select(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + Ref = make_ref(), + Ref2 = make_ref(), + {{R, R_ptr}, {W, W_ptr}} = pipe_nif(), + ok = write_nif(W, <<"hej">>), + <<"hej">> = read_nif(R, 3), + + %% Wait for read + eagain = read_nif(R, 3), + 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref), + [] = flush(0), + ok = write_nif(W, <<"hej">>), + [{select, R, Ref, ready_input}] = flush(), + 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref2), + [{select, R, Ref2, ready_input}] = flush(), + Papa = self(), + Pid = spawn_link(fun() -> + [{select, R, Ref, ready_input}] = flush(), + Papa ! {self(), done} + end), + 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,Pid,Ref), + {Pid, done} = receive_any(1000), + <<"hej">> = read_nif(R, 3), + + %% Wait for write + Written = write_full(W, $a), + 0 = select_nif(W,?ERL_NIF_SELECT_WRITE,W,self(),Ref), + [] = flush(0), + Written = read_nif(R,byte_size(Written)), + [{select, W, Ref, ready_output}] = flush(), + + %% Close write and wait for EOF + eagain = read_nif(R, 1), + check_stop_ret(select_nif(W,?ERL_NIF_SELECT_STOP,W,null,Ref)), + [{fd_resource_stop, W_ptr, _}] = flush(), + {1, {W_ptr,_}} = last_fd_stop_call(), + true = is_closed_nif(W), + [] = flush(0), + 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref), + [{select, R, Ref, ready_input}] = flush(), + eof = read_nif(R,1), + + check_stop_ret(select_nif(R,?ERL_NIF_SELECT_STOP,R,null,Ref)), + [{fd_resource_stop, R_ptr, _}] = flush(), + {1, {R_ptr,_}} = last_fd_stop_call(), + true = is_closed_nif(R), + + select_2(Config). + +select_2(Config) -> + erlang:garbage_collect(), + {_,_,2} = last_resource_dtor_call(), + + Ref1 = make_ref(), + Ref2 = make_ref(), + {{R, R_ptr}, {W, W_ptr}} = pipe_nif(), + + %% Change ref + eagain = read_nif(R, 1), + 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1), + 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref2), + + [] = flush(0), + ok = write_nif(W, <<"hej">>), + [{select, R, Ref2, ready_input}] = flush(), + <<"hej">> = read_nif(R, 3), + + %% Change pid + eagain = read_nif(R, 1), + 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1), + Papa = self(), + spawn_link(fun() -> + 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1), + [] = flush(0), + Papa ! sync, + [{select, R, Ref1, ready_input}] = flush(), + <<"hej">> = read_nif(R, 3), + Papa ! done + end), + sync = receive_any(), + ok = write_nif(W, <<"hej">>), + done = receive_any(), + [] = flush(0), + + check_stop_ret(select_nif(R,?ERL_NIF_SELECT_STOP,R,null,Ref1)), + [{fd_resource_stop, R_ptr, _}] = flush(), + {1, {R_ptr,_}} = last_fd_stop_call(), + true = is_closed_nif(R), + + %% Stop without previous read/write select + ?ERL_NIF_SELECT_STOP_CALLED = select_nif(W,?ERL_NIF_SELECT_STOP,W,null,Ref1), + [{fd_resource_stop, W_ptr, 1}] = flush(), + {1, {W_ptr,1}} = last_fd_stop_call(), + true = is_closed_nif(W), + + select_3(Config). + +select_3(_Config) -> + erlang:garbage_collect(), + {_,_,2} = last_resource_dtor_call(), + ok. + +%% @doc The stealing child process for the select_steal test. Duplicates given +%% W/RFds and runs select on them to steal +select_steal_child_process(Parent, RFd) -> + %% Duplicate the resource with the same FD + {R2Fd, _R2Ptr} = dupe_resource_nif(RFd), + Ref2 = make_ref(), + + %% Try to select from the child pid (steal from parent) + ?assertEqual(0, select_nif(R2Fd, ?ERL_NIF_SELECT_READ, R2Fd, null, Ref2)), + ?assertEqual([], flush(0)), + ?assertEqual(eagain, read_nif(R2Fd, 1)), + + %% Check that now events arrive to this temporary process + Parent ! {self(), stage1}, % signal parent to send the <<"stolen1">> + + %% Receive <<"stolen1">> via enif_select + ?assertEqual(0, select_nif(R2Fd, ?ERL_NIF_SELECT_READ, R2Fd, null, Ref2)), + ?assertMatch([{select, R2Fd, Ref2, ready_input}], flush()), + ?assertEqual(<<"stolen1">>, read_nif(R2Fd, 7)), + + clear_select_nif(R2Fd), + + % do not do this here - stop_selecting(R2Fd, R2Rsrc, Ref2), + Parent ! {self(), done}. + +%% @doc Similar to select/1 test, make a double ended pipe. Then try to steal +%% the socket, see what happens. +select_steal(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + Ref = make_ref(), + {{RFd, RPtr}, {WFd, WPtr}} = pipe_nif(), + + %% Bind the socket to current pid in enif_select + ?assertEqual(0, select_nif(RFd, ?ERL_NIF_SELECT_READ, RFd, null, Ref)), + ?assertEqual([], flush(0)), + + %% Spawn a process and do some stealing + Parent = self(), + Pid = spawn_link(fun() -> select_steal_child_process(Parent, RFd) end), + + %% Signal from the child to send the first message + {Pid, stage1} = receive_any(), + ?assertEqual(ok, write_nif(WFd, <<"stolen1">>)), + + ?assertMatch([{Pid, done}], flush(1)), % synchronize with the child + + %% Try to select from the parent pid (steal back) + ?assertEqual(0, select_nif(RFd, ?ERL_NIF_SELECT_READ, RFd, Pid, Ref)), + + %% Ensure that no data is hanging and close. + %% Rfd is stolen at this point. + check_stop_ret(select_nif(WFd, ?ERL_NIF_SELECT_STOP, WFd, null, Ref)), + ?assertMatch([{fd_resource_stop, WPtr, _}], flush()), + {1, {WPtr, 1}} = last_fd_stop_call(), + + check_stop_ret(select_nif(RFd, ?ERL_NIF_SELECT_STOP, RFd, null, Ref)), + ?assertMatch([{fd_resource_stop, RPtr, _}], flush()), + {1, {RPtr, 1}} = last_fd_stop_call(), + + ?assert(is_closed_nif(WFd)), + + ok. + +check_stop_ret(?ERL_NIF_SELECT_STOP_CALLED) -> ok; +check_stop_ret(?ERL_NIF_SELECT_STOP_SCHEDULED) -> ok. + +write_full(W, C) -> + write_full(W, C, <<>>). +write_full(W, C, Acc) -> + case write_nif(W, <<C>>) of + ok -> + write_full(W, (C+1) band 255, <<Acc/binary, C>>); + {eagain,0} -> + Acc + end. + +%% Basic monitoring of one process that terminates +monitor_process_a(Config) -> + ensure_lib_loaded(Config), + + F = fun(Terminator, UseMsgEnv) -> + Pid = spawn(fun() -> + receive + {exit, Arg} -> exit(Arg); + return -> ok; + BadMatch -> goodmatch = BadMatch + end + end), + R_ptr = alloc_monitor_resource_nif(), + {0, Mon1} = monitor_process_nif(R_ptr, Pid, UseMsgEnv, self()), + [R_ptr] = monitored_by(Pid), + Terminator(Pid), + [{monitor_resource_down, R_ptr, Pid, Mon2}] = flush(), + 0 = compare_monitors_nif(Mon1, Mon2), + [] = last_resource_dtor_call(), + ok = release_resource(R_ptr), + {R_ptr, _, 1} = last_resource_dtor_call() + end, + + T1 = fun(Pid) -> Pid ! {exit, 17} end, + T2 = fun(Pid) -> Pid ! return end, + T3 = fun(Pid) -> Pid ! badmatch end, + T4 = fun(Pid) -> exit(Pid, 18) end, + + [F(T, UME) || T <- [T1,T2,T3,T4], UME <- [true, false]], + + ok. + +%% Test auto-demonitoring at resource destruction +monitor_process_b(Config) -> + ensure_lib_loaded(Config), + + monitor_process_b_do(false), + case erlang:system_info(threads) of + true -> monitor_process_b_do(true); + false -> ok + end, + ok. + + +monitor_process_b_do(FromThread) -> + Pid = spawn_link(fun() -> + receive + return -> ok + end + end), + R_ptr = alloc_monitor_resource_nif(), + {0,_} = monitor_process_nif(R_ptr, Pid, true, self()), + [R_ptr] = monitored_by(Pid), + case FromThread of + false -> ok = release_resource(R_ptr); + true -> ok = release_resource_from_thread(R_ptr) + end, + [] = flush(0), + {R_ptr, _, 1} = last_resource_dtor_call(), + [] = monitored_by(Pid), + Pid ! return, + ok. + +%% Test termination of monitored process holding last resource ref +monitor_process_c(Config) -> + ensure_lib_loaded(Config), + + Papa = self(), + Pid = spawn_link(fun() -> + R_ptr = alloc_monitor_resource_nif(), + {0,Mon} = monitor_process_nif(R_ptr, self(), true, Papa), + [R_ptr] = monitored_by(self()), + put(store, make_resource(R_ptr)), + ok = release_resource(R_ptr), + [] = last_resource_dtor_call(), + Papa ! {self(), done, R_ptr, Mon}, + exit + end), + [{Pid, done, R_ptr, Mon1}, + {monitor_resource_down, R_ptr, Pid, Mon2}] = flush(2), + compare_monitors_nif(Mon1, Mon2), + {R_ptr, _, 1} = last_resource_dtor_call(), + ok. + +%% Test race of resource dtor called when monitored process is exiting +monitor_process_d(Config) -> + ensure_lib_loaded(Config), + + Papa = self(), + {Target,TRef} = spawn_monitor(fun() -> + nothing = receive_any() + end), + + R_ptr = alloc_monitor_resource_nif(), + {0,_} = monitor_process_nif(R_ptr, Target, true, self()), + [Papa, R_ptr] = monitored_by(Target), + + exit(Target, die), + ok = release_resource(R_ptr), + + [{'DOWN', TRef, process, Target, die}] = flush(), %% no monitor_resource_down + {R_ptr, _, 1} = last_resource_dtor_call(), + + ok. + +%% Test basic demonitoring +demonitor_process(Config) -> + ensure_lib_loaded(Config), + + Pid = spawn_link(fun() -> + receive + return -> ok + end + end), + R_ptr = alloc_monitor_resource_nif(), + {0,MonBin1} = monitor_process_nif(R_ptr, Pid, true, self()), + [R_ptr] = monitored_by(Pid), + {0,MonBin2} = monitor_process_nif(R_ptr, Pid, true, self()), + [R_ptr, R_ptr] = monitored_by(Pid), + 0 = demonitor_process_nif(R_ptr, MonBin1), + [R_ptr] = monitored_by(Pid), + 1 = demonitor_process_nif(R_ptr, MonBin1), + 0 = demonitor_process_nif(R_ptr, MonBin2), + [] = monitored_by(Pid), + 1 = demonitor_process_nif(R_ptr, MonBin2), + + ok = release_resource(R_ptr), + [] = flush(0), + {R_ptr, _, 1} = last_resource_dtor_call(), + [] = monitored_by(Pid), + Pid ! return, + ok. + + +monitored_by(Pid) -> + {monitored_by, List0} = process_info(Pid, monitored_by), + List1 = lists:map(fun(E) when ?is_resource(E) -> + {Ptr, _} = get_resource(monitor_resource_type, E), + Ptr; + (E) -> E + end, + List0), + erlang:garbage_collect(), + lists:sort(List1). + +-define(FRENZY_RAND_BITS, 25). + +%% Exercise monitoring from NIF resources by randomly +%% create/destruct processes, resources and monitors. +monitor_frenzy(Config) -> + ensure_lib_loaded(Config), + + Procs1 = processes(), + io:format("~p processes before: ~p\n", [length(Procs1), Procs1]), + + %% Spawn first worker process + Master = self(), + spawn_link(fun() -> + SelfPix = monitor_frenzy_nif(init, ?FRENZY_RAND_BITS, 0, 0), + unlink(Master), + frenzy(SelfPix, {undefined, []}) + end), + receive after 5*1000 -> ok end, + + io:format("stats = ~p\n", [monitor_frenzy_nif(stats, 0, 0, 0)]), + + Pids = monitor_frenzy_nif(stop, 0, 0, 0), + io:format("stats = ~p\n", [monitor_frenzy_nif(stats, 0, 0, 0)]), + + lists:foreach(fun(P) -> + MRef = monitor(process, P), + exit(P, stop), + {'DOWN', MRef, process, P, _} = receive_any() + end, + Pids), + + io:format("stats = ~p\n", [monitor_frenzy_nif(stats, 0, 0, 0)]), + + Procs2 = processes(), + io:format("~p processes after: ~p\n", [length(Procs2), Procs2]), + ok. + + +frenzy(_SelfPix, done) -> + ok; +frenzy(SelfPix, State0) -> + Rnd = rand:uniform(1 bsl (?FRENZY_RAND_BITS+2)) - 1, + Op = Rnd band 3, + State1 = frenzy_do_op(SelfPix, Op, (Rnd bsr 2), State0), + frenzy(SelfPix, State1). + +frenzy_do_op(SelfPix, Op, Rnd, {Pid0,RBins}=State0) -> + case Op of + 0 -> % add/remove process + Papa = self(), + NewPid = case Pid0 of + undefined -> % Prepare new process to be added + spawn(fun() -> + MRef = monitor(process, Papa), + case receive_any() of + {go, MyPix, MyState} -> + demonitor(MRef, [flush]), + frenzy(MyPix, MyState); + {'DOWN', MRef, process, Papa, _} -> + ok + end + end); + _ -> + Pid0 + end, + case monitor_frenzy_nif(Op, Rnd, SelfPix, NewPid) of + NewPix when is_integer(NewPix) -> + NewPid ! {go, NewPix, {undefined, []}}, + {undefined, RBins}; + ExitPid when is_pid(ExitPid) -> + false = (ExitPid =:= self()), + exit(ExitPid,die), + {NewPid, RBins}; + done -> + done + end; + + 3 -> + %% Try provoke revival-race of resource from magic ref external format + _ = [binary_to_term(B) || B <- RBins], + {Pid0, []}; + _ -> + case monitor_frenzy_nif(Op, Rnd, SelfPix, undefined) of + Rsrc when ?is_resource(Rsrc) -> + %% Store resource in ext format only, for later revival + State1 = {Pid0, [term_to_binary(Rsrc) | RBins]}, + gc_and_return(State1); + ok -> State0; + 0 -> State0; + 1 -> State0; + done -> done + end + end. + +gc_and_return(RetVal) -> + erlang:garbage_collect(), + RetVal. + +hipe(Config) when is_list(Config) -> + Data = proplists:get_value(data_dir, Config), + Priv = proplists:get_value(priv_dir, Config), + Src = filename:join(Data, "hipe_compiled"), + {ok,hipe_compiled} = c:c(Src, [{outdir,Priv},native]), + true = code:is_module_native(hipe_compiled), + {error, {notsup,_}} = hipe_compiled:try_load_nif(), + true = code:delete(hipe_compiled), + false = code:purge(hipe_compiled), + ok. + + +%% Test NIF building heap fragments heap_frag(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), heap_frag_do(1,1000000), - ?line verify_tmpmem(TmpMem), + verify_tmpmem(TmpMem), ok. heap_frag_do(N, Max) when N > Max -> @@ -250,12 +944,11 @@ heap_frag_do(N, Max) -> L = list_seq(N), heap_frag_do(((N*5) div 4) + 1, Max). -types(doc) -> ["Type tests"]; -types(suite) -> []; +%% Type tests types(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), - ?line ok = type_test(), + ok = type_test(), lists:foreach(fun(Tpl) -> Lst = erlang:tuple_to_list(Tpl), Lst = tuple_2_list(Tpl) @@ -280,18 +973,18 @@ types(Config) when is_list(Config) -> R1 = echo_int(I), %%io:format("echo_int(~p) -> ~p\n", [I, R1]), R2 = my_echo_int(I, Limits), - ?line R1 = R2, - ?line true = (R1 =:= R2), - ?line true = (R1 == R2) + R1 = R2, + true = (R1 =:= R2), + true = (R1 == R2) end, int_list()), - ?line verify_tmpmem(TmpMem), - ?line true = (compare(-1294536544000, -1178704800000) < 0), - ?line true = (compare(-1178704800000, -1294536544000) > 0), - ?line true = (compare(-295147905179352825856, -36893488147419103232) < 0), - ?line true = (compare(-36893488147419103232, -295147905179352825856) > 0), - ?line true = (compare(-29514790517935282585612345678, -36893488147419103232) < 0), - ?line true = (compare(-36893488147419103232, -29514790517935282585612345678) > 0), + verify_tmpmem(TmpMem), + true = (compare(-1294536544000, -1178704800000) < 0), + true = (compare(-1178704800000, -1294536544000) > 0), + true = (compare(-295147905179352825856, -36893488147419103232) < 0), + true = (compare(-36893488147419103232, -295147905179352825856) > 0), + true = (compare(-29514790517935282585612345678, -36893488147419103232) < 0), + true = (compare(-36893488147419103232, -29514790517935282585612345678) > 0), ok. int_list() -> @@ -319,15 +1012,15 @@ eq_cmp(A,B) -> eq_cmp_do({A,B},{A,B}). eq_cmp_do(A,B) -> - %%?t:format("compare ~p and ~p\n",[A,B]), + %%io:format("compare ~p and ~p\n",[A,B]), Eq = (A =:= B), - ?line Eq = is_identical(A,B), - ?line Cmp = if + Eq = is_identical(A,B), + Cmp = if A < B -> -1; A == B -> 0; A > B -> 1 end, - ?line Cmp = case compare(A,B) of + Cmp = case compare(A,B) of C when is_integer(C), C < 0 -> -1; 0 -> 0; C when is_integer(C) -> 1 @@ -335,47 +1028,45 @@ eq_cmp_do(A,B) -> ok. -many_args(doc) -> ["Test NIF with many arguments"]; -many_args(suite) -> []; +%% Test NIF with many arguments many_args(Config) when is_list(Config) -> TmpMem = tmpmem(), - ?line ensure_lib_loaded(Config ,1), - ?line ok = apply(?MODULE,many_args_100,lists:seq(1,100)), - ?line ok = many_args_100(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100), - ?line verify_tmpmem(TmpMem), + ensure_lib_loaded(Config ,1), + ok = apply(?MODULE,many_args_100,lists:seq(1,100)), + ok = many_args_100(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100), + verify_tmpmem(TmpMem), ok. -binaries(doc) -> ["Test NIF binary handling."]; -binaries(suite) -> []; +%% Test NIF binary handling. binaries(Config) when is_list(Config) -> TmpMem = tmpmem(), - ?line ensure_lib_loaded(Config, 1), - ?line RefcBin = list_to_binary(lists:seq(1,255)), - ?line RefcBin = clone_bin(RefcBin), - ?line HeapBin = list_to_binary(lists:seq(1,20)), - ?line HeapBin = clone_bin(HeapBin), - ?line <<_:8,Sub1:6/binary,_/binary>> = RefcBin, - ?line <<_:8,Sub2:6/binary,_/binary>> = HeapBin, - ?line Sub1 = Sub2, - ?line Sub1 = clone_bin(Sub1), - ?line Sub2 = clone_bin(Sub2), - ?line <<_:9,Sub3:6/binary,_/bitstring>> = RefcBin, - ?line <<_:9,Sub4:6/binary,_/bitstring>> = HeapBin, - ?line Sub3 = Sub4, - ?line Sub3 = clone_bin(Sub3), - ?line Sub4 = clone_bin(Sub4), + ensure_lib_loaded(Config, 1), + RefcBin = list_to_binary(lists:seq(1,255)), + RefcBin = clone_bin(RefcBin), + HeapBin = list_to_binary(lists:seq(1,20)), + HeapBin = clone_bin(HeapBin), + <<_:8,Sub1:6/binary,_/binary>> = RefcBin, + <<_:8,Sub2:6/binary,_/binary>> = HeapBin, + Sub1 = Sub2, + Sub1 = clone_bin(Sub1), + Sub2 = clone_bin(Sub2), + <<_:9,Sub3:6/binary,_/bitstring>> = RefcBin, + <<_:9,Sub4:6/binary,_/bitstring>> = HeapBin, + Sub3 = Sub4, + Sub3 = clone_bin(Sub3), + Sub4 = clone_bin(Sub4), %% When NIFs get bitstring support - %%?line <<_:8,Sub5:27/bitstring,_/bitstring>> = RefcBin, - %%?line <<_:8,Sub6:27/bitstring,_/bitstring>> = HeapBin, - %%?line Sub5 = Sub6, - %%?line Sub5 = clone_bin(Sub5), - %%?line Sub6 = clone_bin(Sub6), - %%?line <<_:9,Sub7:27/bitstring,_/bitstring>> = RefcBin, - %%?line <<_:9,Sub8:27/bitstring,_/bitstring>> = HeapBin, - %%?line Sub7 = Sub8, - %%?line Sub7 = clone_bin(Sub7), - %%?line Sub8 = clone_bin(Sub8), - %%?line <<>> = clone_bin(<<>>), + %%<<_:8,Sub5:27/bitstring,_/bitstring>> = RefcBin, + %%<<_:8,Sub6:27/bitstring,_/bitstring>> = HeapBin, + %%Sub5 = Sub6, + %%Sub5 = clone_bin(Sub5), + %%Sub6 = clone_bin(Sub6), + %%<<_:9,Sub7:27/bitstring,_/bitstring>> = RefcBin, + %%<<_:9,Sub8:27/bitstring,_/bitstring>> = HeapBin, + %%Sub7 = Sub8, + %%Sub7 = clone_bin(Sub7), + %%Sub8 = clone_bin(Sub8), + %%<<>> = clone_bin(<<>>), <<_:8,SubBinA:200/binary,_/binary>> = RefcBin, <<_:9,SubBinB:200/binary,_/bitstring>> = RefcBin, @@ -388,56 +1079,53 @@ binaries(Config) when is_list(Config) -> test_make_sub_bin(SubBinC), test_make_sub_bin(SubBinD), - ?line verify_tmpmem(TmpMem), + verify_tmpmem(TmpMem), ok. test_make_sub_bin(Bin) -> Size = byte_size(Bin), Rest10 = Size - 10, Rest1 = Size - 1, - ?line Bin = make_sub_bin(Bin, 0, Size), + Bin = make_sub_bin(Bin, 0, Size), <<_:10/binary,Sub0:Rest10/binary>> = Bin, - ?line Sub0 = make_sub_bin(Bin, 10, Rest10), + Sub0 = make_sub_bin(Bin, 10, Rest10), <<Sub1:10/binary,_/binary>> = Bin, - ?line Sub1 = make_sub_bin(Bin, 0, 10), + Sub1 = make_sub_bin(Bin, 0, 10), <<_:7/binary,Sub2:10/binary,_/binary>> = Bin, - ?line Sub2 = make_sub_bin(Bin, 7, 10), - ?line <<>> = make_sub_bin(Bin, 0, 0), - ?line <<>> = make_sub_bin(Bin, 10, 0), - ?line <<>> = make_sub_bin(Bin, Rest1, 0), - ?line <<>> = make_sub_bin(Bin, Size, 0), + Sub2 = make_sub_bin(Bin, 7, 10), + <<>> = make_sub_bin(Bin, 0, 0), + <<>> = make_sub_bin(Bin, 10, 0), + <<>> = make_sub_bin(Bin, Rest1, 0), + <<>> = make_sub_bin(Bin, Size, 0), ok. -get_string(doc) -> ["Test enif_get_string"]; -get_string(suite) -> []; +%% Test enif_get_string get_string(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line {7, <<"hejsan",0,_:3/binary>>} = string_to_bin("hejsan",10), - ?line {7, <<"hejsan",0,_>>} = string_to_bin("hejsan",8), - ?line {7, <<"hejsan",0>>} = string_to_bin("hejsan",7), - ?line {-6, <<"hejsa",0>>} = string_to_bin("hejsan",6), - ?line {-5, <<"hejs",0>>} = string_to_bin("hejsan",5), - ?line {-1, <<0>>} = string_to_bin("hejsan",1), - ?line {0, <<>>} = string_to_bin("hejsan",0), - ?line {1, <<0>>} = string_to_bin("",1), - ?line {0, <<>>} = string_to_bin("",0), + ensure_lib_loaded(Config, 1), + {7, <<"hejsan",0,_:3/binary>>} = string_to_bin("hejsan",10), + {7, <<"hejsan",0,_>>} = string_to_bin("hejsan",8), + {7, <<"hejsan",0>>} = string_to_bin("hejsan",7), + {-6, <<"hejsa",0>>} = string_to_bin("hejsan",6), + {-5, <<"hejs",0>>} = string_to_bin("hejsan",5), + {-1, <<0>>} = string_to_bin("hejsan",1), + {0, <<>>} = string_to_bin("hejsan",0), + {1, <<0>>} = string_to_bin("",1), + {0, <<>>} = string_to_bin("",0), ok. -get_atom(doc) -> ["Test enif_get_atom"]; -get_atom(suite) -> []; +%% Test enif_get_atom get_atom(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line {7, <<"hejsan",0,_:3/binary>>} = atom_to_bin(hejsan,10), - ?line {7, <<"hejsan",0,_>>} = atom_to_bin(hejsan,8), - ?line {7, <<"hejsan",0>>} = atom_to_bin(hejsan,7), - ?line {0, <<_:6/binary>>} = atom_to_bin(hejsan,6), - ?line {0, <<>>} = atom_to_bin(hejsan,0), - ?line {1, <<0>>} = atom_to_bin('',1), - ?line {0, <<>>} = atom_to_bin('',0), + ensure_lib_loaded(Config, 1), + {7, <<"hejsan",0,_:3/binary>>} = atom_to_bin(hejsan,10), + {7, <<"hejsan",0,_>>} = atom_to_bin(hejsan,8), + {7, <<"hejsan",0>>} = atom_to_bin(hejsan,7), + {0, <<_:6/binary>>} = atom_to_bin(hejsan,6), + {0, <<>>} = atom_to_bin(hejsan,0), + {1, <<0>>} = atom_to_bin('',1), + {0, <<>>} = atom_to_bin('',0), ok. -maps(doc) -> ["Test NIF maps handling."]; -maps(suite) -> []; +%% Test NIF maps handling. maps(Config) when is_list(Config) -> TmpMem = tmpmem(), Pairs = [{adam, "bert"}] ++ @@ -447,7 +1135,7 @@ maps(Config) when is_list(Config) -> M = maps_from_list_nif(Pairs), R = {RIs,Is} = sorted_list_from_maps_nif(M), io:format("Pairs: ~p~nMap: ~p~nReturned: ~p~n", [lists:sort(Pairs),M,R]), - Is = lists:sort(Pairs), + true = (lists:sort(Is) =:= lists:sort(Pairs)), Is = lists:reverse(RIs), #{} = maps_from_list_nif([]), @@ -482,33 +1170,31 @@ maps(Config) when is_list(Config) -> {1, M2} = make_map_remove_nif(M2, "key3"), {0, undefined} = make_map_remove_nif(self(), key), + verify_tmpmem(TmpMem), ok. -api_macros(doc) -> ["Test macros enif_make_list<N> and enif_make_tuple<N>"]; -api_macros(suite) -> []; +%% Test macros enif_make_list<N> and enif_make_tuple<N> api_macros(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), + ensure_lib_loaded(Config, 1), Expected = {[lists:seq(1,N) || N <- lists:seq(1,9)], [list_to_tuple(lists:seq(1,N)) || N <- lists:seq(1,9)] }, - ?line Expected = macros(list_to_tuple(lists:seq(1,9))), + Expected = macros(list_to_tuple(lists:seq(1,9))), ok. -from_array(doc) -> ["enif_make_[tuple|list]_from_array"]; -from_array(suite) -> []; +%% enif_make_[tuple|list]_from_array from_array(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), + ensure_lib_loaded(Config, 1), lists:foreach(fun(Tpl) -> Lst = tuple_to_list(Tpl), - ?line {Lst,Tpl} = tuple_2_list_and_tuple(Tpl) + {Lst,Tpl} = tuple_2_list_and_tuple(Tpl) end, [{}, {1,2,3}, {[4,5],[],{},{6,7}}, {{}}, {[]}]), ok. -iolist_as_binary(doc) -> ["enif_inspect_iolist_as_binary"]; -iolist_as_binary(suite) -> []; +%% enif_inspect_iolist_as_binary iolist_as_binary(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), + ensure_lib_loaded(Config, 1), TmpMem = tmpmem(), List = [<<"hejsan">>, <<>>, [], [17], [<<>>], [127,128,255,0], @@ -517,18 +1203,17 @@ iolist_as_binary(Config) when is_list(Config) -> lists:foreach(fun(IoL) -> B1 = erlang:iolist_to_binary(IoL), - ?line B2 = iolist_2_bin(IoL), - ?line B1 = B2 + B2 = iolist_2_bin(IoL), + B1 = B2 end, List), - ?line verify_tmpmem(TmpMem), + verify_tmpmem(TmpMem), ok. -resource(doc) -> ["Test memory managed objects, aka 'resources'"]; -resource(suite) -> []; +%% Test memory managed objects, aka 'resources' resource(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line Type = get_resource_type(0), + ensure_lib_loaded(Config, 1), + Type = get_resource_type(0), resource_hugo(Type), resource_otto(Type), resource_new(Type), @@ -538,76 +1223,76 @@ resource(Config) when is_list(Config) -> resource_hugo(Type) -> DtorCall = resource_hugo_do(Type), erlang:garbage_collect(), - ?line DtorCall = last_resource_dtor_call(), + DtorCall = last_resource_dtor_call(), ok. resource_hugo_do(Type) -> HugoBin = <<"Hugo Hacker">>, - ?line HugoPtr = alloc_resource(Type, HugoBin), - ?line Hugo = make_resource(HugoPtr), - ?line <<>> = Hugo, + HugoPtr = alloc_resource(Type, HugoBin), + Hugo = make_resource(HugoPtr), + true = is_reference(Hugo), release_resource(HugoPtr), erlang:garbage_collect(), - ?line {HugoPtr,HugoBin} = get_resource(Type,Hugo), + {HugoPtr,HugoBin} = get_resource(Type,Hugo), Pid = spawn_link(fun() -> - receive {Pid, Type, Resource, Ptr, Bin} -> - Pid ! {self(), got_it}, - receive {Pid, check_it} -> - ?line {Ptr,Bin} = get_resource(Type,Resource), - Pid ! {self(), ok} - end - end - end), + receive {Pid, Type, Resource, Ptr, Bin} -> + Pid ! {self(), got_it}, + receive {Pid, check_it} -> + {Ptr,Bin} = get_resource(Type,Resource), + Pid ! {self(), ok} + end + end + end), Pid ! {self(), Type, Hugo, HugoPtr, HugoBin}, - ?line {Pid, got_it} = receive_any(), + {Pid, got_it} = receive_any(), erlang:garbage_collect(), % just to make our ProcBin move in memory Pid ! {self(), check_it}, - ?line {Pid, ok} = receive_any(), - ?line [] = last_resource_dtor_call(), - ?line {HugoPtr,HugoBin} = get_resource(Type,Hugo), + {Pid, ok} = receive_any(), + [] = last_resource_dtor_call(), + {HugoPtr,HugoBin} = get_resource(Type,Hugo), {HugoPtr, HugoBin, 1}. resource_otto(Type) -> {OttoPtr, OttoBin} = resource_otto_do(Type), erlang:garbage_collect(), - ?line [] = last_resource_dtor_call(), + [] = last_resource_dtor_call(), release_resource(OttoPtr), - ?line {OttoPtr,OttoBin,1} = last_resource_dtor_call(), + {OttoPtr,OttoBin,1} = last_resource_dtor_call(), ok. resource_otto_do(Type) -> OttoBin = <<"Otto Ordonnans">>, - ?line OttoPtr = alloc_resource(Type, OttoBin), - ?line Otto = make_resource(OttoPtr), - ?line <<>> = Otto, + OttoPtr = alloc_resource(Type, OttoBin), + Otto = make_resource(OttoPtr), + true = is_reference(Otto), %% forget resource term but keep referenced by NIF {OttoPtr, OttoBin}. resource_new(Type) -> - ?line {PtrB,BinB} = resource_new_do1(Type), + {PtrB,BinB} = resource_new_do1(Type), erlang:garbage_collect(), - ?line {PtrB,BinB,1} = last_resource_dtor_call(), + {PtrB,BinB,1} = last_resource_dtor_call(), ok. resource_new_do1(Type) -> - ?line {{PtrA,BinA}, {ResB,PtrB,BinB}} = resource_new_do2(Type), + {{PtrA,BinA}, {ResB,PtrB,BinB}} = resource_new_do2(Type), erlang:garbage_collect(), - ?line {PtrA,BinA,1} = last_resource_dtor_call(), - ?line {PtrB,BinB} = get_resource(Type, ResB), + {PtrA,BinA,1} = last_resource_dtor_call(), + {PtrB,BinB} = get_resource(Type, ResB), %% forget ResB and make it garbage {PtrB,BinB}. resource_new_do2(Type) -> BinA = <<"NewA">>, BinB = <<"NewB">>, - ?line ResA = make_new_resource(Type, BinA), - ?line ResB = make_new_resource(Type, BinB), - ?line <<>> = ResA, - ?line <<>> = ResB, - ?line {PtrA,BinA} = get_resource(Type, ResA), - ?line {PtrB,BinB} = get_resource(Type, ResB), - ?line true = (PtrA =/= PtrB), - ?line [] = last_resource_dtor_call(), + ResA = make_new_resource(Type, BinA), + ResB = make_new_resource(Type, BinB), + true = is_reference(ResA), + true = is_reference(ResB), + true = (ResA /= ResB), + {PtrA,BinA} = get_resource(Type, ResA), + {PtrB,BinB} = get_resource(Type, ResB), + true = (PtrA =/= PtrB), %% forget ResA and make it garbage {{PtrA,BinA}, {ResB,PtrB,BinB}}. @@ -616,22 +1301,21 @@ resource_neg(TypeA) -> catch exit(42), % dummy exception to purge saved stacktraces from earlier exception erlang:garbage_collect(), - ?line {_,_,2} = last_resource_dtor_call(), + {_,_,2} = last_resource_dtor_call(), ok. resource_neg_do(TypeA) -> TypeB = get_resource_type(1), 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)), + {'EXIT',{badarg,_}} = (catch get_resource(TypeA, ResB)), + {'EXIT',{badarg,_}} = (catch get_resource(TypeB, ResA)), ok. -resource_binary(doc) -> ["Test enif_make_resource_binary"]; -resource_binary(suite) -> []; +%% Test enif_make_resource_binary resource_binary(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line {Ptr,Bin} = resource_binary_do(), + ensure_lib_loaded(Config, 1), + {Ptr,Bin} = resource_binary_do(), erlang:garbage_collect(), Last = last_resource_dtor_call(), ?CHECK({Ptr,Bin,1}, Last), @@ -639,58 +1323,57 @@ resource_binary(Config) when is_list(Config) -> 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), + {Ptr,ResBin1} = make_new_resource_binary(Bin), + ResBin1 = Bin, + 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), + ResBin2 = ResBin1, + ResInfo = get_resource(binary_resource_type,ResBin2), Forwarder ! terminate, - ?line {Forwarder, 1} = receive_any(), + {Forwarder, 1} = receive_any(), erlang:garbage_collect(), - ?line ResInfo = get_resource(binary_resource_type,ResBin1), - ?line ResInfo = get_resource(binary_resource_type,ResBin2), + ResInfo = get_resource(binary_resource_type,ResBin1), + ResInfo = get_resource(binary_resource_type,ResBin2), ResInfo. -define(RT_CREATE,1). -define(RT_TAKEOVER,2). -resource_takeover(doc) -> ["Test resource takeover by module reload and upgrade"]; -resource_takeover(suite) -> []; +%% Test resource takeover by module upgrade resource_takeover(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "nif_mod"), - ?line {ok,nif_mod,ModBin} = compile:file(File, [binary,return_errors]), - ?line {module,nif_mod} = erlang:load_module(nif_mod,ModBin), - - ?line ok = nif_mod:load_nif_lib(Config, 1, - [{resource_type, 0, ?RT_CREATE, "resource_type_A",resource_dtor_A, - ?RT_CREATE}, - {resource_type, 1, ?RT_CREATE, "resource_type_null_A",null, - ?RT_CREATE}, - {resource_type, 2, ?RT_CREATE bor ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A, - ?RT_CREATE}, - {resource_type, 3, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B, - ?RT_CREATE}, - {resource_type, 4, ?RT_CREATE, "resource_type_null_goneX",null, - ?RT_CREATE}, - {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A, - ?RT_TAKEOVER} - ]), - - ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), - ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "nif_mod"), + {ok,nif_mod,ModBin} = compile:file(File, [binary,return_errors]), + {module,nif_mod} = erlang:load_module(nif_mod,ModBin), - ?line {Holder, _MRef} = spawn_opt(fun resource_holder/0, [link, monitor]), + ok = nif_mod:load_nif_lib(Config, 1, + [{resource_type, 0, ?RT_CREATE, "resource_type_A",resource_dtor_A, + ?RT_CREATE}, + {resource_type, 1, ?RT_CREATE, "resource_type_null_A",null, + ?RT_CREATE}, + {resource_type, 2, ?RT_CREATE bor ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A, + ?RT_CREATE}, + {resource_type, 3, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B, + ?RT_CREATE}, + {resource_type, 4, ?RT_CREATE, "resource_type_null_goneX",null, + ?RT_CREATE}, + {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A, + ?RT_TAKEOVER} + ]), + + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + + {Holder, _MRef} = spawn_opt(fun resource_holder/0, [link, monitor]), {A1,BinA1} = make_resource(0,Holder,"A1"), {A2,BinA2} = make_resource(0,Holder,"A2"), @@ -710,91 +1393,94 @@ resource_takeover(Config) when is_list(Config) -> {NGX1,_BinNGX1} = make_resource(4,Holder,"NGX1"), {NGX2,_BinNGX2} = make_resource(4,Holder,"NGX2"), - ?line [] = nif_mod_call_history(), + [] = nif_mod_call_history(), - ?line ok = forget_resource(A1), - ?line [{{resource_dtor_A_v1,BinA1},1,3,103}] = nif_mod_call_history(), + ok = forget_resource(A1), + [{{resource_dtor_A_v1,BinA1},1,3,103}] = nif_mod_call_history(), - ?line ok = forget_resource(NA1), - ?line [] = nif_mod_call_history(), % no dtor + ok = forget_resource(NA1), + [] = nif_mod_call_history(), % no dtor - ?line ok = forget_resource(AN1), + ok = forget_resource(AN1), ?CHECK([{{resource_dtor_A_v1,BinAN1},1,4,104}] , nif_mod_call_history()), - ?line ok = forget_resource(BGX1), + ok = forget_resource(BGX1), ?CHECK([{{resource_dtor_B_v1,BinBGX1},1,5,105}], nif_mod_call_history()), - ?line ok = forget_resource(NGX1), + ok = forget_resource(NGX1), ?CHECK([], nif_mod_call_history()), % no dtor - ?line ok = nif_mod:load_nif_lib(Config, 2, - [{resource_type, 0, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A, - ?RT_TAKEOVER}, - {resource_type, 1, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",resource_dtor_A, - ?RT_TAKEOVER}, - {resource_type, 2, ?RT_TAKEOVER, "resource_type_A_null",null, - ?RT_TAKEOVER}, - {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A, - ?RT_TAKEOVER}, - {resource_type, null, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B, - ?RT_CREATE}, - {resource_type, null, ?RT_CREATE, "resource_type_null_goneX",null, - ?RT_CREATE}, - {resource_type, 3, ?RT_CREATE, "resource_type_B_goneY",resource_dtor_B, - ?RT_CREATE}, - {resource_type, 4, ?RT_CREATE, "resource_type_null_goneY",null, - ?RT_CREATE} - ]), - ?CHECK([{reload,2,1,201}], nif_mod_call_history()), - - ?line BinA2 = read_resource(0,A2), - ?line ok = forget_resource(A2), + {module,nif_mod} = erlang:load_module(nif_mod,ModBin), + ok = nif_mod:load_nif_lib(Config, 2, + [{resource_type, 0, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, 1, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, 2, ?RT_TAKEOVER, "resource_type_A_null",null, + ?RT_TAKEOVER}, + {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, null, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B, + ?RT_CREATE}, + {resource_type, null, ?RT_CREATE, "resource_type_null_goneX",null, + ?RT_CREATE}, + {resource_type, 3, ?RT_CREATE, "resource_type_B_goneY",resource_dtor_B, + ?RT_CREATE}, + {resource_type, 4, ?RT_CREATE, "resource_type_null_goneY",null, + ?RT_CREATE} + ]), + ?CHECK([{upgrade,2,1,201}], nif_mod_call_history()), + true = erlang:purge_module(nif_mod), + ?CHECK([], nif_mod_call_history()), % BGX2 keeping lib loaded + + BinA2 = read_resource(0,A2), + ok = forget_resource(A2), ?CHECK([{{resource_dtor_A_v2,BinA2},2,2,202}], nif_mod_call_history()), - ?line ok = forget_resource(NA2), + ok = forget_resource(NA2), ?CHECK([{{resource_dtor_A_v2,BinNA2},2,3,203}], nif_mod_call_history()), - ?line ok = forget_resource(AN2), + ok = forget_resource(AN2), ?CHECK([], nif_mod_call_history()), % no dtor - ?line ok = forget_resource(BGX2), % calling dtor in orphan library v1 still loaded - ?CHECK([{{resource_dtor_B_v1,BinBGX2},1,6,106}], nif_mod_call_history()), - % How to test that lib v1 is closed here? + ok = forget_resource(BGX2), % calling dtor in orphan library v1 still loaded + ?CHECK([{{resource_dtor_B_v1,BinBGX2},1,6,106}, {unload,1,7,107}], + nif_mod_call_history()), - ?line ok = forget_resource(NGX2), + ok = forget_resource(NGX2), ?CHECK([], nif_mod_call_history()), % no dtor {BGY1,BinBGY1} = make_resource(3,Holder,"BGY1"), {NGY1,_BinNGY1} = make_resource(4,Holder,"NGY1"), %% Module upgrade with same lib-version - ?line {module,nif_mod} = erlang:load_module(nif_mod,ModBin), - ?line undefined = nif_mod:lib_version(), - ?line ok = nif_mod:load_nif_lib(Config, 2, - [{resource_type, 2, ?RT_TAKEOVER, "resource_type_A",resource_dtor_B, - ?RT_TAKEOVER}, - {resource_type, 0, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",null, - ?RT_TAKEOVER}, - {resource_type, 1, ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A, - ?RT_TAKEOVER}, - {resource_type, null, ?RT_TAKEOVER, "Pink elephant", resource_dtor_A, - ?RT_TAKEOVER}, - {resource_type, 3, ?RT_CREATE, "resource_type_B_goneZ",resource_dtor_B, - ?RT_CREATE}, - {resource_type, 4, ?RT_CREATE, "resource_type_null_goneZ",null, - ?RT_CREATE} - ]), - - ?line 2 = nif_mod:lib_version(), + {module,nif_mod} = erlang:load_module(nif_mod,ModBin), + undefined = nif_mod:lib_version(), + ok = nif_mod:load_nif_lib(Config, 2, + [{resource_type, 2, ?RT_TAKEOVER, "resource_type_A",resource_dtor_B, + ?RT_TAKEOVER}, + {resource_type, 0, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",null, + ?RT_TAKEOVER}, + {resource_type, 1, ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, null, ?RT_TAKEOVER, "Pink elephant", resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, 3, ?RT_CREATE, "resource_type_B_goneZ",resource_dtor_B, + ?RT_CREATE}, + {resource_type, 4, ?RT_CREATE, "resource_type_null_goneZ",null, + ?RT_CREATE} + ]), + + 2 = nif_mod:lib_version(), ?CHECK([{upgrade,2,4,204},{lib_version,2,5,205}], nif_mod_call_history()), - ?line ok = forget_resource(A3), + ok = forget_resource(A3), ?CHECK([{{resource_dtor_B_v2,BinA3},2,6,206}], nif_mod_call_history()), - ?line ok = forget_resource(NA3), + ok = forget_resource(NA3), ?CHECK([], nif_mod_call_history()), - ?line ok = forget_resource(AN3), + ok = forget_resource(AN3), ?CHECK([{{resource_dtor_A_v2,BinAN3},2,7,207}], nif_mod_call_history()), {A4,BinA4} = make_resource(2,Holder, "A4"), @@ -804,19 +1490,19 @@ resource_takeover(Config) when is_list(Config) -> {BGZ1,BinBGZ1} = make_resource(3,Holder,"BGZ1"), {NGZ1,_BinNGZ1} = make_resource(4,Holder,"NGZ1"), - ?line false = code:purge(nif_mod), - ?line [] = nif_mod_call_history(), + false = code:purge(nif_mod), + [] = nif_mod_call_history(), - ?line ok = forget_resource(NGY1), - ?line [] = nif_mod_call_history(), + ok = forget_resource(NGY1), + [] = nif_mod_call_history(), - ?line ok = forget_resource(BGY1), % calling dtor in orphan library v2 still loaded - ?line [{{resource_dtor_B_v2,BinBGY1},2,8,208},{unload,2,9,209}] = nif_mod_call_history(), + ok = forget_resource(BGY1), % calling dtor in orphan library v2 still loaded + [{{resource_dtor_B_v2,BinBGY1},2,8,208},{unload,2,9,209}] = nif_mod_call_history(), %% Module upgrade with other lib-version - ?line {module,nif_mod} = erlang:load_module(nif_mod,ModBin), - ?line undefined = nif_mod:lib_version(), - ?line ok = nif_mod:load_nif_lib(Config, 1, + {module,nif_mod} = erlang:load_module(nif_mod,ModBin), + undefined = nif_mod:lib_version(), + ok = nif_mod:load_nif_lib(Config, 1, [{resource_type, 2, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A, ?RT_TAKEOVER}, {resource_type, 0, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",resource_dtor_A, @@ -827,28 +1513,28 @@ resource_takeover(Config) when is_list(Config) -> ?RT_TAKEOVER} ]), - ?line 1 = nif_mod:lib_version(), - ?line [{upgrade,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(), + 1 = nif_mod:lib_version(), + [{upgrade,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(), - %%?line false= check_process_code(Pid, nif_mod), - ?line false = code:purge(nif_mod), + %%false= check_process_code(Pid, nif_mod), + false = code:purge(nif_mod), %% no unload here as we still have instances with destructors - ?line [] = nif_mod_call_history(), + [] = nif_mod_call_history(), - ?line ok = forget_resource(BGZ1), % calling dtor in orphan library v2 still loaded - ?line [{{resource_dtor_B_v2,BinBGZ1},2,10,210},{unload,2,11,211}] = nif_mod_call_history(), + ok = forget_resource(BGZ1), % calling dtor in orphan library v2 still loaded + [{{resource_dtor_B_v2,BinBGZ1},2,10,210},{unload,2,11,211}] = nif_mod_call_history(), - ?line ok = forget_resource(NGZ1), - ?line [] = nif_mod_call_history(), + ok = forget_resource(NGZ1), + [] = nif_mod_call_history(), - ?line ok = forget_resource(A4), - ?line [{{resource_dtor_A_v1,BinA4},1,3,103}] = nif_mod_call_history(), + ok = forget_resource(A4), + [{{resource_dtor_A_v1,BinA4},1,3,103}] = nif_mod_call_history(), - ?line ok = forget_resource(NA4), - ?line [{{resource_dtor_A_v1,BinNA4},1,4,104}] = nif_mod_call_history(), + ok = forget_resource(NA4), + [{{resource_dtor_A_v1,BinNA4},1,4,104}] = nif_mod_call_history(), - ?line ok = forget_resource(AN4), - ?line [] = nif_mod_call_history(), + ok = forget_resource(AN4), + [] = nif_mod_call_history(), %% @@ -970,11 +1656,11 @@ resource_takeover(Config) when is_list(Config) -> {return, 0} % SUCCESS ]), - ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), - ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), {NA7,BinNA7} = make_resource(0, Holder, "NA7"), - {AN7,BinAN7} = make_resource(1, Holder, "AN7"), + {AN7,_BinAN7} = make_resource(1, Holder, "AN7"), ok = forget_resource(NA7), [{{resource_dtor_A_v1,BinNA7},1,_,_}] = nif_mod_call_history(), @@ -982,15 +1668,18 @@ resource_takeover(Config) when is_list(Config) -> ok = forget_resource(AN7), [] = nif_mod_call_history(), - ?line true = lists:member(?MODULE, erlang:system_info(taints)), - ?line true = lists:member(nif_mod, erlang:system_info(taints)), - ?line verify_tmpmem(TmpMem), + true = erlang:delete_module(nif_mod), + true = erlang:purge_module(nif_mod), + + true = lists:member(?MODULE, erlang:system_info(taints)), + true = lists:member(nif_mod, erlang:system_info(taints)), + verify_tmpmem(TmpMem), ok. make_resource(Type,Holder,Str) when is_list(Str) -> Bin = list_to_binary(Str), A1 = make_resource_do(Type,Holder,Bin), - ?line Bin = read_resource(Type,A1), + Bin = read_resource(Type,A1), {A1,Bin}. make_resource_do(Type, Holder, Bin) -> @@ -1017,7 +1706,7 @@ resource_holder(List) -> %%io:format("resource_holder got ~p with list = ~p\n", [Msg,List]), case Msg of {Pid, make, Type, Bin} -> - ?line Resource = nif_mod:make_new_resource(Type, Bin), + Resource = nif_mod:make_new_resource(Type, Bin), Id = {make_ref(),Bin}, Pid ! {self(), make_ok, Id}, resource_holder([{Id,Resource} | List]); @@ -1039,7 +1728,7 @@ resource_holder(Pid,Reply,List) -> resource_holder(List). -threading(doc) -> ["Test the threading API functions (reuse tests from driver API)"]; +%% Test the threading API functions (reuse tests from driver API) threading(Config) when is_list(Config) -> case erlang:system_info(threads) of true -> threading_do(Config); @@ -1047,62 +1736,65 @@ threading(Config) when is_list(Config) -> end. threading_do(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "tester"), - ?line {ok,tester,ModBin} = compile:file(File, [binary,return_errors]), - ?line {module,tester} = erlang:load_module(tester,ModBin), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "tester"), + {ok,tester,ModBin} = compile:file(File, [binary,return_errors]), + {module,tester} = erlang:load_module(tester,ModBin), + + ok = tester:load_nif_lib(Config, "basic"), + ok = tester:run(), + + erlang:load_module(tester,ModBin), + erlang:purge_module(tester), + ok = tester:load_nif_lib(Config, "rwlock"), + ok = tester:run(), - ?line ok = tester:load_nif_lib(Config, "basic"), - ?line ok = tester:run(), + erlang:load_module(tester,ModBin), + erlang:purge_module(tester), + ok = tester:load_nif_lib(Config, "tsd"), + ok = tester:run(), - ?line ok = tester:load_nif_lib(Config, "rwlock"), - ?line ok = tester:run(), + erlang:delete_module(tester), + erlang:purge_module(tester). - ?line ok = tester:load_nif_lib(Config, "tsd"), - ?line ok = tester:run(). -send(doc) -> ["Test NIF message sending"]; +%% 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(), + {ok,1} = send_list_seq(N, self), + {ok,1} = send_list_seq(N, self()), + List = receive_any(), + List = receive_any(), Papa = self(), - spawn_link(fun() -> ?line {ok,1} = send_list_seq(N, Papa) end), - ?line List = receive_any(), + spawn_link(fun() -> {ok,1} = send_list_seq(N, Papa) end), + List = receive_any(), - ?line {ok, 1, BlobS} = send_new_blob(self(), other_term()), - ?line BlobR = receive_any(), + {ok, 1, BlobS} = send_new_blob(self(), other_term()), + BlobR = receive_any(), io:format("Sent ~p\nGot ~p\n", [BlobS, BlobR]), - ?line BlobR = BlobS, + BlobR = BlobS, %% send to dead pid {DeadPid, DeadMon} = spawn_monitor(fun() -> void end), - ?line {'DOWN', DeadMon, process, DeadPid, normal} = receive_any(), + {'DOWN', DeadMon, process, DeadPid, normal} = receive_any(), {ok,0} = send_list_seq(7, DeadPid), ok. -send2(doc) -> ["More NIF message sending"]; +%% 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 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(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. send2_do1(SendBlobF) -> @@ -1114,44 +1806,44 @@ send2_do1(SendBlobF) -> io:format("sending to forwarder pid=~p\n",[Forwarder]), send2_do2(SendBlobF, Forwarder), Forwarder ! terminate, - ?line {Forwarder, 4} = receive_any(), + {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, + {ok,1,Blob0} = SendBlobF(MsgEnv, To), + Blob1 = receive_any(), + 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, + {ok,1,Blob2} = SendBlobF(MsgEnv, To), + Blob3 = receive_any(), + 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, + {ok,1,Blob4} = SendBlobF(MsgEnv, To), + Blob5 = receive_any(), + 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,1,Blob6} = SendBlobF(MsgEnv, To), + Blob7 = receive_any(), + 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,Blob} = send_blob_thread_dbg(MsgEnv, To, no_join), + {ok,SendRes} = join_send_thread(MsgEnv), {ok,SendRes,Blob}. send_blob_dbg(MsgEnv, To) -> @@ -1179,19 +1871,18 @@ forwarder(To, N) -> other_term() -> {fun(X,Y) -> X*Y end, make_ref()}. -send3(doc) -> ["Message sending stress test"]; +%% 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), + rand:seed(exsplus), + io:format("seed: ~p\n",[rand:export_seed()]), ets:new(nif_SUITE,[named_table,public]), - ?line true = ets:insert(nif_SUITE,{send3,0,0,0,0}), + 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), + [{_,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). @@ -1219,13 +1910,13 @@ send3_controller(SpawnCnt0, Mons0, Pids0, Tick) -> after Tick -> Max = 20, N = length(Pids0), - PidN = random:uniform(Max), + PidN = rand: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), + Balance = ets:lookup_element(nif_SUITE,send3,5), Inject = (Balance =< 0), case Inject of true -> ok; @@ -1251,7 +1942,7 @@ send3_proc(Pids0, Counters={Rcv,SndOk,SndFail}, State0) -> receive {pids, Pids1, Inject} -> %%io:format("~p: got ~p Inject=~p\n", [self(), Pids1, Inject]), - ?line Pids0 = [self()], + Pids0 = [self()], Pids2 = [self() | Pids1], case Inject of true -> send3_proc_send(Pids2, Counters, State0); @@ -1283,7 +1974,7 @@ send3_proc(Pids0, Counters={Rcv,SndOk,SndFail}, State0) -> end. send3_proc_send(Pids, {Rcv,SndOk,SndFail}, State0) -> - To = lists:nth(random:uniform(length(Pids)),Pids), + To = lists:nth(rand:uniform(length(Pids)),Pids), Blob = send3_make_blob(), State1 = send3_new_state(State0,Blob), case send3_send(To, Blob) of @@ -1295,28 +1986,32 @@ send3_proc_send(Pids, {Rcv,SndOk,SndFail}, State0) -> send3_make_blob() -> - case random:uniform(20)-1 of + case rand: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)) + fun(_) -> grow_blob(MsgEnv,other_term(),rand:uniform(1 bsl 20)) end, void), - case (N band 1) of + case (N band 3) of 0 -> {term,copy_blob(MsgEnv)}; - 1 -> {msgenv,MsgEnv} + 1 -> {copy,copy_blob(MsgEnv)}; + _ -> {msgenv,MsgEnv} end end. send3_send(Pid, Msg) -> %% 90% enif_send and 10% normal bang - case random:uniform(10) of + case rand: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, {copy,Blob}) -> + %%io:format("~p send term nif\n",[self()]), + send_copy_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. @@ -1325,109 +2020,115 @@ send3_send_bang(Pid, {term,Blob}) -> %%io:format("~p send term bang\n",[self()]), Pid ! {blob, Blob}, true; +send3_send_bang(Pid, {copy,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 + case rand: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"]; +%% Negative testing of load_nif neg(Config) when is_list(Config) -> TmpMem = tmpmem(), - ?line {'EXIT',{badarg,_}} = (catch erlang:load_nif(badarg, 0)), - ?line {error,{load_failed,_}} = erlang:load_nif("pink_unicorn", 0), + {'EXIT',{badarg,_}} = (catch erlang:load_nif(badarg, 0)), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "nif_mod"), - ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), - - ?line {error,{bad_lib,_}} = nif_mod:load_nif_lib(Config, no_init), - ?line verify_tmpmem(TmpMem), - ?line ok. + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "nif_mod"), + {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), + {module,nif_mod} = erlang:load_module(nif_mod,Bin), + + {error,{load_failed,_}} = nif_mod:load_nif_lib(Config, 0), + {error,{bad_lib,_}} = nif_mod:load_nif_lib(Config, no_init), + verify_tmpmem(TmpMem), + ok. -is_checks(doc) -> ["Test all enif_is functions"]; +%% 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, + ensure_lib_loaded(Config, 1), + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 12), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -12), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551617), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551617), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 99.146), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -99.146), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551616.2e2), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2), try - ?line error = check_is_exception(), - ?line throw(expected_badarg) + check_is_exception(), + throw(expected_badarg) catch error:badarg -> - ?line ok + ok end. -get_length(doc) -> ["Test all enif_get_length functions"]; +%% 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, 1), + ok = length_test(hejsan, "hejsan", [], [], not_a_list, [1,2|3]). ensure_lib_loaded(Config) -> ensure_lib_loaded(Config, 1). ensure_lib_loaded(Config, Ver) -> - ?line case lib_version() of - undefined -> - ?line Path = ?config(data_dir, Config), - ?line Lib = "nif_SUITE." ++ integer_to_list(Ver), - ?line ok = erlang:load_nif(filename:join(Path,Lib), []); - Ver when is_integer(Ver) -> - ok - end. + Path = ?config(data_dir, Config), + case lib_version() of + undefined -> + Lib = "nif_SUITE." ++ integer_to_list(Ver), + ok = erlang:load_nif(filename:join(Path,Lib), []); + Ver when is_integer(Ver) -> + ok + end, + erl_ddll:try_load(Path, echo_drv, []), + ok. make_atom(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), + 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}. + Atoms = make_atoms(), + 7 = size(Atoms), + 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), + ensure_lib_loaded(Config, 1), + Strings = make_strings(), + 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}. + Strings = {A0String,A0String,A0String,A0String0, AStringWithAccents}. reverse_list_test(Config) -> - ?line ensure_lib_loaded(Config, 1), + ensure_lib_loaded(Config, 1), List = lists:seq(1,100), RevList = lists:reverse(List), - ?line RevList = reverse_list(List), - ?line badarg = reverse_list(foo). + RevList = reverse_list(List), + badarg = reverse_list(foo). -otp_9668(doc) -> ["Memory leak of tmp-buffer when inspecting iolist or unaligned binary in unbound environment"]; +%% Memory leak of tmp-buffer when inspecting iolist or unaligned binary in unbound environment otp_9668(Config) -> ensure_lib_loaded(Config, 1), TmpMem = tmpmem(), @@ -1437,79 +2138,104 @@ otp_9668(Config) -> <<_:5/bitstring,UnalignedBin:10/binary,_/bitstring>> = <<"Abuse me as unaligned">>, otp_9668_nif(UnalignedBin), - ?line verify_tmpmem(TmpMem), + verify_tmpmem(TmpMem), ok. +%% Copy of writable binary +otp_9828(Config) -> + ensure_lib_loaded(Config, 1), + otp_9828_loop(<<"I'm alive!">>, 1000). + +otp_9828_loop(_Bin, 0) -> + ok; +otp_9828_loop(Bin, Val) -> + WrtBin = <<Bin/binary, Val:32>>, + ok = otp_9828_nif(WrtBin), + otp_9828_loop(WrtBin, Val-1). + + consume_timeslice(Config) when is_list(Config) -> - CONTEXT_REDS = 2000, + case {erlang:system_info(debug_compiled), + erlang:system_info(lock_checking)} of + {false, false} -> + consume_timeslice_test(Config); + {false, true} -> + {skipped, "Lock checking enabled"}; + _ -> + {skipped, "Debug compiled"} + end. + +consume_timeslice_test(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + CONTEXT_REDS = 4000, Me = self(), Go = make_ref(), RedDiff = make_ref(), Done = make_ref(), DummyMFA = {?MODULE,dummy_call,1}, P = spawn(fun () -> - receive Go -> ok end, - {reductions, R1} = process_info(self(), reductions), - 1 = consume_timeslice_nif(100, false), - dummy_call(111), - 0 = consume_timeslice_nif(90, false), - dummy_call(222), - 1 = consume_timeslice_nif(10, false), - dummy_call(333), - 0 = consume_timeslice_nif(25, false), - 0 = consume_timeslice_nif(25, false), - 0 = consume_timeslice_nif(25, false), - 1 = consume_timeslice_nif(25, false), - 0 = consume_timeslice_nif(25, false), - - ok = case consume_timeslice_nif(1, true) of - Cnt when Cnt > 70, Cnt < 80 -> ok; - Other -> Other - end, - dummy_call(444), - - {reductions, R2} = process_info(self(), reductions), - Me ! {RedDiff, R2 - R1}, - exit(Done) - end), + receive Go -> ok end, + {reductions, R1} = process_info(self(), reductions), + 1 = consume_timeslice_nif(100, false), + dummy_call(111), + 0 = consume_timeslice_nif(90, false), + dummy_call(222), + 1 = consume_timeslice_nif(10, false), + dummy_call(333), + 0 = consume_timeslice_nif(25, false), + 0 = consume_timeslice_nif(25, false), + 0 = consume_timeslice_nif(25, false), + 1 = consume_timeslice_nif(25, false), + 0 = consume_timeslice_nif(25, false), + + ok = case consume_timeslice_nif(1, true) of + Cnt when Cnt > 70, Cnt < 80 -> ok; + Other -> Other + end, + dummy_call(444), + + {reductions, R2} = process_info(self(), reductions), + Me ! {RedDiff, R2 - R1}, + exit(Done) + end), erlang:yield(), erlang:trace_pattern(DummyMFA, [], [local]), - ?line 1 = erlang:trace(P, true, [call, running, procs, {tracer, self()}]), + 1 = erlang:trace(P, true, [call, running, procs, {tracer, self()}]), P ! Go, %% receive Go -> ok end, - ?line {trace, P, in, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), %% consume_timeslice_nif(100), %% dummy_call(111) - ?line {trace, P, out, _} = next_tmsg(P), - ?line {trace, P, in, _} = next_tmsg(P), - ?line {trace, P, call, {?MODULE,dummy_call,[111]}} = next_tmsg(P), + {trace, P, out, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), + {trace, P, call, {?MODULE,dummy_call,[111]}} = next_tmsg(P), %% consume_timeslice_nif(90), %% dummy_call(222) - ?line {trace, P, call, {?MODULE,dummy_call,[222]}} = next_tmsg(P), + {trace, P, call, {?MODULE,dummy_call,[222]}} = next_tmsg(P), %% consume_timeslice_nif(10), %% dummy_call(333) - ?line {trace, P, out, _} = next_tmsg(P), - ?line {trace, P, in, _} = next_tmsg(P), - ?line {trace, P, call, {?MODULE,dummy_call,[333]}} = next_tmsg(P), + {trace, P, out, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), + {trace, P, call, {?MODULE,dummy_call,[333]}} = next_tmsg(P), %% 25,25,25,25, 25 - ?line {trace, P, out, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P), - ?line {trace, P, in, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P), + {trace, P, out, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P), + {trace, P, in, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P), %% consume_timeslice(1,true) %% dummy_call(444) - ?line {trace, P, out, DummyMFA} = next_tmsg(P), - ?line {trace, P, in, DummyMFA} = next_tmsg(P), - ?line {trace, P, call, {?MODULE,dummy_call,[444]}} = next_tmsg(P), + {trace, P, out, DummyMFA} = next_tmsg(P), + {trace, P, in, DummyMFA} = next_tmsg(P), + {trace, P, call, {?MODULE,dummy_call,[444]}} = next_tmsg(P), %% exit(Done) - ?line {trace, P, exit, Done} = next_tmsg(P), + {trace, P, exit, Done} = next_tmsg(P), ExpReds = (100 + 90 + 10 + 25*5 + 75) * CONTEXT_REDS div 100, receive @@ -1517,60 +2243,99 @@ consume_timeslice(Config) when is_list(Config) -> io:format("Reductions = ~p~n", [Reductions]), ok; {RedDiff, Reductions} -> - ?t:fail({unexpected_reduction_count, Reductions}) + ct:fail({unexpected_reduction_count, Reductions, ExpReds}) end, none = next_msg(P), ok. -dirty_nif(Config) when is_list(Config) -> - try erlang:system_info(dirty_cpu_schedulers) of - N when is_integer(N) -> - ensure_lib_loaded(Config), - Val1 = 42, - Val2 = "Erlang", - Val3 = list_to_binary([Val2, 0]), - {Val1, Val2, Val3} = call_dirty_nif(Val1, Val2, Val3), +nif_schedule(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + A = "this is a string", + B = {this,is,a,tuple}, + {B,A} = call_nif_schedule(A, B), + ok = try call_nif_schedule(1, 2) + catch + error:badarg -> + [{?MODULE,call_nif_schedule,[1,2],_}|_] = + erlang:get_stacktrace(), + ok + end, + ok. + +nif_exception(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + try + %% this checks that the expected exception occurs when the NIF + %% calls enif_make_badarg at some point but then tries to return a + %% value that isn't an exception + call_nif_exception(0), + ct:fail(expected_badarg) + catch + error:badarg -> + ok + end, + %% this checks that a NIF can raise various terms as exceptions + ok = nif_raise_exceptions(call_nif_exception), + ok. + +nif_nan_and_inf(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + try + call_nif_nan_or_inf(nan), + ct:fail(expected_badarg) + catch + error:badarg -> + ok + end, + try + call_nif_nan_or_inf(inf), + ct:fail(expected_badarg) + catch + error:badarg -> ok + end, + try + call_nif_nan_or_inf(tuple), + ct:fail(expected_badarg) catch error:badarg -> - {skipped,"No dirty scheduler support"} + ok end. -dirty_nif_send(Config) when is_list(Config) -> - try erlang:system_info(dirty_cpu_schedulers) of - N when is_integer(N) -> - ensure_lib_loaded(Config), - Parent = self(), - Pid = spawn_link(fun() -> - Self = self(), - {ok, Self} = receive_any(), - Parent ! {ok, Self} - end), - {ok, Pid} = send_from_dirty_nif(Pid), - {ok, Pid} = receive_any(), +nif_atom_too_long(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + try + call_nif_atom_too_long(all), + ct:fail(expected_badarg) + catch + error:badarg -> ok + end, + try + call_nif_atom_too_long(len), + ct:fail(expected_badarg) catch error:badarg -> - {skipped,"No dirty scheduler support"} + ok end. next_msg(_Pid) -> receive - M -> M + M -> M after 100 -> - none + none end. next_tmsg(Pid) -> receive TMsg when is_tuple(TMsg), - element(1, TMsg) == trace, - element(2, TMsg) == Pid -> - TMsg - after 100 -> - none - end. + element(1, TMsg) == trace, + element(2, TMsg) == Pid -> + TMsg + after 100 -> + none + end. dummy_call(_) -> ok. @@ -1580,7 +2345,9 @@ tmpmem() -> false -> undefined; MemInfo -> MSBCS = lists:foldl( - fun ({instance, _, L}, Acc) -> + fun ({instance, 0, _}, Acc) -> + Acc; % Ignore instance 0 + ({instance, _, L}, Acc) -> {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), [MBCS,SBCS | Acc] @@ -1608,9 +2375,7 @@ verify_tmpmem(MemInfo) -> ok end; Other -> - io:format("Expected: ~p", [MemInfo]), - io:format("Actual: ~p", [Other]), - ?t:fail() + ct:fail("Expected: ~p\nActual: ~p", [MemInfo, Other]) end. call(Pid,Cmd) -> @@ -1623,6 +2388,25 @@ call(Pid,Cmd) -> receive_any() -> receive M -> M end. +receive_any(Timeout) -> + receive M -> M + after Timeout -> timeout end. + +flush() -> + flush(1). + +flush(0) -> + flush(0, 10); % don't waste too much time waiting for nothing +flush(N) -> + flush(N, 1000). + +flush(N, Timeout) -> + receive M -> + [M | flush(N-1)] + after Timeout -> + [] + end. + repeat(0, _, Arg) -> Arg; repeat(N, Fun, Arg0) -> @@ -1632,10 +2416,787 @@ check(Exp,Got,Line) -> case Got of Exp -> Exp; _ -> - io:format("CHECK at ~p: Expected ~p but got ~p\n",[Line,Exp,Got]), + io:format("CHECK at line ~p\nExpected: ~p\nGot : ~p\n", + [Line,Exp,Got]), Got end. - + +nif_raise_exceptions(NifFunc) -> + ExcTerms = [{error, test}, "a string", <<"a binary">>, + 42, [1,2,3,4,5], [{p,1},{p,2},{p,3}]], + lists:foldl(fun(Term, ok) -> + try + erlang:apply(?MODULE,NifFunc,[Term]), + ct:fail({expected,Term}) + catch + error:Term -> + [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(), + ok + end + end, ok, ExcTerms). + +-define(ERL_NIF_TIME_ERROR, -9223372036854775808). +-define(TIME_UNITS, [second, millisecond, microsecond, nanosecond]). + +nif_monotonic_time(_Config) -> + ?ERL_NIF_TIME_ERROR = monotonic_time(invalid_time_unit), + mtime_loop(1000000). + +mtime_loop(0) -> + ok; +mtime_loop(N) -> + chk_mtime(?TIME_UNITS), + mtime_loop(N-1). + +chk_mtime([]) -> + ok; +chk_mtime([TU|TUs]) -> + A = erlang:monotonic_time(TU), + B = monotonic_time(TU), + C = erlang:monotonic_time(TU), + try + true = A =< B, + true = B =< C + catch + _ : _ -> + ct:fail({monotonic_time_missmatch, TU, A, B, C}) + end, + chk_mtime(TUs). + +nif_time_offset(_Config) -> + ?ERL_NIF_TIME_ERROR = time_offset(invalid_time_unit), + toffs_loop(1000000). + +toffs_loop(0) -> + ok; +toffs_loop(N) -> + chk_toffs(?TIME_UNITS), + toffs_loop(N-1). + +chk_toffs([]) -> + ok; +chk_toffs([TU|TUs]) -> + TO = erlang:time_offset(TU), + NifTO = time_offset(TU), + case TO =:= NifTO of + true -> + ok; + false -> + case erlang:system_info(time_warp_mode) of + no_time_warp -> + ct:fail({time_offset_mismatch, TU, TO, NifTO}); + _ -> + %% Most frequent time offset change + %% is currently only every 15:th + %% second so this should currently + %% work... + NTO = erlang:time_offset(TU), + case NifTO =:= NTO of + true -> + ok; + false -> + ct:fail({time_offset_mismatch, TU, TO, NifTO, NTO}) + end + end + end, + chk_toffs(TUs). + +nif_convert_time_unit(_Config) -> + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, second, invalid_time_unit), + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, second), + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, invalid_time_unit), + lists:foreach(fun (Offset) -> + lists:foreach(fun (Diff) -> + chk_ctu(Diff+(Offset*1000*1000*1000)) + end, + [999999999999, + 99999999999, + 9999999999, + 999999999, + 99999999, + 9999999, + 999999, + 99999, + 999, + 99, + 9, + 1, + 11, + 101, + 1001, + 10001, + 100001, + 1000001, + 10000001, + 100000001, + 1000000001, + 100000000001, + 1000000000001, + 5, + 50, + 500, + 5000, + 50000, + 500000, + 5000000, + 50000000, + 500000000, + 5000000000, + 50000000000, + 500000000000]) + end, + [-4711, -1000, -475, -5, -4, -3, -2, -1, 0, + 1, 2, 3, 4, 5, 475, 1000, 4711]), + ctu_loop(1000000). + +ctu_loop(0) -> + ok; +ctu_loop(N) -> + chk_ctu(erlang:monotonic_time(nanosecond)), + ctu_loop(N-1). + +chk_ctu(Time) -> + chk_ctu(Time, ?TIME_UNITS). + +chk_ctu(_Time, []) -> + ok; +chk_ctu(Time, [FromTU|FromTUs]) -> + chk_ctu(Time, FromTU, ?TIME_UNITS), + chk_ctu(Time, FromTUs). + +chk_ctu(_Time, _FromTU, []) -> + ok; +chk_ctu(Time, FromTU, [ToTU|ToTUs]) -> + T = erlang:convert_time_unit(Time, nanosecond, FromTU), + TE = erlang:convert_time_unit(T, FromTU, ToTU), + TN = convert_time_unit(T, FromTU, ToTU), + case TE =:= TN of + false -> + ct:fail({conversion_mismatch, FromTU, T, ToTU, TE, TN}); + true -> + chk_ctu(Time, FromTU, ToTUs) + end. + +nif_now_time(Config) -> + ensure_lib_loaded(Config), + + N1 = now(), + NifN1 = now_time(), + NifN2 = now_time(), + N2 = now(), + true = N1 < NifN1, + true = NifN1 < NifN2, + true = NifN2 < N2. + +nif_cpu_time(Config) -> + ensure_lib_loaded(Config), + + try cpu_time() of + {_, _, _} -> + ok + catch error:badarg -> + {comment, "cpu_time not supported"} + end. + +nif_unique_integer(Config) -> + ensure_lib_loaded(Config), + + UM1 = erlang:unique_integer([monotonic]), + UM2 = unique_integer_nif([monotonic]), + UM3 = erlang:unique_integer([monotonic]), + + true = UM1 < UM2, + true = UM2 < UM3, + + UMP1 = erlang:unique_integer([monotonic, positive]), + UMP2 = unique_integer_nif([monotonic, positive]), + UMP3 = erlang:unique_integer([monotonic, positive]), + + true = 0 =< UMP1, + true = UMP1 < UMP2, + true = UMP2 < UMP3, + + UP1 = erlang:unique_integer([positive]), + UP2 = unique_integer_nif([positive]), + UP3 = erlang:unique_integer([positive]), + + true = 0 =< UP1, + true = 0 =< UP2, + true = 0 =< UP3, + + true = is_integer(unique_integer_nif([])), + true = is_integer(unique_integer_nif([])), + true = is_integer(unique_integer_nif([])). + +nif_is_process_alive(Config) -> + ensure_lib_loaded(Config), + + {Pid,_} = spawn_monitor(fun() -> receive ok -> nok end end), + true = is_process_alive_nif(Pid), + exit(Pid, die), + receive _ -> ok end, %% Clear monitor + false = is_process_alive_nif(Pid). + +nif_is_port_alive(Config) -> + ensure_lib_loaded(Config), + + Port = open_port({spawn,echo_drv},[eof]), + true = is_port_alive_nif(Port), + port_close(Port), + false = is_port_alive_nif(Port). + +nif_term_to_binary(Config) -> + ensure_lib_loaded(Config), + T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)}, + Bin = term_to_binary(T), + ct:log("~p",[Bin]), + Bin = term_to_binary_nif(T, undefined), + true = term_to_binary_nif(T, self()), + receive Bin -> ok end. + +-define(ERL_NIF_BIN2TERM_SAFE, 16#20000000). + +nif_binary_to_term(Config) -> + ensure_lib_loaded(Config), + T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)}, + Bin = term_to_binary(T), + Len = byte_size(Bin), + {Len,T} = binary_to_term_nif(Bin, undefined, 0), + Len = binary_to_term_nif(Bin, self(), 0), + T = receive M -> M after 1000 -> timeout end, + + {Len, T} = binary_to_term_nif(Bin, undefined, ?ERL_NIF_BIN2TERM_SAFE), + false = binary_to_term_nif(<<131,100,0,14,"undefined_atom">>, + undefined, ?ERL_NIF_BIN2TERM_SAFE), + false = binary_to_term_nif(Bin, undefined, 1), + ok. + +nif_port_command(Config) -> + ensure_lib_loaded(Config), + + Port = open_port({spawn,echo_drv},[eof]), + true = port_command_nif(Port, "hello\n"), + receive {Port,{data,"hello\n"}} -> ok + after 1000 -> ct:fail(timeout) end, + + RefcBin = lists:flatten([lists:duplicate(100, "hello"),"\n"]), + true = port_command_nif(Port, iolist_to_binary(RefcBin)), + receive {Port,{data,RefcBin}} -> ok + after 1000 -> ct:fail(timeout) end, + + %% Test that invalid arguments correctly returns + %% badarg and that the port survives. + {'EXIT', {badarg, _}} = (catch port_command_nif(Port, [ok])), + + IoList = [lists:duplicate(100,<<"hello">>),"\n"], + true = port_command_nif(Port, [IoList]), + FlatIoList = binary_to_list(iolist_to_binary(IoList)), + receive {Port,{data,FlatIoList}} -> ok + after 1000 -> ct:fail(timeout) end, + + port_close(Port), + + {'EXIT', {badarg, _}} = (catch port_command_nif(Port, "hello\n")), + ok. + +nif_snprintf(Config) -> + ensure_lib_loaded(Config), + <<"ok",0>> = format_term_nif(3,ok), + <<"o",0>> = format_term_nif(2,ok), + <<"\"hello world\"",0>> = format_term_nif(14,"hello world"), + <<"{{hello,world,-33},3.14",_/binary>> = format_term_nif(50,{{hello,world, -33}, 3.14, self()}), + <<"{{hello,world,-33},",0>> = format_term_nif(20,{{hello,world, -33}, 3.14, self()}), + ok. + +nif_internal_hash(Config) -> + ensure_lib_loaded(Config), + HashValueBitSize = nif_hash_result_bitsize(internal), + Terms = unique([random_term() || _ <- lists:seq(1, 500)]), + HashValues = [hash_nif(internal, Term, 0) || Term <- Terms], + test_bit_distribution_fitness(HashValues, HashValueBitSize). + +nif_internal_hash_salted(Config) -> + ensure_lib_loaded(Config), + test_salted_nif_hash(internal). + +nif_phash2(Config) -> + ensure_lib_loaded(Config), + HashValueBitSize = nif_hash_result_bitsize(phash2), + Terms = unique([random_term() || _ <- lists:seq(1, 500)]), + HashValues = + lists:map( + fun (Term) -> + HashValue = erlang:phash2(Term), + Salt = random_uint32(), % phash2 should ignore salt + NifHashValue = hash_nif(phash2, Term, Salt), + (HashValue =:= NifHashValue + orelse ct:fail("Expected: ~p\nActual: ~p", + [HashValue, NifHashValue])), + HashValue + end, + Terms), + test_bit_distribution_fitness(HashValues, HashValueBitSize). + +test_salted_nif_hash(HashType) -> + HashValueBitSize = nif_hash_result_bitsize(HashType), + Terms = unique([random_term() || _ <- lists:seq(1, 500)]), + Salts = unique([random_uint32() || _ <- lists:seq(1, 50)]), + {HashValuesPerSalt, HashValuesPerTerm} = + lists:mapfoldl( + fun (Salt, Acc) -> + {HashValues, NewAcc} = + lists:mapfoldl( + fun (Term, AccB) -> + HashValue = hash_nif(HashType, Term, Salt), + NewAccB = dict:append(Term, HashValue, AccB), + {HashValue, NewAccB} + end, + Acc, + Terms), + {{Salt, HashValues}, NewAcc} + end, + dict:new(), + Salts), + + % Test per-salt hash distribution of different terms + lists:foreach( + fun ({_Salt, HashValues}) -> + test_bit_distribution_fitness(HashValues, HashValueBitSize) + end, + HashValuesPerSalt), + + % Test per-term hash distribution of different salts + dict:fold( + fun (_Term, HashValues, Acc) -> + test_bit_distribution_fitness(HashValues, HashValueBitSize), + Acc + end, + ok, + HashValuesPerTerm). + +test_bit_distribution_fitness(Integers, BitSize) -> + MaxInteger = (1 bsl BitSize) - 1, + OnesPerBit = + lists:foldl( + fun (Integer, Acc) when Integer >= 0, Integer =< MaxInteger -> + lists:foldl( + fun (BitIndex, AccB) -> + BitValue = (Integer band (1 bsl BitIndex)) bsr BitIndex, + orddict:update_counter(BitIndex, BitValue, AccB) + end, + Acc, + lists:seq(0, BitSize - 1)) + end, + orddict:new(), + Integers), + + N = length(Integers), + ExpectedNrOfOnes = N div 2, + %% ExpectedNrOfOnes should have a binomial distribution + %% with a standard deviation as: + ExpectedStdDev = math:sqrt(N) / 2, + %% which can be approximated as a normal distribution + %% where we allow a deviation of 6 std.devs + %% for a fail probability of 0.000000002: + MaxStdDevs = 6, + + FailureText = + orddict:fold( + fun (BitIndex, NrOfOnes, Acc) -> + Deviation = abs(NrOfOnes - ExpectedNrOfOnes) / ExpectedStdDev, + case Deviation >= MaxStdDevs of + false -> + Acc; + true -> + [Acc, + io_lib:format( + "Unreasonable deviation on number of set bits (i=~p): " + "expected ~p, got ~p (# std.dev ~.3f > ~p)~n", + [BitIndex, ExpectedNrOfOnes, NrOfOnes, Deviation, MaxStdDevs])] + end + end, + [], + OnesPerBit), + + (FailureText =:= [] orelse ct:fail(FailureText)). + +nif_hash_result_bitsize(internal) -> 32; +nif_hash_result_bitsize(phash2) -> 27. + +unique(List) -> + lists:usort(List). + +random_uint32() -> + rand:uniform(1 bsl 32) - 1. + +random_term() -> + case rand:uniform(6) of + 1 -> rand:uniform(1 bsl 27) - 1; % small + 2 -> (1 bsl 27) + rand:uniform(1 bsl 128); % big + 3 -> random_sign() * (rand:uniform() * (1 bsl 53)); % float + 4 -> random_binary(); + 5 -> random_pid(); + 6 -> + Length = rand:uniform(10), + List = [random_term() || _ <- lists:seq(1, Length)], + case rand:uniform(2) of + 1 -> + List; + 2 -> + list_to_tuple(List) + end + end. + +random_sign() -> + case rand:uniform(2) of + 1 -> -1.0; + 2 -> 1.0 + end. + +random_binary() -> + list_to_binary(random_bytes(rand:uniform(32) - 1)). + +random_bytes(0) -> + []; +random_bytes(N) when N > 0 -> + [rand:uniform(256) - 1 | random_bytes(N - 1)]. + +random_pid() -> + Processes = erlang:processes(), + lists:nth(rand:uniform(length(Processes)), Processes). + +%% Test enif_whereis_... + +nif_whereis(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + RegName = nif_whereis_test_thing, + undefined = erlang:whereis(RegName), + false = whereis_term(pid, RegName), + + Mgr = self(), + Ref = make_ref(), + ProcMsg = {Ref, ?LINE}, + PortMsg = ?MODULE_STRING " whereis hello\n", + + {Pid, Mon} = spawn_monitor(?MODULE, nif_whereis_proxy, [Ref]), + true = register(RegName, Pid), + Pid = erlang:whereis(RegName), + Pid = whereis_term(pid, RegName), + false = whereis_term(port, RegName), + false = whereis_term(pid, [RegName]), + + ok = whereis_send(pid, RegName, {forward, Mgr, ProcMsg}), + ok = receive ProcMsg -> ok end, + + Pid ! {Ref, quit}, + ok = receive {'DOWN', Mon, process, Pid, normal} -> ok end, + undefined = erlang:whereis(RegName), + false = whereis_term(pid, RegName), + + Port = open_port({spawn, echo_drv}, [eof]), + true = register(RegName, Port), + Port = erlang:whereis(RegName), + Port = whereis_term(port, RegName), + false = whereis_term(pid, RegName), + false = whereis_term(port, [RegName]), + + ok = whereis_send(port, RegName, PortMsg), + ok = receive {Port, {data, PortMsg}} -> ok end, + + port_close(Port), + undefined = erlang:whereis(RegName), + false = whereis_term(port, RegName), + ok. + +nif_whereis_parallel(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + %% try to be at least a little asymetric + NProcs = trunc(3.7 * erlang:system_info(schedulers)), + NSeq = lists:seq(1, NProcs), + Names = [list_to_atom("nif_whereis_proc_" ++ integer_to_list(N)) + || N <- NSeq], + Mgr = self(), + Ref = make_ref(), + + NotReg = fun(Name) -> + erlang:whereis(Name) == undefined + end, + PidReg = fun({Name, Pid, _Mon}) -> + erlang:whereis(Name) == Pid andalso whereis_term(pid, Name) == Pid + end, + RecvDown = fun({_Name, Pid, Mon}) -> + receive {'DOWN', Mon, process, Pid, normal} -> true + after 1500 -> false end + end, + RecvNum = fun(N) -> + receive {N, Ref} -> true + after 1500 -> false end + end, + + true = lists:all(NotReg, Names), + + %% {Name, Pid, Mon} + Procs = lists:map( + fun(N) -> + Name = lists:nth(N, Names), + Prev = lists:nth((if N == 1 -> NProcs; true -> (N - 1) end), Names), + Next = lists:nth((if N == NProcs -> 1; true -> (N + 1) end), Names), + {Pid, Mon} = spawn_monitor( + ?MODULE, nif_whereis_proxy, [{N, Ref, Mgr, [Prev, Next]}]), + true = register(Name, Pid), + {Name, Pid, Mon} + end, NSeq), + + true = lists:all(PidReg, Procs), + + %% tell them all to 'fire' as fast as we can + repeat(10, fun(_) -> + [P ! {Ref, send_proc} || {_, P, _} <- Procs] + end, void), + + %% each gets forwarded through two processes + repeat(10, fun(_) -> + true = lists:all(RecvNum, NSeq), + true = lists:all(RecvNum, NSeq) + end, void), + + %% tell them all to 'quit' by name + [N ! {Ref, quit} || {N, _, _} <- Procs], + true = lists:all(RecvDown, Procs), + true = lists:all(NotReg, Names), + ok. + +nif_whereis_threaded(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + RegName = nif_whereis_test_threaded, + undefined = erlang:whereis(RegName), + + Ref = make_ref(), + {Pid, Mon} = spawn_monitor(?MODULE, nif_whereis_proxy, [Ref]), + true = register(RegName, Pid), + + {ok, ProcThr} = whereis_thd_lookup(pid, RegName), + {ok, Pid} = whereis_thd_result(ProcThr), + + Pid ! {Ref, quit}, + ok = receive {'DOWN', Mon, process, Pid, normal} -> ok end, + + Port = open_port({spawn, echo_drv}, [eof]), + true = register(RegName, Port), + + {ok, PortThr} = whereis_thd_lookup(port, RegName), + {ok, Port} = whereis_thd_result(PortThr), + + port_close(Port), + ok. + +%% exported to be spawned by MFA by whereis tests +nif_whereis_proxy({N, Ref, Mgr, Targets} = Args) -> + receive + {forward, To, Data} -> + To ! Data, + nif_whereis_proxy(Args); + {Ref, quit} -> + ok; + {Ref, send_port} -> + Msg = ?MODULE_STRING " whereis " ++ integer_to_list(N) ++ "\n", + lists:foreach( + fun(T) -> + ok = whereis_send(port, T, Msg) + end, Targets), + nif_whereis_proxy(Args); + {Ref, send_proc} -> + lists:foreach( + fun(T) -> + ok = whereis_send(pid, T, {forward, Mgr, {N, Ref}}) + end, Targets), + nif_whereis_proxy(Args) + end; +nif_whereis_proxy(Ref) -> + receive + {forward, To, Data} -> + To ! Data, + nif_whereis_proxy(Ref); + {Ref, quit} -> + ok + end. +nif_ioq(Config) -> + ensure_lib_loaded(Config), + + Script = + [{create, a}, + + %% Test enq of erlang term binary + {enqb, a}, + {enqb, a, 3}, + + %% Test enq of non-erlang term binary + {enqbraw,a}, + {enqbraw,a, 5}, + {peek, a}, + {deq, a, 42}, + + %% Test enqv + {enqv, a, 2, 100}, + {deq, a, all}, + + %% This skips all elements but one in the iolist + {enqv, a, 5, iolist_size(nif_ioq_payload(5)) - 1}, + {peek, a}, + + %% Test to enqueue a bunch of refc binaries + {enqv, a, [nif_ioq_payload(refcbin) || _ <- lists:seq(1,20)], 0}, + + %% Enq stuff to destroy with data in queue + {enqv, a, 2, 100}, + {destroy,a}, + + %% Test destroy of new queue + {create, a}, + {destroy,a} + ], + + nif_ioq_run(Script), + + %% Test that only enif_inspect_as_vec works + Payload = nif_ioq_payload(5), + PayloadBin = iolist_to_binary(Payload), + + [begin + PayloadBin = iolist_to_binary(ioq_nif(inspect,Payload,Stack,Env)), + <<>> = iolist_to_binary(ioq_nif(inspect,[],Stack,Env)) + end || Stack <- [no_stack, use_stack], Env <- [use_env, no_env]], + + %% Test error cases + + Q = ioq_nif(create), + + {'EXIT', {badarg, _}} = (catch ioq_nif(deq, Q, 1)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, 1, 1234)), + + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [atom_in_list], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [make_ref()], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [256], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [-1], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [#{}], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [1 bsl 64], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [{tuple}], 0)), + + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [atom_in_list], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [make_ref()], no_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [256], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [-1], no_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [#{}], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [1 bsl 64], no_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [{tuple}], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, <<"binary">>, use_stack)), + + ioq_nif(destroy, Q), + + %% Test that the example in the docs works + ExampleQ = ioq_nif(create), + true = ioq_nif(example, ExampleQ, nif_ioq_payload(5)), + ioq_nif(destroy, ExampleQ), + + ok. + + +nif_ioq_run(Script) -> + nif_ioq_run(Script, #{}). + +nif_ioq_run([{Action, Name}|T], State) + when Action =:= enqb; Action =:= enqbraw -> + nif_ioq_run([{Action, Name, heapbin}|T], State); +nif_ioq_run([{Action, Name, Skip}|T], State) + when Action =:= enqb, is_integer(Skip); + Action =:= enqbraw, is_integer(Skip) -> + nif_ioq_run([{Action, Name, heapbin, Skip}|T], State); +nif_ioq_run([{Action, Name, N}|T], State) + when Action =:= enqv; Action =:= enqb; Action =:= enqbraw -> + nif_ioq_run([{Action, Name, N, 0}|T], State); +nif_ioq_run([{Action, Name, N, Skip}|T], State) + when Action =:= enqv; Action =:= enqb; Action =:= enqbraw -> + + #{ q := IOQ, b := B } = Q = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + %% Sanitize the log output a bit so that it doesn't become too large. + H = {Action, Name, try iolist_size(N) of Sz -> Sz catch _:_ -> N end, Skip}, + ct:log("~p", [H]), + + Data = nif_ioq_payload(N), + ioq_nif(Action, IOQ, Data, Skip), + + <<_:Skip/binary, SkippedData/binary>> = iolist_to_binary(Data), + + true = ioq_nif(size, IOQ) == (iolist_size([B|SkippedData])), + + nif_ioq_run(T, State#{ Name := Q#{ b := [B|SkippedData]}}); +nif_ioq_run([{peek, Name} = H|T], State) -> + #{ q := IOQ, b := B } = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + ct:log("~p", [H]), + + Data = ioq_nif(peek, IOQ, ioq_nif(size, IOQ)), + + true = iolist_to_binary(B) == iolist_to_binary(Data), + nif_ioq_run(T, State); +nif_ioq_run([{deq, Name, all}|T], State) -> + #{ q := IOQ, b := B } = maps:get(Name, State), + Size = ioq_nif(size, IOQ), + true = Size == iolist_size(B), + nif_ioq_run([{deq, Name, Size}|T], State); +nif_ioq_run([{deq, Name, N} = H|T], State) -> + #{ q := IOQ, b := B } = Q = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + ct:log("~p", [H]), + + <<_:N/binary,Remain/binary>> = iolist_to_binary(B), + NewQ = Q#{ b := Remain }, + + Sz = ioq_nif(deq, IOQ, N), + + true = Sz == iolist_size(Remain), + true = ioq_nif(size, IOQ) == iolist_size(Remain), + + nif_ioq_run(T, State#{ Name := NewQ }); +nif_ioq_run([{create, Name} = H|T], State) -> + ct:log("~p", [H]), + nif_ioq_run(T, State#{ Name => #{ q => ioq_nif(create), b => [] } }); +nif_ioq_run([{destroy, Name} = H|T], State) -> + #{ q := IOQ, b := B } = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + ct:log("~p", [H]), + + ioq_nif(destroy, IOQ), + + nif_ioq_run(T, maps:remove(Name, State)); +nif_ioq_run([], State) -> + State. + +nif_ioq_payload(N) when is_integer(N) -> + Tail = if N > 3 -> nif_ioq_payload(N-3); true -> [] end, + Head = element(1, lists:split(N,[nif_ioq_payload(subbin), + nif_ioq_payload(heapbin), + nif_ioq_payload(refcbin) | Tail])), + erlang:iolist_to_iovec(Head); +nif_ioq_payload(subbin) -> + Bin = nif_ioq_payload(refcbin), + Sz = size(Bin) - 1, + <<_:8,SubBin:Sz/binary,_/bits>> = Bin, + SubBin; +nif_ioq_payload(heapbin) -> + <<"a literal heap binary">>; +nif_ioq_payload(refcbin) -> + iolist_to_binary([lists:seq(1,255) || _ <- lists:seq(1,255)]); +nif_ioq_payload(Else) -> + Else. %% The NIFs: lib_version() -> undefined. @@ -1647,6 +3208,7 @@ type_test() -> ?nif_stub. tuple_2_list(_) -> ?nif_stub. is_identical(_,_) -> ?nif_stub. compare(_,_) -> ?nif_stub. +hash_nif(_Type, _Term, _Salt) -> ?nif_stub. many_args_100(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. clone_bin(_) -> ?nif_stub. make_sub_bin(_,_,_) -> ?nif_stub. @@ -1660,11 +3222,12 @@ alloc_resource(_,_) -> ?nif_stub. make_resource(_) -> ?nif_stub. get_resource(_,_) -> ?nif_stub. release_resource(_) -> ?nif_stub. +release_resource_from_thread(_) -> ?nif_stub. last_resource_dtor_call() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. check_is_exception() -> ?nif_stub. -length_test(_,_,_,_,_) -> ?nif_stub. +length_test(_,_,_,_,_,_) -> ?nif_stub. make_atoms() -> ?nif_stub. make_strings() -> ?nif_stub. make_new_resource_binary(_) -> ?nif_stub. @@ -1680,13 +3243,47 @@ send_blob_thread(_,_,_) -> ?nif_stub. join_send_thread(_) -> ?nif_stub. copy_blob(_) -> ?nif_stub. send_term(_,_) -> ?nif_stub. +send_copy_term(_,_) -> ?nif_stub. reverse_list(_) -> ?nif_stub. echo_int(_) -> ?nif_stub. type_sizes() -> ?nif_stub. otp_9668_nif(_) -> ?nif_stub. +otp_9828_nif(_) -> ?nif_stub. consume_timeslice_nif(_,_) -> ?nif_stub. -call_dirty_nif(_,_,_) -> ?nif_stub. -send_from_dirty_nif(_) -> ?nif_stub. +call_nif_schedule(_,_) -> ?nif_stub. +call_nif_exception(_) -> ?nif_stub. +call_nif_nan_or_inf(_) -> ?nif_stub. +call_nif_atom_too_long(_) -> ?nif_stub. +unique_integer_nif(_) -> ?nif_stub. +is_process_alive_nif(_) -> ?nif_stub. +is_port_alive_nif(_) -> ?nif_stub. +term_to_binary_nif(_, _) -> ?nif_stub. +binary_to_term_nif(_, _, _) -> ?nif_stub. +port_command_nif(_, _) -> ?nif_stub. +format_term_nif(_,_) -> ?nif_stub. +select_nif(_,_,_,_,_) -> ?nif_stub. +dupe_resource_nif(_) -> ?nif_stub. +pipe_nif() -> ?nif_stub. +write_nif(_,_) -> ?nif_stub. +read_nif(_,_) -> ?nif_stub. +is_closed_nif(_) -> ?nif_stub. +clear_select_nif(_) -> ?nif_stub. +last_fd_stop_call() -> ?nif_stub. +alloc_monitor_resource_nif() -> ?nif_stub. +monitor_process_nif(_,_,_,_) -> ?nif_stub. +demonitor_process_nif(_,_) -> ?nif_stub. +compare_monitors_nif(_,_) -> ?nif_stub. +monitor_frenzy_nif(_,_,_,_) -> ?nif_stub. +ioq_nif(_) -> ?nif_stub. +ioq_nif(_,_) -> ?nif_stub. +ioq_nif(_,_,_) -> ?nif_stub. +ioq_nif(_,_,_,_) -> ?nif_stub. + +%% whereis +whereis_send(_Type,_Name,_Msg) -> ?nif_stub. +whereis_term(_Type,_Name) -> ?nif_stub. +whereis_thd_lookup(_Type,_Name) -> ?nif_stub. +whereis_thd_result(_Thd) -> ?nif_stub. %% maps is_map_nif(_) -> ?nif_stub. @@ -1699,6 +3296,12 @@ make_map_remove_nif(_,_) -> ?nif_stub. maps_from_list_nif(_) -> ?nif_stub. sorted_list_from_maps_nif(_) -> ?nif_stub. +%% Time +monotonic_time(_) -> ?nif_stub. +time_offset(_) -> ?nif_stub. +convert_time_unit(_,_,_) -> ?nif_stub. +now_time() -> ?nif_stub. +cpu_time() -> ?nif_stub. nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/Makefile.src b/erts/emulator/test/nif_SUITE_data/Makefile.src index ab4ff77add..de06026780 100644 --- a/erts/emulator/test/nif_SUITE_data/Makefile.src +++ b/erts/emulator/test/nif_SUITE_data/Makefile.src @@ -2,10 +2,15 @@ NIF_LIBS = nif_SUITE.1@dll@ \ nif_mod.1@dll@ \ nif_mod.2@dll@ \ - nif_mod.3@dll@ - -all: $(NIF_LIBS) basic@dll@ rwlock@dll@ tsd@dll@ - + nif_mod.3@dll@ \ + nif_mod.1.2_0@dll@ \ + nif_mod.2.2_0@dll@ \ + nif_mod.3.2_0@dll@ \ + nif_mod.1.2_4@dll@ \ + nif_mod.2.2_4@dll@ \ + nif_mod.3.2_4@dll@ + +all: $(NIF_LIBS) basic@dll@ rwlock@dll@ tsd@dll@ echo_drv@dll@ @SHLIB_RULES@ diff --git a/erts/emulator/test/nif_SUITE_data/echo_drv.c b/erts/emulator/test/nif_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..2b3510c641 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/echo_drv.c @@ -0,0 +1,62 @@ +#include <stdio.h> +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData echo_start(ErlDrvPort, char *); +static void from_erlang(ErlDrvData, char*, ErlDrvSizeT); +static ErlDrvSSizeT echo_call(ErlDrvData drv_data, unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, unsigned *ret_flags); +static ErlDrvEntry echo_driver_entry = { + NULL, /* Init */ + echo_start, + NULL, /* Stop */ + from_erlang, + NULL, /* Ready input */ + NULL, /* Ready output */ + "echo_drv", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + echo_call, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, + NULL, + NULL +}; + +DRIVER_INIT(echo_drv) +{ + return &echo_driver_entry; +} + +static ErlDrvData +echo_start(ErlDrvPort port, char *buf) +{ + return (ErlDrvData) port; +} + +static void +from_erlang(ErlDrvData data, char *buf, ErlDrvSizeT count) +{ + driver_output((ErlDrvPort) data, buf, count); +} + +static ErlDrvSSizeT +echo_call(ErlDrvData drv_data, unsigned int command, + char *buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen, + unsigned *ret_flags) +{ + *rbuf = buf; + *ret_flags |= DRIVER_CALL_KEEP_BUFFER; + return len; +} + diff --git a/erts/emulator/test/nif_SUITE_data/hipe_compiled.erl b/erts/emulator/test/nif_SUITE_data/hipe_compiled.erl new file mode 100644 index 0000000000..84ddbc8d63 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/hipe_compiled.erl @@ -0,0 +1,6 @@ +-module(hipe_compiled). + +-export([try_load_nif/0]). + +try_load_nif() -> + erlang:load_nif("doesn't matter", 0). diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 955dc64189..79560a38aa 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1,39 +1,95 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-2017. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ -#include "erl_nif.h" +#include <erl_nif.h> #include <stdio.h> #include <string.h> #include <assert.h> #include <limits.h> +#include <errno.h> +#ifndef __WIN32__ +#include <unistd.h> +#include <fcntl.h> +#endif #include "nif_mod.h" +#if 0 +static ErlNifMutex* dbg_trace_lock; +#define DBG_TRACE_INIT dbg_trace_lock = enif_mutex_create("nif_SUITE.DBG_TRACE") +#define DBG_TRACE_FINI enif_mutex_destroy(dbg_trace_lock) +#define DBG_TRACE_LOCK enif_mutex_lock(dbg_trace_lock) +#define DBG_TRACE_UNLOCK enif_mutex_unlock(dbg_trace_lock) +#define DBG_TRACE0(FMT) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT); DBG_TRACE_UNLOCK; }while(0) +#define DBG_TRACE1(FMT, A) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A); DBG_TRACE_UNLOCK; }while(0) +#define DBG_TRACE2(FMT, A, B) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A, B); DBG_TRACE_UNLOCK; }while(0) +#define DBG_TRACE3(FMT, A, B, C) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A, B, C); DBG_TRACE_UNLOCK; }while(0) +#define DBG_TRACE4(FMT, A, B, C, D) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A, B, C, D); DBG_TRACE_UNLOCK; }while(0) +#else +#define DBG_TRACE_INIT +#define DBG_TRACE_FINI +#define DBG_TRACE0(FMT) +#define DBG_TRACE1(FMT, A) +#define DBG_TRACE2(FMT, A, B) +#define DBG_TRACE3(FMT, A, B, C) +#define DBG_TRACE4(FMT, A, B, C, D) +#endif + +/* + * Hack to get around this function missing from the NIF API. + * TODO: Add this function/macro in the appropriate place, probably with + * enif_make_pid() in erl_nif_api_funcs.h + */ +#ifndef enif_make_port +#define enif_make_port(ENV, PORT) ((void)(ENV),(const ERL_NIF_TERM)((PORT)->port_id)) +#endif + static int static_cntA; /* zero by default */ static int static_cntB = NIF_SUITE_LIB_VER * 100; static ERL_NIF_TERM atom_false; +static ERL_NIF_TERM atom_true; 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; - +static ERL_NIF_TERM atom_second; +static ERL_NIF_TERM atom_millisecond; +static ERL_NIF_TERM atom_microsecond; +static ERL_NIF_TERM atom_nanosecond; +static ERL_NIF_TERM atom_eagain; +static ERL_NIF_TERM atom_eof; +static ERL_NIF_TERM atom_error; +static ERL_NIF_TERM atom_fd_resource_stop; +static ERL_NIF_TERM atom_monitor_resource_type; +static ERL_NIF_TERM atom_monitor_resource_down; +static ERL_NIF_TERM atom_init; +static ERL_NIF_TERM atom_stats; +static ERL_NIF_TERM atom_done; +static ERL_NIF_TERM atom_stop; +static ERL_NIF_TERM atom_null; +static ERL_NIF_TERM atom_pid; +static ERL_NIF_TERM atom_port; +static ERL_NIF_TERM atom_send; +static ERL_NIF_TERM atom_lookup; +static ERL_NIF_TERM atom_badarg; typedef struct { @@ -93,23 +149,69 @@ struct binary_resource { unsigned size; }; +static ErlNifResourceType* fd_resource_type; +static void fd_resource_dtor(ErlNifEnv* env, void* obj); +static void fd_resource_stop(ErlNifEnv* env, void* obj, ErlNifEvent, int); +static ErlNifResourceTypeInit fd_rt_init = { + fd_resource_dtor, + fd_resource_stop +}; +struct fd_resource { + ErlNifEvent fd; + int was_selected; + ErlNifPid pid; +}; + +static ErlNifResourceType* monitor_resource_type; +static void monitor_resource_dtor(ErlNifEnv* env, void* obj); +static void monitor_resource_down(ErlNifEnv*, void* obj, ErlNifPid*, ErlNifMonitor*); +static ErlNifResourceTypeInit monitor_rt_init = { + monitor_resource_dtor, + NULL, + monitor_resource_down +}; +struct monitor_resource { + ErlNifPid receiver; + int use_msgenv; +}; + +static ErlNifResourceType* frenzy_resource_type; +static void frenzy_resource_dtor(ErlNifEnv* env, void* obj); +static void frenzy_resource_down(ErlNifEnv*, void* obj, ErlNifPid*, ErlNifMonitor*); +static ErlNifResourceTypeInit frenzy_rt_init = { + frenzy_resource_dtor, + NULL, + frenzy_resource_down +}; + +static ErlNifResourceType* whereis_resource_type; +static void whereis_thread_resource_dtor(ErlNifEnv* env, void* obj); +static ErlNifResourceType* ioq_resource_type; + +static void ioq_resource_dtor(ErlNifEnv* env, void* obj); +struct ioq_resource { + ErlNifIOQueue *q; +}; + static int get_pointer(ErlNifEnv* env, ERL_NIF_TERM term, void** pp) { - ErlNifUInt64 i64; - int r = enif_get_uint64(env, term, &i64); + ErlNifBinary bin; + int r = enif_inspect_binary(env, term, &bin); if (r) { - *pp = (void*)i64; + *pp = *(void**)bin.data; } return r; } static ERL_NIF_TERM make_pointer(ErlNifEnv* env, void* p) { - ErlNifUInt64 i64 = (ErlNifUInt64) p; - return enif_make_uint64(env, i64); + void** bin_data; + ERL_NIF_TERM res; + bin_data = (void**)enif_make_new_binary(env, sizeof(void*), &res); + *bin_data = p; + return res; } - static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { PrivData* data = enif_alloc(sizeof(PrivData)); @@ -118,6 +220,8 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) data->call_history = NULL; data->nif_mod = NULL; + DBG_TRACE_INIT; + add_call(env, data, "load"); data->rt_arr[0].t = enif_open_resource_type(env,NULL,"Gold",resource_dtor, @@ -132,11 +236,49 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) msgenv_resource_type = enif_open_resource_type(env,NULL,"nif_SUITE.msgenv", msgenv_dtor, ERL_NIF_RT_CREATE, NULL); + fd_resource_type = enif_open_resource_type_x(env, "nif_SUITE.fd", + &fd_rt_init, + ERL_NIF_RT_CREATE, NULL); + monitor_resource_type = enif_open_resource_type_x(env, "nif_SUITE.monitor", + &monitor_rt_init, + ERL_NIF_RT_CREATE, NULL); + frenzy_resource_type = enif_open_resource_type_x(env, "nif_SUITE.monitor_frenzy", + &frenzy_rt_init, + ERL_NIF_RT_CREATE, NULL); + + whereis_resource_type = enif_open_resource_type(env, NULL, "nif_SUITE.whereis", + whereis_thread_resource_dtor, ERL_NIF_RT_CREATE, NULL); + + ioq_resource_type = enif_open_resource_type(env,NULL,"ioq", + ioq_resource_dtor, + ERL_NIF_RT_CREATE, NULL); + atom_false = enif_make_atom(env,"false"); + atom_true = enif_make_atom(env,"true"); 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"); + atom_second = enif_make_atom(env,"second"); + atom_millisecond = enif_make_atom(env,"millisecond"); + atom_microsecond = enif_make_atom(env,"microsecond"); + atom_nanosecond = enif_make_atom(env,"nanosecond"); + atom_eagain = enif_make_atom(env, "eagain"); + atom_eof = enif_make_atom(env, "eof"); + atom_error = enif_make_atom(env, "error"); + atom_fd_resource_stop = enif_make_atom(env, "fd_resource_stop"); + atom_monitor_resource_type = enif_make_atom(env, "monitor_resource_type"); + atom_monitor_resource_down = enif_make_atom(env, "monitor_resource_down"); + atom_init = enif_make_atom(env,"init"); + atom_stats = enif_make_atom(env,"stats"); + atom_done = enif_make_atom(env,"done"); + atom_stop = enif_make_atom(env,"stop"); + atom_null = enif_make_atom(env,"null"); + atom_pid = enif_make_atom(env, "pid"); + atom_port = enif_make_atom(env, "port"); + atom_send = enif_make_atom(env, "send"); + atom_lookup = enif_make_atom(env, "lookup"); + atom_badarg = enif_make_atom(env, "badarg"); *priv_data = data; return 0; @@ -170,14 +312,6 @@ static void resource_takeover(ErlNifEnv* env, PrivData* priv) msgenv_resource_type = rt; } -static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) -{ - 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* priv = (PrivData*) *old_priv_data; @@ -198,6 +332,7 @@ static void unload(ErlNifEnv* env, void* priv_data) } enif_free(priv_data); } + DBG_TRACE_FINI; } static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -502,6 +637,7 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ goto error; } } + ref1 = enif_make_ref(env); ref2 = enif_make_ref(env); if (!enif_is_ref(env,ref1) || !enif_is_ref(env,ref2) @@ -586,6 +722,31 @@ static ERL_NIF_TERM compare(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) return enif_make_int(env, enif_compare(argv[0],argv[1])); } +static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + if (argc != 3) { + return enif_make_badarg(env); + } + + ErlNifHash type; + if (enif_is_identical(argv[0], enif_make_atom(env, "internal"))) { + type = ERL_NIF_INTERNAL_HASH; + } + else if (enif_is_identical(argv[0], enif_make_atom(env, "phash2"))) { + type = ERL_NIF_PHASH2; + } + else { + return enif_make_badarg(env); + } + + ErlNifUInt64 salt; + if (! enif_get_uint64(env, argv[2], &salt)) { + return enif_make_badarg(env); + } + + return enif_make_uint64(env, enif_hash(type, argv[1], salt)); +} + static ERL_NIF_TERM many_args_100(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { int i, k; @@ -820,6 +981,9 @@ static ERL_NIF_TERM get_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar if (enif_is_identical(argv[0], atom_binary_resource_type)) { type.t = binary_resource_type; } + else if (enif_is_identical(argv[0], atom_monitor_resource_type)) { + type.t = monitor_resource_type; + } else { get_pointer(env, argv[0], &type.vp); } @@ -843,6 +1007,30 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER return enif_make_atom(env,"ok"); } +static void* threaded_release_resource(void* resource) +{ + enif_release_resource(resource); +} + +static ERL_NIF_TERM release_resource_from_thread(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + void* resource; + ErlNifTid tid; + int err; + + if (!get_pointer(env, argv[0], &resource)) { + return enif_make_badarg(env); + } + if (enif_thread_create("nif_SUITE:release_resource_from_thread", &tid, + threaded_release_resource, resource, NULL) != 0) { + return enif_make_badarg(env); + } + err = enif_thread_join(tid, NULL); + assert(err == 0); + return atom_ok; +} + + /* * argv[0] an atom * argv[1] a binary @@ -881,15 +1069,19 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] * * This function is separate from check_is because it calls enif_make_badarg * and so it must return the badarg exception as its return value. Thus, the - * badarg exception indicates success. Failure is indicated by returning an - * error atom. + * badarg exception indicates success. */ static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM badarg, exc_term; ERL_NIF_TERM error_atom = enif_make_atom(env, "error"); - ERL_NIF_TERM badarg = enif_make_badarg(env); - if (enif_is_exception(env, error_atom)) return error_atom; - if (!enif_is_exception(env, badarg)) return error_atom; + ERL_NIF_TERM badarg_atom = enif_make_atom(env, "badarg"); + assert(!enif_is_exception(env, error_atom)); + badarg = enif_make_badarg(env); + assert(enif_is_exception(env, badarg)); + assert(enif_has_pending_exception(env, NULL)); + assert(enif_has_pending_exception(env, &exc_term)); + assert(enif_is_identical(exc_term, badarg_atom)); return badarg; } @@ -899,6 +1091,7 @@ static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_T * argv[2] empty list * argv[3] not an atom * argv[4] not a list + * argv[5] improper list */ static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -919,6 +1112,9 @@ static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg if (enif_get_list_length(env, argv[4], &len)) return enif_make_badarg(env); + if (enif_get_list_length(env, argv[5], &len)) + return enif_make_badarg(env); + return enif_make_atom(env, "ok"); } @@ -1000,15 +1196,248 @@ static void fill(void* dst, unsigned bytes, int seed) } } +/* enif_whereis_... tests */ + +enum { + /* results */ + WHEREIS_SUCCESS, + WHEREIS_ERROR_TYPE, + WHEREIS_ERROR_LOOKUP, + WHEREIS_ERROR_SEND, + /* types */ + WHEREIS_LOOKUP_PID, /* enif_whereis_pid() */ + WHEREIS_LOOKUP_PORT /* enif_whereis_port() */ +}; + +typedef union { + ErlNifPid pid; + ErlNifPort port; +} whereis_term_data_t; + +/* single use, no cross-thread access/serialization */ +typedef struct { + ErlNifEnv* env; + ERL_NIF_TERM name; + whereis_term_data_t res; + ErlNifTid tid; + int type; +} whereis_thread_resource_t; + +static whereis_thread_resource_t* whereis_thread_resource_create(void) +{ + whereis_thread_resource_t* rp = (whereis_thread_resource_t*) + enif_alloc_resource(whereis_resource_type, sizeof(*rp)); + memset(rp, 0, sizeof(*rp)); + rp->env = enif_alloc_env(); + + return rp; +} + +static void whereis_thread_resource_dtor(ErlNifEnv* env, void* obj) +{ + whereis_thread_resource_t* rp = (whereis_thread_resource_t*) obj; + enif_free_env(rp->env); +} + +static int whereis_type(ERL_NIF_TERM type) +{ + if (enif_is_identical(type, atom_pid)) + return WHEREIS_LOOKUP_PID; + + if (enif_is_identical(type, atom_port)) + return WHEREIS_LOOKUP_PORT; + + return WHEREIS_ERROR_TYPE; +} + +static int whereis_lookup_internal( + ErlNifEnv* env, int type, ERL_NIF_TERM name, whereis_term_data_t* out) +{ + if (type == WHEREIS_LOOKUP_PID) + return enif_whereis_pid(env, name, & out->pid) + ? WHEREIS_SUCCESS : WHEREIS_ERROR_LOOKUP; + + if (type == WHEREIS_LOOKUP_PORT) + return enif_whereis_port(env, name, & out->port) + ? WHEREIS_SUCCESS : WHEREIS_ERROR_LOOKUP; + + return WHEREIS_ERROR_TYPE; +} + +static int whereis_send_internal( + ErlNifEnv* env, int type, whereis_term_data_t* to, ERL_NIF_TERM msg) +{ + if (type == WHEREIS_LOOKUP_PID) + return enif_send(env, & to->pid, NULL, msg) + ? WHEREIS_SUCCESS : WHEREIS_ERROR_SEND; + + if (type == WHEREIS_LOOKUP_PORT) + return enif_port_command(env, & to->port, NULL, msg) + ? WHEREIS_SUCCESS : WHEREIS_ERROR_SEND; + + return WHEREIS_ERROR_TYPE; +} + +static int whereis_resolved_term( + ErlNifEnv* env, int type, whereis_term_data_t* res, ERL_NIF_TERM* out) +{ + switch (type) { + case WHEREIS_LOOKUP_PID: + *out = enif_make_pid(env, & res->pid); + break; + case WHEREIS_LOOKUP_PORT: + *out = enif_make_port(env, & res->port); + break; + default: + return WHEREIS_ERROR_TYPE; + } + return WHEREIS_SUCCESS; +} + +static ERL_NIF_TERM whereis_result_term(ErlNifEnv* env, int result) +{ + ERL_NIF_TERM err; + switch (result) + { + case WHEREIS_SUCCESS: + return atom_ok; + case WHEREIS_ERROR_LOOKUP: + err = atom_lookup; + break; + case WHEREIS_ERROR_SEND: + err = atom_send; + break; + case WHEREIS_ERROR_TYPE: + err = atom_badarg; + break; + default: + err = enif_make_int(env, -result); + break; + } + return enif_make_tuple2(env, atom_error, err); +} + +static void* whereis_lookup_thread(void* arg) +{ + whereis_thread_resource_t* rp = (whereis_thread_resource_t*) arg; + int rc; + + /* enif_whereis_xxx should work with allocated or null env */ + rc = whereis_lookup_internal( + ((rp->type == WHEREIS_LOOKUP_PID) ? NULL : rp->env), + rp->type, rp->name, & rp->res); + + return (((char*) NULL) + rc); +} + +/* whereis_term(Type, Name) -> pid() | port() | false */ +static ERL_NIF_TERM +whereis_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + whereis_term_data_t res; + ERL_NIF_TERM ret; + int type, rc; + + if (argc != 2) /* allow non-atom name for testing */ + return enif_make_badarg(env); + + if ((type = whereis_type(argv[0])) == WHEREIS_ERROR_TYPE) + return enif_make_badarg(env); + + rc = whereis_lookup_internal(env, type, argv[1], & res); + if (rc == WHEREIS_SUCCESS) { + rc = whereis_resolved_term(env, type, & res, & ret); + } + return (rc == WHEREIS_SUCCESS) ? ret : atom_false; +} + +/* whereis_send(Type, Name, Message) -> ok | {error, Reason} */ +static ERL_NIF_TERM +whereis_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + whereis_term_data_t to; + int type, rc; + + if (argc != 3 || !enif_is_atom(env, argv[1])) + return enif_make_badarg(env); + + if ((type = whereis_type(argv[0])) == WHEREIS_ERROR_TYPE) + return enif_make_badarg(env); + + rc = whereis_lookup_internal(env, type, argv[1], & to); + if (rc == WHEREIS_SUCCESS) + rc = whereis_send_internal(env, type, & to, argv[2]); + + return whereis_result_term(env, rc); +} + +/* whereis_thd_lookup(Type, Name) -> {ok, Resource} | {error, SysErrno} */ +static ERL_NIF_TERM +whereis_thd_lookup(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + whereis_thread_resource_t* rp; + int type, rc; + + if (argc != 2 || !enif_is_atom(env, argv[1])) + return enif_make_badarg(env); + + if ((type = whereis_type(argv[0])) == WHEREIS_ERROR_TYPE) + return enif_make_badarg(env); + + rp = whereis_thread_resource_create(); + rp->type = type; + rp->name = enif_make_copy(rp->env, argv[1]); + + rc = enif_thread_create( + "nif_SUITE:whereis_thd", & rp->tid, whereis_lookup_thread, rp, NULL); + + if (rc == 0) { + return enif_make_tuple2(env, atom_ok, enif_make_resource(env, rp)); + } + else { + enif_release_resource(rp); + return enif_make_tuple2(env, atom_error, enif_make_int(env, rc)); + } +} + +/* whereis_thd_result(Resource) -> {ok, pid() | port()} | {error, ErrNum} */ +static ERL_NIF_TERM +whereis_thd_result(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + whereis_thread_resource_t* rp; + ERL_NIF_TERM ret; + char* thdret; /* so we can keep compilers happy converting to int */ + int rc; + + if (argc != 1 + || !enif_get_resource(env, argv[0], whereis_resource_type, (void**) & rp)) + return enif_make_badarg(env); + + if ((rc = enif_thread_join(rp->tid, (void**) & thdret)) != 0) + return enif_make_tuple2(env, atom_error, enif_make_int(env, rc)); + + rc = (int)(thdret - ((char*) NULL)); + if (rc == WHEREIS_SUCCESS) { + rc = whereis_resolved_term(env, rp->type, & rp->res, & ret); + } + ret = (rc == WHEREIS_SUCCESS) + ? enif_make_tuple2(env, atom_ok, ret) : whereis_result_term(env, rc); + + enif_release_resource(rp); + return ret; +} + #define MAKE_TERM_REUSE_LEN 16 struct make_term_info { ErlNifEnv* caller_env; ErlNifEnv* dst_env; + int dst_env_valid; ERL_NIF_TERM reuse[MAKE_TERM_REUSE_LEN]; unsigned reuse_push; unsigned reuse_pull; ErlNifResourceType* resource_type; + void *resource; ERL_NIF_TERM other_term; ERL_NIF_TERM blob; ErlNifPid to_pid; @@ -1034,6 +1463,7 @@ static ERL_NIF_TERM pull_term(struct make_term_info* mti) mti->reuse_push < MAKE_TERM_REUSE_LEN) { mti->reuse_pull = 0; if (mti->reuse_push == 0) { + assert(mti->dst_env_valid); mti->reuse[0] = enif_make_list(mti->dst_env, 0); } } @@ -1087,10 +1517,6 @@ 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; @@ -1120,12 +1546,7 @@ static ERL_NIF_TERM make_term_list0(struct make_term_info* mti, int n) } static ERL_NIF_TERM make_term_resource(struct make_term_info* mti, int n) { - void* resource = enif_alloc_resource(mti->resource_type, 10); - ERL_NIF_TERM term; - fill(resource, 10, n); - term = enif_make_resource(mti->dst_env, resource); - enif_release_resource(resource); - return term; + return enif_make_resource(mti->dst_env, mti->resource); } static ERL_NIF_TERM make_term_new_binary(struct make_term_info* mti, int n) { @@ -1198,7 +1619,6 @@ static Make_term_Func* make_funcs[] = { make_term_atom, make_term_existing_atom, make_term_string, - //make_term_ref, make_term_sub_binary, make_term_uint, make_term_long, @@ -1222,6 +1642,7 @@ static unsigned num_of_make_funcs() static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res) { if (n < num_of_make_funcs()) { + assert(mti->dst_env_valid); *res = make_funcs[n](mti, n); push_term(mti, *res); return 1; @@ -1229,22 +1650,39 @@ static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res) return 0; } -static ERL_NIF_TERM make_blob(ErlNifEnv* caller_env, ErlNifEnv* dst_env, - ERL_NIF_TERM other_term) + +static void +init_make_blob(struct make_term_info *mti, + ErlNifEnv* caller_env, + ERL_NIF_TERM other_term) { PrivData* priv = (PrivData*) enif_priv_data(caller_env); + mti->caller_env = caller_env; + mti->resource_type = priv->rt_arr[0].t; + mti->resource = enif_alloc_resource(mti->resource_type, 10); + fill(mti->resource, 10, 17); + mti->other_term = other_term; +} + +static void +fini_make_blob(struct make_term_info *mti) +{ + enif_release_resource(mti->resource); +} + +static ERL_NIF_TERM make_blob(struct make_term_info *mti, + ErlNifEnv* dst_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; + + mti->reuse_push = 0; + mti->reuse_pull = 0; + mti->dst_env = dst_env; + mti->dst_env_valid = 1; list = enif_make_list(dst_env, 0); - while (make_term_n(&mti, n++, &term)) { + while (make_term_n(mti, n++, &term)) { list = enif_make_list_cell(dst_env, term, list); } return list; @@ -1256,13 +1694,16 @@ static ERL_NIF_TERM send_new_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM a ERL_NIF_TERM msg, copy; ErlNifEnv* msg_env; int res; + struct make_term_info mti; 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]); + init_make_blob(&mti, env, argv[1]); + msg = make_blob(&mti,msg_env); + copy = make_blob(&mti,env); + fini_make_blob(&mti); 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); @@ -1278,9 +1719,12 @@ static ERL_NIF_TERM alloc_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar sizeof(*mti)); mti->caller_env = NULL; mti->dst_env = enif_alloc_env(); + mti->dst_env_valid = 1; mti->reuse_push = 0; mti->reuse_pull = 0; mti->resource_type = priv->rt_arr[0].t; + mti->resource = enif_alloc_resource(mti->resource_type, 10); + fill(mti->resource, 10, 17); 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"); @@ -1298,6 +1742,7 @@ static void msgenv_dtor(ErlNifEnv* env, void* obj) if (mti->dst_env != NULL) { enif_free_env(mti->dst_env); } + enif_release_resource(mti->resource); enif_mutex_destroy(mti->mtx); enif_cond_destroy(mti->cond); } @@ -1309,6 +1754,7 @@ static ERL_NIF_TERM clear_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return enif_make_badarg(env); } enif_clear_env(mti.p->dst_env); + mti.p->dst_env_valid = 1; mti.p->reuse_pull = 0; mti.p->reuse_push = 0; mti.p->blob = enif_make_list(mti.p->dst_env, 0); @@ -1343,6 +1789,8 @@ static ERL_NIF_TERM send_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ } copy = enif_make_copy(env, mti.p->blob); res = enif_send(env, &to, mti.p->dst_env, mti.p->blob); + if (res) + mti.p->dst_env_valid = 0; return enif_make_tuple3(env, atom_ok, enif_make_int(env,res), copy); } @@ -1350,7 +1798,6 @@ static ERL_NIF_TERM send3_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv { mti_t 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)) { @@ -1360,6 +1807,8 @@ static ERL_NIF_TERM send3_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv enif_make_copy(mti.p->dst_env, argv[2]), mti.p->blob); res = enif_send(env, &to, mti.p->dst_env, mti.p->blob); + if (res) + mti.p->dst_env_valid = 0; return enif_make_int(env,res); } @@ -1376,6 +1825,8 @@ void* threaded_sender(void *arg) 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); + if (mti.p->send_res) + mti.p->dst_env_valid = 0; return NULL; } @@ -1445,6 +1896,17 @@ static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ return enif_make_int(env, ret); } +static ERL_NIF_TERM send_copy_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid pid; + int ret; + if (!enif_get_local_pid(env, argv[0], &pid)) { + return enif_make_badarg(env); + } + ret = enif_send(env, &pid, NULL, argv[1]); + return enif_make_int(env, ret); +} + static ERL_NIF_TERM reverse_list(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ERL_NIF_TERM rev_list; @@ -1473,6 +1935,26 @@ static ERL_NIF_TERM otp_9668_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return atom_ok; } +static ERL_NIF_TERM otp_9828_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + /* copy a writable binary could reallocate it due to "emasculation" + and thereby render a previous inspection invalid. + */ + ErlNifBinary bin1; + ErlNifEnv* myenv; + + if (!enif_inspect_binary(env, argv[0], &bin1)) { + return enif_make_badarg(env); + } + + myenv = enif_alloc_env(); + enif_make_copy(myenv, argv[0]); + enif_free_env(myenv); + + return memcmp(bin1.data, "I'm alive!", 10)==0 ? atom_ok : atom_false; +} + + static ERL_NIF_TERM consume_timeslice_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { int percent; @@ -1493,78 +1975,127 @@ static ERL_NIF_TERM consume_timeslice_nif(ErlNifEnv* env, int argc, const ERL_NI } } -#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT -static ERL_NIF_TERM dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM nif_sched2(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - int n; - char s[10]; - ErlNifBinary b; - ERL_NIF_TERM result; - if (enif_have_dirty_schedulers()) { - assert(enif_is_on_dirty_scheduler(env)); - } - assert(argc == 3); - enif_get_int(env, argv[0], &n); - enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1); - enif_inspect_binary(env, argv[2], &b); - result = enif_make_tuple3(env, - enif_make_int(env, n), - enif_make_string(env, s, ERL_NIF_LATIN1), - enif_make_binary(env, &b)); - return enif_schedule_dirty_nif_finalizer(env, result, enif_dirty_nif_finalizer); + char s[64]; + if (!enif_get_string(env, argv[2], s, sizeof s, ERL_NIF_LATIN1)) + return enif_make_badarg(env); + return enif_make_tuple2(env, argv[3], argv[2]); } -static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM nif_sched1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - int n; - char s[10]; - ErlNifBinary b; - assert(!enif_is_on_dirty_scheduler(env)); - if (argc != 3) - return enif_make_badarg(env); - if (enif_have_dirty_schedulers()) { - if (enif_get_int(env, argv[0], &n) && - enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1) && - enif_inspect_binary(env, argv[2], &b)) - return enif_schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_nif, argc, argv); - else - return enif_make_badarg(env); + ERL_NIF_TERM new_argv[4]; + new_argv[0] = enif_make_atom(env, "garbage0"); + new_argv[1] = enif_make_atom(env, "garbage1"); + new_argv[2] = argv[0]; + new_argv[3] = argv[1]; + return enif_schedule_nif(env, "nif_sched2", 0, nif_sched2, 4, new_argv); +} + +static ERL_NIF_TERM call_nif_schedule(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM result; + if (argc != 2) + return enif_make_atom(env, "false"); + result = enif_schedule_nif(env, "nif_sched1", 0, nif_sched1, argc, argv); + assert(!enif_is_exception(env, result)); + return result; +} + +/* + * If argv[0] is the integer 0, call enif_make_badarg, but don't return its + * return value. Instead, return ok. Result should still be a badarg + * exception for the erlang caller. + * + * For any other value of argv[0], use it as an exception term and return + * the exception. + */ +static ERL_NIF_TERM call_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM exc_term; + ERL_NIF_TERM badarg_atom = enif_make_atom(env, "badarg"); + int arg; + + if (enif_get_int(env, argv[0], &arg) && arg == 0) { + /* ignore return value */ enif_make_badarg(env); + assert(enif_has_pending_exception(env, NULL)); + assert(enif_has_pending_exception(env, &exc_term)); + assert(enif_is_identical(badarg_atom, exc_term)); + return enif_make_atom(env, "ok"); } else { - return dirty_nif(env, argc, argv); + ERL_NIF_TERM exc_retval = enif_raise_exception(env, argv[0]); + assert(enif_has_pending_exception(env, NULL)); + assert(enif_has_pending_exception(env, &exc_term)); + assert(enif_is_identical(argv[0], exc_term)); + return exc_retval; } } -static ERL_NIF_TERM dirty_sender(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +#if !defined(NAN) || !defined(INFINITY) +double zero(void) { - ERL_NIF_TERM result; - ErlNifPid pid; - ErlNifEnv* menv; - int res; + return 0.0; +} +#endif - enif_get_local_pid(env, argv[0], &pid); - result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid)); - menv = enif_alloc_env(); - res = enif_send(env, &pid, menv, result); - enif_free_env(menv); - if (!res) - /* Note the next line will crash, since dirty nifs can't return exceptions. - * This is intentional, since enif_send should not fail if the test succeeds. - */ - return enif_schedule_dirty_nif_finalizer(env, enif_make_badarg(env), enif_dirty_nif_finalizer); - else - return enif_schedule_dirty_nif_finalizer(env, result, enif_dirty_nif_finalizer); +static ERL_NIF_TERM call_nif_nan_or_inf(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + double val; + char arg[6]; + ERL_NIF_TERM res; + + assert(argc == 1); + enif_get_atom(env, argv[0], arg, sizeof arg, ERL_NIF_LATIN1); + if (strcmp(arg, "nan") == 0) { + /* Verify that enif_make_double raises a badarg for NaN */ +#ifdef NAN + val = NAN; +#else + val = 0.0/zero(); +#endif + } else { + /* Verify that enif_make_double raises a badarg for NaN and infinity */ +#ifdef INFINITY + val = INFINITY; +#else + val = 1.0/zero(); +#endif + } + res = enif_make_double(env, val); + assert(enif_is_exception(env, res)); + assert(enif_has_pending_exception(env, NULL)); + if (strcmp(arg, "tuple") == 0) { + return enif_make_tuple2(env, argv[0], res); + } else { + return res; + } } -static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM call_nif_atom_too_long(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - ERL_NIF_TERM result; - ErlNifPid pid; + char str[257]; + char arg[4]; + size_t len; + int i; + ERL_NIF_TERM res; - if (!enif_get_local_pid(env, argv[0], &pid)) - return enif_make_badarg(env); - return enif_schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_sender, argc, argv); + assert(argc == 1); + enif_get_atom(env, argv[0], arg, sizeof arg, ERL_NIF_LATIN1); + /* Verify that creating an atom from a string that's too long results in a badarg */ + for (i = 0; i < sizeof str; ++i) { + str[i] = 'a'; + } + str[256] = '\0'; + if (strcmp(arg, "len") == 0) { + len = strlen(str); + res = enif_make_atom_len(env, str, len); + } else { + res = enif_make_atom(env, str); + } + assert(enif_is_exception(env, res)); + return res; } -#endif static ERL_NIF_TERM is_map_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -1642,12 +2173,13 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER if (argc != 1 && !enif_is_map(env, map)) return enif_make_int(env, __LINE__); - if(!enif_map_iterator_create(env, map, &iter_f, ERL_NIF_MAP_ITERATOR_HEAD)) + if(!enif_map_iterator_create(env, map, &iter_f, ERL_NIF_MAP_ITERATOR_FIRST)) return enif_make_int(env, __LINE__); cnt = 0; + next_ret = 1; while(enif_map_iterator_get_pair(env,&iter_f,&key,&value)) { - if (cnt && !next_ret) + if (!next_ret) return enif_make_int(env, __LINE__); list_f = enif_make_list_cell(env, enif_make_tuple2(env, key, value), list_f); next_ret = enif_map_iterator_next(env,&iter_f); @@ -1656,12 +2188,13 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER if (cnt && next_ret) return enif_make_int(env, __LINE__); - if(!enif_map_iterator_create(env, map, &iter_b, ERL_NIF_MAP_ITERATOR_TAIL)) + if(!enif_map_iterator_create(env, map, &iter_b, ERL_NIF_MAP_ITERATOR_LAST)) return enif_make_int(env, __LINE__); cnt = 0; + prev_ret = 1; while(enif_map_iterator_get_pair(env,&iter_b,&key,&value)) { - if (cnt && !prev_ret) + if (!prev_ret) return enif_make_int(env, __LINE__); /* Test that iter_f can step "backwards" */ @@ -1673,6 +2206,7 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER list_b = enif_make_list_cell(env, enif_make_tuple2(env, key, value), list_b); prev_ret = enif_map_iterator_prev(env,&iter_b); + cnt++; } if (cnt) { @@ -1692,6 +2226,1221 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER return enif_make_tuple2(env, list_f, list_b); } + +static ERL_NIF_TERM monotonic_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifTimeUnit time_unit; + + if (argc != 1) + return atom_false; + + if (enif_compare(argv[0], atom_second) == 0) + time_unit = ERL_NIF_SEC; + else if (enif_compare(argv[0], atom_millisecond) == 0) + time_unit = ERL_NIF_MSEC; + else if (enif_compare(argv[0], atom_microsecond) == 0) + time_unit = ERL_NIF_USEC; + else if (enif_compare(argv[0], atom_nanosecond) == 0) + time_unit = ERL_NIF_NSEC; + else + time_unit = 4711; /* invalid time unit */ + + return enif_make_int64(env, enif_monotonic_time(time_unit)); +} + +static ERL_NIF_TERM time_offset(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifTimeUnit time_unit; + + if (argc != 1) + return atom_false; + + if (enif_compare(argv[0], atom_second) == 0) + time_unit = ERL_NIF_SEC; + else if (enif_compare(argv[0], atom_millisecond) == 0) + time_unit = ERL_NIF_MSEC; + else if (enif_compare(argv[0], atom_microsecond) == 0) + time_unit = ERL_NIF_USEC; + else if (enif_compare(argv[0], atom_nanosecond) == 0) + time_unit = ERL_NIF_NSEC; + else + time_unit = 4711; /* invalid time unit */ + return enif_make_int64(env, enif_time_offset(time_unit)); +} + +static ERL_NIF_TERM convert_time_unit(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifSInt64 i64; + ErlNifTime val; + ErlNifTimeUnit from, to; + + if (argc != 3) + return atom_false; + + if (!enif_get_int64(env, argv[0], &i64)) + return enif_make_badarg(env); + + val = (ErlNifTime) i64; + + if (enif_compare(argv[1], atom_second) == 0) + from = ERL_NIF_SEC; + else if (enif_compare(argv[1], atom_millisecond) == 0) + from = ERL_NIF_MSEC; + else if (enif_compare(argv[1], atom_microsecond) == 0) + from = ERL_NIF_USEC; + else if (enif_compare(argv[1], atom_nanosecond) == 0) + from = ERL_NIF_NSEC; + else + from = 4711; /* invalid time unit */ + + if (enif_compare(argv[2], atom_second) == 0) + to = ERL_NIF_SEC; + else if (enif_compare(argv[2], atom_millisecond) == 0) + to = ERL_NIF_MSEC; + else if (enif_compare(argv[2], atom_microsecond) == 0) + to = ERL_NIF_USEC; + else if (enif_compare(argv[2], atom_nanosecond) == 0) + to = ERL_NIF_NSEC; + else + to = 4711; /* invalid time unit */ + + return enif_make_int64(env, enif_convert_time_unit(val, from, to)); +} + +static ERL_NIF_TERM now_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_now_time(env); +} + +static ERL_NIF_TERM cpu_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_cpu_time(env); +} + +static ERL_NIF_TERM unique_integer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM atom_pos = enif_make_atom(env,"positive"), + atom_mon = enif_make_atom(env,"monotonic"); + ERL_NIF_TERM opts = argv[0], opt; + ErlNifUniqueInteger properties = 0; + + while (!enif_is_empty_list(env, opts)) { + if (!enif_get_list_cell(env, opts, &opt, &opts)) + return enif_make_badarg(env); + + if (enif_compare(opt, atom_pos) == 0) + properties |= ERL_NIF_UNIQUE_POSITIVE; + if (enif_compare(opt, atom_mon) == 0) + properties |= ERL_NIF_UNIQUE_MONOTONIC; + } + + return enif_make_unique_integer(env, properties); +} + +static ERL_NIF_TERM is_process_alive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid pid; + if (!enif_get_local_pid(env, argv[0], &pid)) + return enif_make_badarg(env); + if (enif_is_process_alive(env, &pid)) + return atom_true; + return atom_false; +} + +static ERL_NIF_TERM is_port_alive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPort port; + if (!enif_get_local_port(env, argv[0], &port)) + return enif_make_badarg(env); + if (enif_is_port_alive(env, &port)) + return atom_true; + return atom_false; +} + +static ERL_NIF_TERM term_to_binary(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifBinary bin; + ErlNifPid pid; + ErlNifEnv *msg_env = env; + ERL_NIF_TERM term; + + if (enif_get_local_pid(env, argv[1], &pid)) + msg_env = enif_alloc_env(); + + if (!enif_term_to_binary(msg_env, argv[0], &bin)) + return enif_make_badarg(env); + + term = enif_make_binary(msg_env, &bin); + + if (msg_env != env) { + enif_send(env, &pid, msg_env, term); + enif_free_env(msg_env); + return atom_true; + } else { + return term; + } +} + +static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifBinary bin; + ERL_NIF_TERM term, ret_term; + ErlNifPid pid; + ErlNifEnv *msg_env = env; + unsigned int opts; + ErlNifUInt64 ret; + + if (enif_get_local_pid(env, argv[1], &pid)) + msg_env = enif_alloc_env(); + + if (!enif_inspect_binary(env, argv[0], &bin) + || !enif_get_uint(env, argv[2], &opts)) + return enif_make_badarg(env); + + ret = enif_binary_to_term(msg_env, bin.data, bin.size, &term, + (ErlNifBinaryToTerm)opts); + if (!ret) + return atom_false; + + ret_term = enif_make_uint64(env, ret); + if (msg_env != env) { + enif_send(env, &pid, msg_env, term); + enif_free_env(msg_env); + return ret_term; + } else { + return enif_make_tuple2(env, ret_term, term); + } +} + +static ERL_NIF_TERM port_command(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPort port; + + if (!enif_get_local_port(env, argv[0], &port)) + return enif_make_badarg(env); + + if (!enif_port_command(env, &port, NULL, argv[1])) + return enif_make_badarg(env); + return atom_true; +} + +static ERL_NIF_TERM format_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifBinary obin; + unsigned int size; + + if (!enif_get_uint(env, argv[0], &size)) + return enif_make_badarg(env); + if (!enif_alloc_binary(size,&obin)) + return enif_make_badarg(env); + + if (enif_snprintf((char*)obin.data, (size_t)size, "%T", argv[1]) < 0) + return atom_false; + + return enif_make_binary(env,&obin); +} + +static int get_fd(ErlNifEnv* env, ERL_NIF_TERM term, struct fd_resource** rsrc) +{ + if (!enif_get_resource(env, term, fd_resource_type, (void**)rsrc)) { + return 0; + } + return 1; +} + +/* Returns: badarg + * Or an enif_select result, which is a combination of bits: + * ERL_NIF_SELECT_STOP_CALLED = 1 + * ERL_NIF_SELECT_STOP_SCHEDULED = 2 + * ERL_NIF_SELECT_INVALID_EVENT = 4 + * ERL_NIF_SELECT_FAILED = 8 + */ +static ERL_NIF_TERM select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct fd_resource* fdr; + enum ErlNifSelectFlags mode; + void* obj; + ErlNifPid nifpid, *pid = NULL; + ERL_NIF_TERM ref; + int retval; + + if (!get_fd(env, argv[0], &fdr) + || !enif_get_uint(env, argv[1], (unsigned int*)&mode) + || !enif_get_resource(env, argv[2], fd_resource_type, &obj)) + { + return enif_make_badarg(env); + } + + if (argv[3] != atom_null) { + if (!enif_get_local_pid(env, argv[3], &nifpid)) + return enif_make_badarg(env); + pid = &nifpid; + } + ref = argv[4]; + + fdr->was_selected = 1; + enif_self(env, &fdr->pid); + retval = enif_select(env, fdr->fd, mode, obj, pid, ref); + + return enif_make_int(env, retval); +} + +#ifndef __WIN32__ +/* + * Create a read-write pipe with two fds (to read and to write) + */ +static ERL_NIF_TERM pipe_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct fd_resource* read_rsrc; + struct fd_resource* write_rsrc; + ERL_NIF_TERM read_fd, write_fd; + int fds[2], flags; + + if (pipe(fds) < 0) + return enif_make_string(env, "pipe failed", ERL_NIF_LATIN1); + + if ((flags = fcntl(fds[0], F_GETFL, 0)) < 0 + || fcntl(fds[0], F_SETFL, flags|O_NONBLOCK) < 0 + || (flags = fcntl(fds[1], F_GETFL, 0)) < 0 + || fcntl(fds[1], F_SETFL, flags|O_NONBLOCK) < 0) { + close(fds[0]); + close(fds[1]); + return enif_make_string(env, "fcntl failed on pipe", ERL_NIF_LATIN1); + } + + read_rsrc = enif_alloc_resource(fd_resource_type, sizeof(struct fd_resource)); + write_rsrc = enif_alloc_resource(fd_resource_type, sizeof(struct fd_resource)); + read_rsrc->fd = fds[0]; + read_rsrc->was_selected = 0; + write_rsrc->fd = fds[1]; + write_rsrc->was_selected = 0; + read_fd = enif_make_resource(env, read_rsrc); + write_fd = enif_make_resource(env, write_rsrc); + enif_release_resource(read_rsrc); + enif_release_resource(write_rsrc); + + return enif_make_tuple2(env, + enif_make_tuple2(env, read_fd, make_pointer(env, read_rsrc)), + enif_make_tuple2(env, write_fd, make_pointer(env, write_rsrc))); +} + +/* + * Create (dupe) of a resource with the same fd, to test stealing + */ +static ERL_NIF_TERM dupe_resource_nif(ErlNifEnv* env, int argc, + const ERL_NIF_TERM argv[]) { + struct fd_resource* orig_rsrc; + + if (!get_fd(env, argv[0], &orig_rsrc)) { + return enif_make_badarg(env); + } else { + struct fd_resource* new_rsrc; + ERL_NIF_TERM new_fd; + + new_rsrc = enif_alloc_resource(fd_resource_type, + sizeof(struct fd_resource)); + new_rsrc->fd = orig_rsrc->fd; + new_rsrc->was_selected = 0; + new_fd = enif_make_resource(env, new_rsrc); + enif_release_resource(new_rsrc); + + return enif_make_tuple2(env, new_fd, make_pointer(env, new_rsrc)); + } +} + +static ERL_NIF_TERM write_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct fd_resource* fdr; + ErlNifBinary bin; + int n, written = 0; + + if (!get_fd(env, argv[0], &fdr) + || !enif_inspect_binary(env, argv[1], &bin)) + return enif_make_badarg(env); + + for (;;) { + n = write(fdr->fd, bin.data + written, bin.size - written); + if (n >= 0) { + written += n; + if (written == bin.size) { + return atom_ok; + } + } + else if (errno == EAGAIN) { + return enif_make_tuple2(env, atom_eagain, enif_make_int(env, written)); + } + else if (errno == EINTR) { + continue; + } + else { + return enif_make_tuple2(env, atom_error, enif_make_int(env, errno)); + } + } +} + +static ERL_NIF_TERM read_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct fd_resource* fdr; + unsigned char* buf; + int n, count; + ERL_NIF_TERM res; + + if (!get_fd(env, argv[0], &fdr) + || !enif_get_int(env, argv[1], &count) || count < 1) + return enif_make_badarg(env); + + buf = enif_make_new_binary(env, count, &res); + + for (;;) { + n = read(fdr->fd, buf, count); + if (n > 0) { + if (n < count) { + res = enif_make_sub_binary(env, res, 0, n); + } + return res; + } + else if (n == 0) { + return atom_eof; + } + else if (errno == EAGAIN) { + return atom_eagain; + } + else if (errno == EINTR) { + continue; + } + else { + return enif_make_tuple2(env, atom_error, enif_make_int(env, errno)); + } + } +} + +static ERL_NIF_TERM is_closed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct fd_resource* fdr; + + if (!get_fd(env, argv[0], &fdr)) + return enif_make_badarg(env); + + return fdr->fd < 0 ? atom_true : atom_false; +} + +static ERL_NIF_TERM clear_select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct fd_resource* fdr = NULL; + + if (!get_fd(env, argv[0], &fdr)) + return enif_make_badarg(env); + + fdr->fd = -1; + fdr->was_selected = 0; + + return atom_ok; +} + +#endif /* !__WIN32__ */ + + +static void fd_resource_dtor(ErlNifEnv* env, void* obj) +{ + struct fd_resource* fdr = (struct fd_resource*)obj; + resource_dtor(env, obj); +#ifdef __WIN32__ + abort(); +#else + if (fdr->fd >= 0) { + assert(!fdr->was_selected); + close(fdr->fd); + } +#endif +} + +static struct { + void* obj; + int was_direct_call; +}last_fd_stop; +int fd_stop_cnt = 0; + +static void fd_resource_stop(ErlNifEnv* env, void* obj, ErlNifEvent fd, + int is_direct_call) +{ + struct fd_resource* fdr = (struct fd_resource*)obj; + assert(fd == fdr->fd); + assert(fd >= 0); + + last_fd_stop.obj = obj; + last_fd_stop.was_direct_call = is_direct_call; + fd_stop_cnt++; + + close(fd); + fdr->fd = -1; /* thread safety ? */ + fdr->was_selected = 0; + + { + ErlNifEnv* msg_env = enif_alloc_env(); + ERL_NIF_TERM msg; + msg = enif_make_tuple3(msg_env, + atom_fd_resource_stop, + make_pointer(msg_env, obj), + enif_make_int(msg_env, is_direct_call)); + + enif_send(env, &fdr->pid, msg_env, msg); + enif_free_env(msg_env); + } +} + +static ERL_NIF_TERM last_fd_stop_call(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM last, ret; + last = enif_make_tuple2(env, make_pointer(env, last_fd_stop.obj), + enif_make_int(env, last_fd_stop.was_direct_call)); + ret = enif_make_tuple2(env, enif_make_int(env, fd_stop_cnt), last); + fd_stop_cnt = 0; + return ret; +} + + +static void monitor_resource_dtor(ErlNifEnv* env, void* obj) +{ + resource_dtor(env, obj); +} + +static ERL_NIF_TERM make_monitor(ErlNifEnv* env, const ErlNifMonitor* mon) +{ + ERL_NIF_TERM mon_bin; + memcpy(enif_make_new_binary(env, sizeof(ErlNifMonitor), &mon_bin), + mon, sizeof(ErlNifMonitor)); + return mon_bin; +} + +static int get_monitor(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifMonitor* mon) +{ + ErlNifBinary bin; + if (!enif_inspect_binary(env, term, &bin) + || bin.size != sizeof(ErlNifMonitor)) + return 0; + memcpy(mon, bin.data, bin.size); + return 1; +} + +static void monitor_resource_down(ErlNifEnv* env, void* obj, ErlNifPid* pid, + ErlNifMonitor* mon) +{ + struct monitor_resource* rsrc = (struct monitor_resource*)obj; + ErlNifEnv* build_env; + ErlNifEnv* msg_env; + ERL_NIF_TERM msg; + + if (rsrc->use_msgenv) { + msg_env = enif_alloc_env(); + build_env = msg_env; + } + else { + msg_env = NULL; + build_env = env; + } + + msg = enif_make_tuple4(build_env, + atom_monitor_resource_down, + make_pointer(build_env, obj), + enif_make_pid(build_env, pid), + make_monitor(build_env, mon)); + + enif_send(env, &rsrc->receiver, msg_env, msg); + if (msg_env) + enif_free_env(msg_env); +} + +static ERL_NIF_TERM alloc_monitor_resource_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct monitor_resource* rsrc; + + rsrc = enif_alloc_resource(monitor_resource_type, sizeof(struct monitor_resource)); + + return make_pointer(env,rsrc); +} + +static ERL_NIF_TERM monitor_process_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct monitor_resource* rsrc; + ErlNifPid target; + ErlNifMonitor mon; + int res; + + if (!get_pointer(env, argv[0], (void**)&rsrc) + || !enif_get_local_pid(env, argv[1], &target) + || !enif_get_local_pid(env, argv[3], &rsrc->receiver)) { + return enif_make_badarg(env); + } + + rsrc->use_msgenv = (argv[2] == atom_true); + res = enif_monitor_process(env, rsrc, &target, &mon); + + return enif_make_tuple2(env, enif_make_int(env, res), make_monitor(env, &mon)); +} + +static ERL_NIF_TERM demonitor_process_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct monitor_resource* rsrc; + ErlNifMonitor mon; + int res; + + if (!get_pointer(env, argv[0], (void**)&rsrc) + || !get_monitor(env, argv[1], &mon)) { + return enif_make_badarg(env); + } + + res = enif_demonitor_process(env, rsrc, &mon); + + return enif_make_int(env, res); +} + +static ERL_NIF_TERM compare_monitors_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifMonitor m1, m2; + if (!get_monitor(env, argv[0], &m1) + || !get_monitor(env, argv[1], &m2)) { + return enif_make_badarg(env); + } + + return enif_make_int(env, enif_compare_monitors(&m1, &m2)); +} + + +/*********** monitor_frenzy ************/ + +struct frenzy_rand_bits +{ + unsigned int source; + unsigned int bits_consumed; +}; + +static unsigned int frenzy_rand_bits_max; + +unsigned rand_bits(struct frenzy_rand_bits* rnd, unsigned int nbits) +{ + unsigned int res; + + rnd->bits_consumed += nbits; + assert(rnd->bits_consumed <= frenzy_rand_bits_max); + res = rnd->source & ((1 << nbits)-1); + rnd->source >>= nbits; + return res; +} + +#define FRENZY_PROCS_MAX_BITS 4 +#define FRENZY_PROCS_MAX (1 << FRENZY_PROCS_MAX_BITS) + +#define FRENZY_RESOURCES_MAX_BITS 4 +#define FRENZY_RESOURCES_MAX (1 << FRENZY_RESOURCES_MAX_BITS) + +#define FRENZY_MONITORS_MAX_BITS 4 +#define FRENZY_MONITORS_MAX (1 << FRENZY_MONITORS_MAX_BITS) + +struct frenzy_monitor { + ErlNifMutex* lock; + enum { + MON_FREE, MON_FREE_DOWN, MON_FREE_DEMONITOR, + MON_TRYING, MON_ACTIVE, MON_PENDING + } state; + ErlNifMonitor mon; + ErlNifPid pid; + unsigned int use_cnt; +}; + +struct frenzy_resource { + unsigned int rix; + struct frenzy_monitor monv[FRENZY_MONITORS_MAX]; +}; +struct frenzy_reslot { + ErlNifMutex* lock; + int stopped; + struct frenzy_resource* obj; + unsigned long alloc_cnt; + unsigned long release_cnt; + unsigned long dtor_cnt; +}; +static struct frenzy_reslot resv[FRENZY_RESOURCES_MAX]; + +static ERL_NIF_TERM monitor_frenzy_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct frenzy_proc { + ErlNifPid pid; + int is_free; + }; + static struct frenzy_proc procs[FRENZY_PROCS_MAX]; + static struct frenzy_proc* proc_refs[FRENZY_PROCS_MAX]; + static unsigned int nprocs, old_nprocs; + static ErlNifMutex* procs_lock; + static unsigned long spawn_cnt = 0; + static unsigned long kill_cnt = 0; + static unsigned long proc_histogram[FRENZY_PROCS_MAX]; + static int initialized = 0; + + static const unsigned int primes[] = {7, 13, 17, 19}; + + struct frenzy_resource* r; + struct frenzy_rand_bits rnd; + unsigned int op, inc, my_nprocs; + unsigned int mix; /* r->monv[] index */ + unsigned int rix; /* resv[] index */ + unsigned int pix; /* procs[] index */ + unsigned int ref_ix; /* proc_refs[] index */ + int self_pix, rv; + ERL_NIF_TERM retval = atom_error; + const ERL_NIF_TERM Op = argv[0]; + const ERL_NIF_TERM Rnd = argv[1]; + const ERL_NIF_TERM SelfPix = argv[2]; + const ERL_NIF_TERM NewPid = argv[3]; + + if (enif_is_atom(env, Op)) { + if (Op == atom_init) { + if (initialized || !enif_get_uint(env, Rnd, &frenzy_rand_bits_max)) + return enif_make_badarg(env); + + procs_lock = enif_mutex_create("nif_SUITE:monitor_frenzy.procs"); + nprocs = 0; + old_nprocs = 0; + for (pix = 0; pix < FRENZY_PROCS_MAX; pix++) { + proc_refs[pix] = &procs[pix]; + procs[pix].is_free = 1; + proc_histogram[pix] = 0; + } + for (rix = 0; rix < FRENZY_RESOURCES_MAX; rix++) { + resv[rix].lock = enif_mutex_create("nif_SUITE:monitor_frenzy.resv.lock"); + resv[rix].obj = NULL; + resv[rix].stopped = 0; + resv[rix].alloc_cnt = 0; + resv[rix].release_cnt = 0; + resv[rix].dtor_cnt = 0; + } + + /* Add self as first process */ + enif_self(env, &procs[0].pid); + procs[0].is_free = 0; + old_nprocs = ++nprocs; + + spawn_cnt = 1; + kill_cnt = 0; + initialized = 1; + return enif_make_uint(env, 0); /* SelfPix */ + } + else if (Op == atom_stats) { + ERL_NIF_TERM hist[FRENZY_PROCS_MAX]; + unsigned long res_alloc_cnt = 0; + unsigned long res_release_cnt = 0; + unsigned long res_dtor_cnt = 0; + for (ref_ix = 0; ref_ix < FRENZY_PROCS_MAX; ref_ix++) { + hist[ref_ix] = enif_make_ulong(env, proc_histogram[ref_ix]); + } + for (rix = 0; rix < FRENZY_RESOURCES_MAX; rix++) { + res_alloc_cnt += resv[rix].alloc_cnt; + res_release_cnt += resv[rix].release_cnt; + res_dtor_cnt += resv[rix].dtor_cnt; + } + + return + enif_make_list4(env, + enif_make_tuple2(env, enif_make_string(env, "proc_histogram", ERL_NIF_LATIN1), + enif_make_list_from_array(env, hist, FRENZY_PROCS_MAX)), + enif_make_tuple2(env, enif_make_string(env, "spawn_cnt", ERL_NIF_LATIN1), + enif_make_ulong(env, spawn_cnt)), + enif_make_tuple2(env, enif_make_string(env, "kill_cnt", ERL_NIF_LATIN1), + enif_make_ulong(env, kill_cnt)), + enif_make_tuple4(env, enif_make_string(env, "resource_alloc", ERL_NIF_LATIN1), + enif_make_ulong(env, res_alloc_cnt), + enif_make_ulong(env, res_release_cnt), + enif_make_ulong(env, res_dtor_cnt))); + + } + else if (Op == atom_stop && initialized) { /* stop all */ + + /* Release all resources */ + for (rix = 0; rix < FRENZY_RESOURCES_MAX; rix++) { + enif_mutex_lock(resv[rix].lock); + r = resv[rix].obj; + if (r) { + resv[rix].obj = NULL; + resv[rix].release_cnt++; + } + resv[rix].stopped = 1; + enif_mutex_unlock(resv[rix].lock); + if (r) + enif_release_resource(r); + } + + /* Remove and return all pids */ + retval = enif_make_list(env, 0); + enif_mutex_lock(procs_lock); + for (ref_ix = 0; ref_ix < nprocs; ref_ix++) { + assert(!proc_refs[ref_ix]->is_free); + retval = enif_make_list_cell(env, enif_make_pid(env, &proc_refs[ref_ix]->pid), + retval); + proc_refs[ref_ix]->is_free = 1; + } + kill_cnt += nprocs; + nprocs = 0; + old_nprocs = 0; + enif_mutex_unlock(procs_lock); + + return retval; + } + return enif_make_badarg(env); + } + + if (!enif_get_int(env, SelfPix, &self_pix) || + !enif_get_uint(env, Op, &op) || + !enif_get_uint(env, Rnd, &rnd.source)) + return enif_make_badarg(env); + + rnd.bits_consumed = 0; + switch (op) { + case 0: { /* add/remove process */ + ErlNifPid self; + enif_self(env, &self); + + ref_ix = rand_bits(&rnd, FRENZY_PROCS_MAX_BITS) % FRENZY_PROCS_MAX; + enif_mutex_lock(procs_lock); + if (procs[self_pix].is_free || procs[self_pix].pid.pid != self.pid) { + /* Some one already removed me */ + enif_mutex_unlock(procs_lock); + return atom_done; + } + if (ref_ix >= nprocs || nprocs < 2) { /* add process */ + ref_ix = nprocs++; + pix = proc_refs[ref_ix] - procs; + assert(procs[pix].is_free); + if (!enif_get_local_pid(env, NewPid, &procs[pix].pid)) + abort(); + procs[pix].is_free = 0; + spawn_cnt++; + proc_histogram[ref_ix]++; + old_nprocs = nprocs; + enif_mutex_unlock(procs_lock); + DBG_TRACE2("Add pid %T, nprocs = %u\n", NewPid, nprocs); + retval = enif_make_uint(env, pix); + } + else { /* remove process */ + pix = proc_refs[ref_ix] - procs; + if (pix == self_pix) { + ref_ix = (ref_ix + 1) % nprocs; + pix = proc_refs[ref_ix] - procs; + } + assert(procs[pix].pid.pid != self.pid); + assert(!procs[pix].is_free); + retval = enif_make_pid(env, &procs[pix].pid); + --nprocs; + assert(!proc_refs[nprocs]->is_free); + if (ref_ix != nprocs) { + struct frenzy_proc* tmp = proc_refs[ref_ix]; + proc_refs[ref_ix] = proc_refs[nprocs]; + proc_refs[nprocs] = tmp; + } + procs[pix].is_free = 1; + proc_histogram[nprocs]++; + kill_cnt++; + enif_mutex_unlock(procs_lock); + DBG_TRACE2("Removed pid %T, nprocs = %u\n", retval, nprocs); + } + break; + } + case 1: + case 2: /* create/delete/lookup resource */ + rix = rand_bits(&rnd, FRENZY_RESOURCES_MAX_BITS) % FRENZY_RESOURCES_MAX; + inc = primes[rand_bits(&rnd, 2)]; + while (enif_mutex_trylock(resv[rix].lock) == EBUSY) { + rix = (rix + inc) % FRENZY_RESOURCES_MAX; + } + if (resv[rix].stopped) { + retval = atom_done; + enif_mutex_unlock(resv[rix].lock); + break; + } + else if (resv[rix].obj == NULL) { + r = enif_alloc_resource(frenzy_resource_type, + sizeof(struct frenzy_resource)); + resv[rix].obj = r; + resv[rix].alloc_cnt++; + r->rix = rix; + for (mix = 0; mix < FRENZY_MONITORS_MAX; mix++) { + r->monv[mix].lock = enif_mutex_create("nif_SUITE:monitor_frenzy.monv.lock"); + r->monv[mix].state = MON_FREE; + r->monv[mix].use_cnt = 0; + r->monv[mix].pid.pid = 0; /* null-pid */ + } + DBG_TRACE2("New resource at r=%p rix=%u\n", r, rix); + } + else { + unsigned int resource_op = rand_bits(&rnd, 3); + r = resv[rix].obj; + if (resource_op == 0) { /* delete resource */ + resv[rix].obj = NULL; + resv[rix].release_cnt++; + enif_mutex_unlock(resv[rix].lock); + DBG_TRACE2("Delete resource at r=%p rix=%u\n", r, rix); + enif_release_resource(r); + retval = atom_ok; + break; + } + else if (resource_op == 1) { /* return resource */ + retval = enif_make_resource(env, r); + enif_mutex_unlock(resv[rix].lock); + break; + } + } + enif_keep_resource(r); + enif_mutex_unlock(resv[rix].lock); + + /* monitor/demonitor */ + + mix = rand_bits(&rnd, FRENZY_MONITORS_MAX_BITS) % FRENZY_MONITORS_MAX; + inc = primes[rand_bits(&rnd, 2)]; + while (enif_mutex_trylock(r->monv[mix].lock) == EBUSY) { + mix = (mix + inc) % FRENZY_MONITORS_MAX; + } + switch (r->monv[mix].state) { + case MON_FREE: + case MON_FREE_DOWN: + case MON_FREE_DEMONITOR: { /* do monitor */ + /* + * Use an old possibly larger value of 'nprocs', to increase + * probability of monitoring an already terminated process + */ + my_nprocs = old_nprocs; + if (my_nprocs > 0) { + int save_state = r->monv[mix].state; + ref_ix = rand_bits(&rnd, FRENZY_PROCS_MAX_BITS) % my_nprocs; + pix = proc_refs[ref_ix] - procs; + r->monv[mix].pid.pid = procs[pix].pid.pid; /* "atomic" */ + r->monv[mix].state = MON_TRYING; + rv = enif_monitor_process(env, r, &r->monv[mix].pid, &r->monv[mix].mon); + if (rv == 0) { + r->monv[mix].state = MON_ACTIVE; + r->monv[mix].use_cnt++; + DBG_TRACE3("Monitor from r=%p rix=%u to %T\n", + r, r->rix, r->monv[mix].pid.pid); + } + else { + r->monv[mix].state = save_state; + DBG_TRACE4("Monitor from r=%p rix=%u to %T FAILED with %d\n", + r, r->rix, r->monv[mix].pid.pid, rv); + } + retval = enif_make_int(env,rv); + } + else { + DBG_TRACE0("No pids to monitor\n"); + retval = atom_ok; + } + break; + } + case MON_ACTIVE: /* do demonitor */ + rv = enif_demonitor_process(env, r, &r->monv[mix].mon); + if (rv == 0) { + DBG_TRACE3("Demonitor from r=%p rix=%u to %T\n", + r, r->rix, r->monv[mix].pid.pid); + r->monv[mix].state = MON_FREE_DEMONITOR; + } + else { + DBG_TRACE4("Demonitor from r=%p rix=%u to %T FAILED with %d\n", + r, r->rix, r->monv[mix].pid.pid, rv); + r->monv[mix].state = MON_PENDING; + } + retval = enif_make_int(env,rv); + break; + + case MON_PENDING: /* waiting for 'down' callback, do nothing */ + retval = atom_ok; + break; + default: + abort(); + break; + } + enif_mutex_unlock(r->monv[mix].lock); + enif_release_resource(r); + break; + + case 3: /* no-op */ + retval = atom_ok; + break; + } + + { + int percent = (rand_bits(&rnd, 6) + 1) * 2; /* 2 to 128 */ + if (percent <= 100) + enif_consume_timeslice(env, percent); + } + + return retval; +} + +static void frenzy_resource_dtor(ErlNifEnv* env, void* obj) +{ + struct frenzy_resource* r = (struct frenzy_resource*) obj; + unsigned int mix; + + DBG_TRACE2("DTOR r=%p rix=%u\n", r, r->rix); + + enif_mutex_lock(resv[r->rix].lock); + resv[r->rix].dtor_cnt++; + enif_mutex_unlock(resv[r->rix].lock); + + for (mix = 0; mix < FRENZY_MONITORS_MAX; mix++) { + assert(r->monv[mix].state != MON_PENDING); + enif_mutex_destroy(r->monv[mix].lock); + r->monv[mix].lock = NULL; + } + +} + +static void frenzy_resource_down(ErlNifEnv* env, void* obj, ErlNifPid* pid, + ErlNifMonitor* mon) +{ + struct frenzy_resource* r = (struct frenzy_resource*) obj; + unsigned int mix; + + DBG_TRACE3("DOWN pid=%T, r=%p rix=%u\n", pid->pid, r, r->rix); + + for (mix = 0; mix < FRENZY_MONITORS_MAX; mix++) { + if (r->monv[mix].pid.pid == pid->pid && r->monv[mix].state >= MON_TRYING) { + enif_mutex_lock(r->monv[mix].lock); + if (enif_compare_monitors(mon, &r->monv[mix].mon) == 0) { + assert(r->monv[mix].state >= MON_ACTIVE); + r->monv[mix].state = MON_FREE_DOWN; + enif_mutex_unlock(r->monv[mix].lock); + return; + } + enif_mutex_unlock(r->monv[mix].lock); + } + } + enif_fprintf(stderr, "DOWN called for unknown monitor\n"); + abort(); +} + +/*********** testing ioq ************/ + +static void ioq_resource_dtor(ErlNifEnv* env, void* obj) { + +} + +#ifndef __WIN32__ +static int writeiovec(ErlNifEnv *env, ERL_NIF_TERM term, ERL_NIF_TERM *tail, ErlNifIOQueue *q, int fd) { + ErlNifIOVec vec, *iovec = &vec; + SysIOVec *sysiovec; + int saved_errno; + int iovcnt, n; + + if (!enif_inspect_iovec(env, 64, term, tail, &iovec)) + return -2; + + if (enif_ioq_size(q) > 0) { + /* If the I/O queue contains data we enqueue the iovec and then + peek the data to write out of the queue. */ + if (!enif_ioq_enqv(q, iovec, 0)) + return -3; + + sysiovec = enif_ioq_peek(q, &iovcnt); + } else { + /* If the I/O queue is empty we skip the trip through it. */ + iovcnt = iovec->iovcnt; + sysiovec = iovec->iov; + } + + /* Attempt to write the data */ + n = writev(fd, sysiovec, iovcnt); + saved_errno = errno; + + if (enif_ioq_size(q) == 0) { + /* If the I/O queue was initially empty we enqueue any + remaining data into the queue for writing later. */ + if (n >= 0 && !enif_ioq_enqv(q, iovec, n)) + return -3; + } else { + /* Dequeue any data that was written from the queue. */ + if (n > 0 && !enif_ioq_deq(q, n, NULL)) + return -4; + } + + /* return n, which is either number of bytes written or -1 if + some error happened */ + errno = saved_errno; + return n; +} +#endif + +static ERL_NIF_TERM ioq(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct ioq_resource *ioq; + ERL_NIF_TERM ret; + if (enif_is_identical(argv[0], enif_make_atom(env, "create"))) { + ErlNifIOQueue *q = enif_ioq_create(ERL_NIF_IOQ_NORMAL); + ioq = (struct ioq_resource *)enif_alloc_resource(ioq_resource_type, + sizeof(*ioq)); + ioq->q = q; + ret = enif_make_resource(env, ioq); + enif_release_resource(ioq); + return ret; + } else if (enif_is_identical(argv[0], enif_make_atom(env, "inspect"))) { + ErlNifIOVec vec, *iovec = NULL; + int i, iovcnt; + ERL_NIF_TERM *elems, tail, list; + ErlNifEnv *myenv = NULL; + + if (enif_is_identical(argv[2], enif_make_atom(env, "use_stack"))) + iovec = &vec; + if (enif_is_identical(argv[3], enif_make_atom(env, "use_env"))) + myenv = env; + if (!enif_inspect_iovec(myenv, ~(size_t)0, argv[1], &tail, &iovec)) + return enif_make_badarg(env); + + iovcnt = iovec->iovcnt; + elems = enif_alloc(sizeof(ERL_NIF_TERM) * iovcnt); + + for (i = 0; i < iovcnt; i++) { + ErlNifBinary bin; + if (!enif_alloc_binary(iovec->iov[i].iov_len, &bin)) { + enif_free_iovec(iovec); + enif_free(elems); + return enif_make_badarg(env); + } + memcpy(bin.data, iovec->iov[i].iov_base, iovec->iov[i].iov_len); + elems[i] = enif_make_binary(env, &bin); + } + + if (!myenv) + enif_free_iovec(iovec); + + list = enif_make_list_from_array(env, elems, iovcnt); + enif_free(elems); + return list; + } else { + unsigned skip; + if (!enif_get_resource(env, argv[1], ioq_resource_type, (void**)&ioq) + || !ioq->q) + return enif_make_badarg(env); + + if (enif_is_identical(argv[0], enif_make_atom(env, "example"))) { +#ifndef __WIN32__ + int fd[2], res = 0, cnt = 0, queue_cnt; + ERL_NIF_TERM tail; + char buff[255]; + pipe(fd); + fcntl(fd[0], F_SETFL, fcntl(fd[0], F_GETFL) | O_NONBLOCK); + fcntl(fd[1], F_SETFL, fcntl(fd[1], F_GETFL) | O_NONBLOCK); + + /* Write until the pipe buffer is full, which should result in data + * being queued up. */ + for (res = 0; res >= 0; ) { + cnt += res; + res = writeiovec(env, argv[2], &tail, ioq->q, fd[1]); + } + + /* Flush the queue while reading from the other end of the pipe. */ + tail = enif_make_list(env, 0); + while (enif_ioq_size(ioq->q) > 0) { + res = writeiovec(env, tail, &tail, ioq->q, fd[1]); + + if (res < 0 && errno != EAGAIN) { + break; + } else if (res > 0) { + cnt += res; + } + + for (res = 0; res >= 0; ) { + cnt -= res; + res = read(fd[0], buff, sizeof(buff)); + } + } + + close(fd[0]); + close(fd[1]); + + /* Check that we read as much as we wrote */ + if (cnt == 0 && enif_ioq_size(ioq->q) == 0) + return enif_make_atom(env, "true"); + + return enif_make_int(env, cnt); +#else + return enif_make_atom(env, "true"); +#endif + } + if (enif_is_identical(argv[0], enif_make_atom(env, "destroy"))) { + enif_ioq_destroy(ioq->q); + ioq->q = NULL; + return enif_make_atom(env, "false"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqv"))) { + ErlNifIOVec vec, *iovec = &vec; + ERL_NIF_TERM tail; + + if (!enif_get_uint(env, argv[3], &skip)) + return enif_make_badarg(env); + if (!enif_inspect_iovec(env, ~0ul, argv[2], &tail, &iovec)) + return enif_make_badarg(env); + if (!enif_ioq_enqv(ioq->q, iovec, skip)) + return enif_make_badarg(env); + + return enif_make_atom(env, "true"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqb"))) { + ErlNifBinary bin; + if (!enif_get_uint(env, argv[3], &skip) || + !enif_inspect_binary(env, argv[2], &bin)) + return enif_make_badarg(env); + + if (!enif_ioq_enq_binary(ioq->q, &bin, skip)) + return enif_make_badarg(env); + + return enif_make_atom(env, "true"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqbraw"))) { + ErlNifBinary bin; + ErlNifBinary localbin; + int i; + if (!enif_get_uint(env, argv[3], &skip) || + !enif_inspect_binary(env, argv[2], &bin) || + !enif_alloc_binary(bin.size, &localbin)) + return enif_make_badarg(env); + + memcpy(localbin.data, bin.data, bin.size); + i = enif_ioq_enq_binary(ioq->q, &localbin, skip); + if (!i) + return enif_make_badarg(env); + else + return enif_make_atom(env, "true"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "peek"))) { + int iovlen, num, i, off = 0; + SysIOVec *iov = enif_ioq_peek(ioq->q, &iovlen); + ErlNifBinary bin; + + if (!enif_get_int(env, argv[2], &num) || !enif_alloc_binary(num, &bin)) + return enif_make_badarg(env); + + for (i = 0; i < iovlen && num > 0; i++) { + int to_copy = num < iov[i].iov_len ? num : iov[i].iov_len; + memcpy(bin.data + off, iov[i].iov_base, to_copy); + num -= to_copy; + off += to_copy; + } + + return enif_make_binary(env, &bin); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "deq"))) { + int num; + size_t sz; + ErlNifUInt64 sz64; + if (!enif_get_int(env, argv[2], &num)) + return enif_make_badarg(env); + + if (!enif_ioq_deq(ioq->q, num, &sz)) + return enif_make_badarg(env); + + sz64 = sz; + + return enif_make_uint64(env, sz64); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "size"))) { + ErlNifUInt64 size = enif_ioq_size(ioq->q); + return enif_make_uint64(env, size); + } + } + + return enif_make_badarg(env); +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -1703,6 +3452,7 @@ static ErlNifFunc nif_funcs[] = {"tuple_2_list", 1, tuple_2_list}, {"is_identical",2,is_identical}, {"compare",2,compare}, + {"hash_nif",3,hash_nif}, {"many_args_100", 100, many_args_100}, {"clone_bin", 1, clone_bin}, {"make_sub_bin", 3, make_sub_bin}, @@ -1716,11 +3466,12 @@ static ErlNifFunc nif_funcs[] = {"make_resource", 1, make_resource}, {"get_resource", 2, get_resource}, {"release_resource", 1, release_resource}, + {"release_resource_from_thread", 1, release_resource_from_thread}, {"last_resource_dtor_call", 0, last_resource_dtor_call}, {"make_new_resource", 2, make_new_resource}, {"check_is", 11, check_is}, {"check_is_exception", 0, check_is_exception}, - {"length_test", 5, length_test}, + {"length_test", 6, length_test}, {"make_atoms", 0, make_atoms}, {"make_strings", 0, make_strings}, {"make_new_resource", 2, make_new_resource}, @@ -1737,15 +3488,17 @@ static ErlNifFunc nif_funcs[] = {"join_send_thread", 1, join_send_thread}, {"copy_blob", 1, copy_blob}, {"send_term", 2, send_term}, + {"send_copy_term", 2, send_copy_term}, {"reverse_list",1, reverse_list}, {"echo_int", 1, echo_int}, {"type_sizes", 0, type_sizes}, {"otp_9668_nif", 1, otp_9668_nif}, + {"otp_9828_nif", 1, otp_9828_nif}, {"consume_timeslice_nif", 2, consume_timeslice_nif}, -#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT - {"call_dirty_nif", 3, call_dirty_nif}, - {"send_from_dirty_nif", 1, send_from_dirty_nif}, -#endif + {"call_nif_schedule", 2, call_nif_schedule}, + {"call_nif_exception", 1, call_nif_exception}, + {"call_nif_nan_or_inf", 1, call_nif_nan_or_inf}, + {"call_nif_atom_too_long", 1, call_nif_atom_too_long}, {"is_map_nif", 1, is_map_nif}, {"get_map_size_nif", 1, get_map_size_nif}, {"make_new_map_nif", 0, make_new_map_nif}, @@ -1754,8 +3507,42 @@ static ErlNifFunc nif_funcs[] = {"make_map_update_nif", 3, make_map_update_nif}, {"make_map_remove_nif", 2, make_map_remove_nif}, {"maps_from_list_nif", 1, maps_from_list_nif}, - {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif} + {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif}, + {"monotonic_time", 1, monotonic_time}, + {"time_offset", 1, time_offset}, + {"convert_time_unit", 3, convert_time_unit}, + {"now_time", 0, now_time}, + {"cpu_time", 0, cpu_time}, + {"unique_integer_nif", 1, unique_integer}, + {"is_process_alive_nif", 1, is_process_alive}, + {"is_port_alive_nif", 1, is_port_alive}, + {"term_to_binary_nif", 2, term_to_binary}, + {"binary_to_term_nif", 3, binary_to_term}, + {"port_command_nif", 2, port_command}, + {"format_term_nif", 2, format_term}, + {"select_nif", 5, select_nif}, +#ifndef __WIN32__ + {"pipe_nif", 0, pipe_nif}, + {"write_nif", 2, write_nif}, + {"dupe_resource_nif", 1, dupe_resource_nif}, + {"read_nif", 2, read_nif}, + {"is_closed_nif", 1, is_closed_nif}, + {"clear_select_nif", 1, clear_select_nif}, +#endif + {"last_fd_stop_call", 0, last_fd_stop_call}, + {"alloc_monitor_resource_nif", 0, alloc_monitor_resource_nif}, + {"monitor_process_nif", 4, monitor_process_nif}, + {"demonitor_process_nif", 2, demonitor_process_nif}, + {"compare_monitors_nif", 2, compare_monitors_nif}, + {"monitor_frenzy_nif", 4, monitor_frenzy_nif}, + {"whereis_send", 3, whereis_send}, + {"whereis_term", 2, whereis_term}, + {"whereis_thd_lookup", 2, whereis_thd_lookup}, + {"whereis_thd_result", 1, whereis_thd_result}, + {"ioq_nif", 1, ioq}, + {"ioq_nif", 2, ioq}, + {"ioq_nif", 3, ioq}, + {"ioq_nif", 4, ioq} }; -ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) - +ERL_NIF_INIT(nif_SUITE,nif_funcs,load,NULL,upgrade,unload) diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_0/README b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/README new file mode 100644 index 0000000000..a6ed36f634 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/README @@ -0,0 +1,5 @@ +These are old genuine header files +checked out from tag OTP_R14A c1e94fa9a6fe4ae717d35. + +I choose this API version (2.0) to test as it's +before the addition of vm_variant in ErlNifEntry. diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_drv_nif.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_drv_nif.h new file mode 100644 index 0000000000..3e5435e353 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_drv_nif.h @@ -0,0 +1,48 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2010-2017. 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% + */ + +/* + * Common structures for both erl_driver.h and erl_nif.h + */ + +#ifndef __ERL_DRV_NIF_H__ +#define __ERL_DRV_NIF_H__ + +typedef struct { + int driver_major_version; + int driver_minor_version; + char *erts_version; + char *otp_release; + int thread_support; + int smp_support; + int async_threads; + int scheduler_threads; + int nif_major_version; + int nif_minor_version; +} ErlDrvSysInfo; + +typedef struct { + int suggested_stack_size; +} ErlDrvThreadOpts; + +#endif /* __ERL_DRV_NIF_H__ */ + + + + diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h new file mode 100644 index 0000000000..4b2b7550e5 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h @@ -0,0 +1,206 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2017. 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 file for writers of Native Implemented Functions. +*/ + +#ifndef __ERL_NIF_H__ +#define __ERL_NIF_H__ + + +#include "erl_drv_nif.h" + +/* Version history: +** 0.1: R13B03 +** 1.0: R13B04 +** 2.0: R14A +*/ +#define ERL_NIF_MAJOR_VERSION 2 +#define ERL_NIF_MINOR_VERSION 0 + +#include <stdlib.h> + +#ifdef SIZEOF_CHAR +# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR +# undef SIZEOF_CHAR +#endif +#ifdef SIZEOF_SHORT +# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT +# undef SIZEOF_SHORT +#endif +#ifdef SIZEOF_INT +# define SIZEOF_INT_SAVED__ SIZEOF_INT +# undef SIZEOF_INT +#endif +#ifdef SIZEOF_LONG +# define SIZEOF_LONG_SAVED__ SIZEOF_LONG +# undef SIZEOF_LONG +#endif +#ifdef SIZEOF_LONG_LONG +# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG +# undef SIZEOF_LONG_LONG +#endif +#ifdef HALFWORD_HEAP_EMULATOR +# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR +# undef HALFWORD_HEAP_EMULATOR +#endif +#include "erl_int_sizes_config.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef HALFWORD_HEAP_EMULATOR +typedef unsigned int ERL_NIF_TERM; +#else +typedef unsigned long ERL_NIF_TERM; +#endif + +struct enif_environment_t; +typedef struct enif_environment_t ErlNifEnv; + +typedef struct +{ + const char* name; + unsigned arity; + ERL_NIF_TERM (*fptr)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +}ErlNifFunc; + +typedef struct enif_entry_t +{ + int major; + int minor; + const char* name; + int num_of_funcs; + ErlNifFunc* funcs; + int (*load) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info); + int (*reload) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info); + int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); + void (*unload) (ErlNifEnv*, void* priv_data); +}ErlNifEntry; + + + +typedef struct +{ + size_t size; + unsigned char* data; + + /* Internals (avert your eyes) */ + ERL_NIF_TERM bin_term; + void* ref_bin; +}ErlNifBinary; + +typedef struct enif_resource_type_t ErlNifResourceType; +typedef void ErlNifResourceDtor(ErlNifEnv*, void*); +typedef enum +{ + ERL_NIF_RT_CREATE = 1, + ERL_NIF_RT_TAKEOVER = 2 +}ErlNifResourceFlags; + +typedef enum +{ + ERL_NIF_LATIN1 = 1 +}ErlNifCharEncoding; + +typedef struct +{ + ERL_NIF_TERM pid; /* internal, may change */ +}ErlNifPid; + +typedef ErlDrvSysInfo ErlNifSysInfo; + +typedef struct ErlDrvTid_ *ErlNifTid; +typedef struct ErlDrvMutex_ ErlNifMutex; +typedef struct ErlDrvCond_ ErlNifCond; +typedef struct ErlDrvRWLock_ ErlNifRWLock; +typedef int ErlNifTSDKey; + +typedef ErlDrvThreadOpts ErlNifThreadOpts; + +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) RET_TYPE (*NAME) ARGS +typedef struct { +# include "erl_nif_api_funcs.h" +} TWinDynNifCallbacks; +extern TWinDynNifCallbacks WinDynNifCallbacks; +# undef ERL_NIF_API_FUNC_DECL +#endif + +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) && !defined(STATIC_ERLANG_DRIVER) +# define ERL_NIF_API_FUNC_MACRO(NAME) (WinDynNifCallbacks.NAME) +# include "erl_nif_api_funcs.h" +/* note that we have to keep ERL_NIF_API_FUNC_MACRO defined */ + +#else /* non windows or included from emulator itself */ + +# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) extern RET_TYPE NAME ARGS +# include "erl_nif_api_funcs.h" +# undef ERL_NIF_API_FUNC_DECL +#endif + + +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +# define ERL_NIF_INIT_GLOB TWinDynNifCallbacks WinDynNifCallbacks; +# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks) +# define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks)) +#else +# define ERL_NIF_INIT_GLOB +# define ERL_NIF_INIT_BODY +# if defined(VXWORKS) +# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _init(void) +# else +# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* nif_init(void) +# endif +#endif + + +#ifdef __cplusplus +} +# define ERL_NIF_INIT_PROLOGUE extern "C" { +# define ERL_NIF_INIT_EPILOGUE } +#else +# define ERL_NIF_INIT_PROLOGUE +# define ERL_NIF_INIT_EPILOGUE +#endif + + +#define ERL_NIF_INIT(NAME, FUNCS, LOAD, RELOAD, UPGRADE, UNLOAD) \ +ERL_NIF_INIT_PROLOGUE \ +ERL_NIF_INIT_GLOB \ +ERL_NIF_INIT_DECL(NAME) \ +{ \ + static ErlNifEntry entry = \ + { \ + ERL_NIF_MAJOR_VERSION, \ + ERL_NIF_MINOR_VERSION, \ + #NAME, \ + sizeof(FUNCS) / sizeof(*FUNCS), \ + FUNCS, \ + LOAD, RELOAD, UPGRADE, UNLOAD \ + }; \ + ERL_NIF_INIT_BODY; \ + return &entry; \ +} \ +ERL_NIF_INIT_EPILOGUE + + +#endif /* __ERL_NIF_H__ */ + diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif_api_funcs.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif_api_funcs.h new file mode 100644 index 0000000000..302973fcca --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif_api_funcs.h @@ -0,0 +1,257 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2017. 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% + */ + +#if !defined(ERL_NIF_API_FUNC_DECL) && !defined(ERL_NIF_API_FUNC_MACRO) +# error This file should not be included directly +#endif + +#ifdef ERL_NIF_API_FUNC_DECL +ERL_NIF_API_FUNC_DECL(void*,enif_priv_data,(ErlNifEnv*)); +ERL_NIF_API_FUNC_DECL(void*,enif_alloc,(size_t size)); +ERL_NIF_API_FUNC_DECL(void,enif_free,(void* ptr)); +ERL_NIF_API_FUNC_DECL(int,enif_is_atom,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_binary,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_ref,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_inspect_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(int,enif_alloc_binary,(size_t size, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(int,enif_realloc_binary,(ErlNifBinary* bin, size_t size)); +ERL_NIF_API_FUNC_DECL(void,enif_release_binary,(ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(int,enif_get_int,(ErlNifEnv*, ERL_NIF_TERM term, int* ip)); +ERL_NIF_API_FUNC_DECL(int,enif_get_ulong,(ErlNifEnv*, ERL_NIF_TERM term, unsigned long* ip)); +ERL_NIF_API_FUNC_DECL(int,enif_get_double,(ErlNifEnv*, ERL_NIF_TERM term, double* dp)); +ERL_NIF_API_FUNC_DECL(int,enif_get_list_cell,(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM* head, ERL_NIF_TERM* tail)); +ERL_NIF_API_FUNC_DECL(int,enif_get_tuple,(ErlNifEnv* env, ERL_NIF_TERM tpl, int* arity, const ERL_NIF_TERM** array)); +ERL_NIF_API_FUNC_DECL(int,enif_is_identical,(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs)); +ERL_NIF_API_FUNC_DECL(int,enif_compare,(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_binary,(ErlNifEnv* env, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_badarg,(ErlNifEnv* env)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int,(ErlNifEnv* env, int i)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_ulong,(ErlNifEnv* env, unsigned long i)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_double,(ErlNifEnv* env, double d)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_atom,(ErlNifEnv* env, const char* name)); +ERL_NIF_API_FUNC_DECL(int,enif_make_existing_atom,(ErlNifEnv* env, const char* name, ERL_NIF_TERM* atom, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple,(ErlNifEnv* env, unsigned cnt, ...)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list,(ErlNifEnv* env, unsigned cnt, ...)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_cell,(ErlNifEnv* env, ERL_NIF_TERM car, ERL_NIF_TERM cdr)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_string,(ErlNifEnv* env, const char* string, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_ref,(ErlNifEnv* env)); + +ERL_NIF_API_FUNC_DECL(ErlNifMutex*,enif_mutex_create,(char *name)); +ERL_NIF_API_FUNC_DECL(void,enif_mutex_destroy,(ErlNifMutex *mtx)); +ERL_NIF_API_FUNC_DECL(int,enif_mutex_trylock,(ErlNifMutex *mtx)); +ERL_NIF_API_FUNC_DECL(void,enif_mutex_lock,(ErlNifMutex *mtx)); +ERL_NIF_API_FUNC_DECL(void,enif_mutex_unlock,(ErlNifMutex *mtx)); +ERL_NIF_API_FUNC_DECL(ErlNifCond*,enif_cond_create,(char *name)); +ERL_NIF_API_FUNC_DECL(void,enif_cond_destroy,(ErlNifCond *cnd)); +ERL_NIF_API_FUNC_DECL(void,enif_cond_signal,(ErlNifCond *cnd)); +ERL_NIF_API_FUNC_DECL(void,enif_cond_broadcast,(ErlNifCond *cnd)); +ERL_NIF_API_FUNC_DECL(void,enif_cond_wait,(ErlNifCond *cnd, ErlNifMutex *mtx)); +ERL_NIF_API_FUNC_DECL(ErlNifRWLock*,enif_rwlock_create,(char *name)); +ERL_NIF_API_FUNC_DECL(void,enif_rwlock_destroy,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(int,enif_rwlock_tryrlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(void,enif_rwlock_runlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(int,enif_rwlock_tryrwlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rwlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rwunlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(int,enif_tsd_key_create,(char *name, ErlNifTSDKey *key)); +ERL_NIF_API_FUNC_DECL(void,enif_tsd_key_destroy,(ErlNifTSDKey key)); +ERL_NIF_API_FUNC_DECL(void,enif_tsd_set,(ErlNifTSDKey key, void *data)); +ERL_NIF_API_FUNC_DECL(void*,enif_tsd_get,(ErlNifTSDKey key)); +ERL_NIF_API_FUNC_DECL(ErlNifThreadOpts*,enif_thread_opts_create,(char *name)); +ERL_NIF_API_FUNC_DECL(void,enif_thread_opts_destroy,(ErlNifThreadOpts *opts)); +ERL_NIF_API_FUNC_DECL(int,enif_thread_create,(char *name,ErlNifTid *tid,void * (*func)(void *),void *args,ErlNifThreadOpts *opts)); +ERL_NIF_API_FUNC_DECL(ErlNifTid,enif_thread_self,(void)); +ERL_NIF_API_FUNC_DECL(int,enif_equal_tids,(ErlNifTid tid1, ErlNifTid tid2)); +ERL_NIF_API_FUNC_DECL(void,enif_thread_exit,(void *resp)); +ERL_NIF_API_FUNC_DECL(int,enif_thread_join,(ErlNifTid, void **respp)); + +ERL_NIF_API_FUNC_DECL(void*,enif_realloc,(void* ptr, size_t size)); +ERL_NIF_API_FUNC_DECL(void,enif_system_info,(ErlNifSysInfo *sip, size_t si_size)); +ERL_NIF_API_FUNC_DECL(int,enif_fprintf,(void/* FILE* */ *filep, const char *format, ...)); +ERL_NIF_API_FUNC_DECL(int,enif_inspect_iolist_as_binary,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_sub_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, size_t pos, size_t size)); +ERL_NIF_API_FUNC_DECL(int,enif_get_string,(ErlNifEnv*, ERL_NIF_TERM list, char* buf, unsigned len, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(int,enif_get_atom,(ErlNifEnv*, ERL_NIF_TERM atom, char* buf, unsigned len, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(int,enif_is_fun,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_pid,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_port,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_get_uint,(ErlNifEnv*, ERL_NIF_TERM term, unsigned* ip)); +ERL_NIF_API_FUNC_DECL(int,enif_get_long,(ErlNifEnv*, ERL_NIF_TERM term, long* ip)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint,(ErlNifEnv*, unsigned i)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_long,(ErlNifEnv*, long i)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple_from_array,(ErlNifEnv*, const ERL_NIF_TERM arr[], unsigned cnt)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_from_array,(ErlNifEnv*, const ERL_NIF_TERM arr[], unsigned cnt)); +ERL_NIF_API_FUNC_DECL(int,enif_is_empty_list,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(ErlNifResourceType*,enif_open_resource_type,(ErlNifEnv*, const char* module_str, const char* name_str, void (*dtor)(ErlNifEnv*,void *), ErlNifResourceFlags flags, ErlNifResourceFlags* tried)); +ERL_NIF_API_FUNC_DECL(void*,enif_alloc_resource,(ErlNifResourceType* type, size_t size)); +ERL_NIF_API_FUNC_DECL(void,enif_release_resource,(void* obj)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource,(ErlNifEnv*, void* obj)); +ERL_NIF_API_FUNC_DECL(int,enif_get_resource,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp)); +ERL_NIF_API_FUNC_DECL(size_t,enif_sizeof_resource,(void* obj)); +ERL_NIF_API_FUNC_DECL(unsigned char*,enif_make_new_binary,(ErlNifEnv*,size_t size,ERL_NIF_TERM* termp)); +ERL_NIF_API_FUNC_DECL(int,enif_is_list,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_tuple,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_get_atom_length,(ErlNifEnv*, ERL_NIF_TERM atom, unsigned* len, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(int,enif_get_list_length,(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_atom_len,(ErlNifEnv* env, const char* name, size_t len)); +ERL_NIF_API_FUNC_DECL(int, enif_make_existing_atom_len,(ErlNifEnv* env, const char* name, size_t len, ERL_NIF_TERM* atom, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_string_len,(ErlNifEnv* env, const char* string, size_t len, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(ErlNifEnv*,enif_alloc_env,(void)); +ERL_NIF_API_FUNC_DECL(void,enif_free_env,(ErlNifEnv* env)); +ERL_NIF_API_FUNC_DECL(void,enif_clear_env,(ErlNifEnv* env)); +ERL_NIF_API_FUNC_DECL(int,enif_send,(ErlNifEnv* env, const ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_copy,(ErlNifEnv* dst_env, ERL_NIF_TERM src_term)); +ERL_NIF_API_FUNC_DECL(ErlNifPid*,enif_self,(ErlNifEnv* caller_env, ErlNifPid* pid)); +ERL_NIF_API_FUNC_DECL(int,enif_get_local_pid,(ErlNifEnv* env, ERL_NIF_TERM, ErlNifPid* pid)); +ERL_NIF_API_FUNC_DECL(void,enif_keep_resource,(void* obj)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource_binary,(ErlNifEnv*,void* obj,const void* data, size_t size)); + +/* +** Add last to keep compatibility on Windows!!! +*/ +#endif + +#ifdef ERL_NIF_API_FUNC_MACRO +# define enif_priv_data ERL_NIF_API_FUNC_MACRO(enif_priv_data) +# define enif_alloc ERL_NIF_API_FUNC_MACRO(enif_alloc) +# define enif_free ERL_NIF_API_FUNC_MACRO(enif_free) +# define enif_is_atom ERL_NIF_API_FUNC_MACRO(enif_is_atom) +# define enif_is_binary ERL_NIF_API_FUNC_MACRO(enif_is_binary) +# define enif_is_ref ERL_NIF_API_FUNC_MACRO(enif_is_ref) +# define enif_inspect_binary ERL_NIF_API_FUNC_MACRO(enif_inspect_binary) +# define enif_alloc_binary ERL_NIF_API_FUNC_MACRO(enif_alloc_binary) +# define enif_realloc_binary ERL_NIF_API_FUNC_MACRO(enif_realloc_binary) +# define enif_release_binary ERL_NIF_API_FUNC_MACRO(enif_release_binary) +# define enif_get_int ERL_NIF_API_FUNC_MACRO(enif_get_int) +# define enif_get_ulong ERL_NIF_API_FUNC_MACRO(enif_get_ulong) +# define enif_get_double ERL_NIF_API_FUNC_MACRO(enif_get_double) +# define enif_get_tuple ERL_NIF_API_FUNC_MACRO(enif_get_tuple) +# define enif_get_list_cell ERL_NIF_API_FUNC_MACRO(enif_get_list_cell) +# define enif_is_identical ERL_NIF_API_FUNC_MACRO(enif_is_identical) +# define enif_compare ERL_NIF_API_FUNC_MACRO(enif_compare) + +# define enif_make_binary ERL_NIF_API_FUNC_MACRO(enif_make_binary) +# define enif_make_badarg ERL_NIF_API_FUNC_MACRO(enif_make_badarg) +# define enif_make_int ERL_NIF_API_FUNC_MACRO(enif_make_int) +# define enif_make_ulong ERL_NIF_API_FUNC_MACRO(enif_make_ulong) +# define enif_make_double ERL_NIF_API_FUNC_MACRO(enif_make_double) +# define enif_make_atom ERL_NIF_API_FUNC_MACRO(enif_make_atom) +# define enif_make_existing_atom ERL_NIF_API_FUNC_MACRO(enif_make_existing_atom) +# define enif_make_tuple ERL_NIF_API_FUNC_MACRO(enif_make_tuple) +# define enif_make_list ERL_NIF_API_FUNC_MACRO(enif_make_list) +# define enif_make_list_cell ERL_NIF_API_FUNC_MACRO(enif_make_list_cell) +# define enif_make_string ERL_NIF_API_FUNC_MACRO(enif_make_string) +# define enif_make_ref ERL_NIF_API_FUNC_MACRO(enif_make_ref) + +# define enif_mutex_create ERL_NIF_API_FUNC_MACRO(enif_mutex_create) +# define enif_mutex_destroy ERL_NIF_API_FUNC_MACRO(enif_mutex_destroy) +# define enif_mutex_trylock ERL_NIF_API_FUNC_MACRO(enif_mutex_trylock) +# define enif_mutex_lock ERL_NIF_API_FUNC_MACRO(enif_mutex_lock) +# define enif_mutex_unlock ERL_NIF_API_FUNC_MACRO(enif_mutex_unlock) +# define enif_cond_create ERL_NIF_API_FUNC_MACRO(enif_cond_create) +# define enif_cond_destroy ERL_NIF_API_FUNC_MACRO(enif_cond_destroy) +# define enif_cond_signal ERL_NIF_API_FUNC_MACRO(enif_cond_signal) +# define enif_cond_broadcast ERL_NIF_API_FUNC_MACRO(enif_cond_broadcast) +# define enif_cond_wait ERL_NIF_API_FUNC_MACRO(enif_cond_wait) +# define enif_rwlock_create ERL_NIF_API_FUNC_MACRO(enif_rwlock_create) +# define enif_rwlock_destroy ERL_NIF_API_FUNC_MACRO(enif_rwlock_destroy) +# define enif_rwlock_tryrlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_tryrlock) +# define enif_rwlock_rlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rlock) +# define enif_rwlock_runlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_runlock) +# define enif_rwlock_tryrwlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_tryrwlock) +# define enif_rwlock_rwlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rwlock) +# define enif_rwlock_rwunlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rwunlock) +# define enif_tsd_key_create ERL_NIF_API_FUNC_MACRO(enif_tsd_key_create) +# define enif_tsd_key_destroy ERL_NIF_API_FUNC_MACRO(enif_tsd_key_destroy) +# define enif_tsd_set ERL_NIF_API_FUNC_MACRO(enif_tsd_set) +# define enif_tsd_get ERL_NIF_API_FUNC_MACRO(enif_tsd_get) +# define enif_thread_opts_create ERL_NIF_API_FUNC_MACRO(enif_thread_opts_create) +# define enif_thread_opts_destroy ERL_NIF_API_FUNC_MACRO(enif_thread_opts_destroy) +# define enif_thread_create ERL_NIF_API_FUNC_MACRO(enif_thread_create) +# define enif_thread_self ERL_NIF_API_FUNC_MACRO(enif_thread_self) +# define enif_equal_tids ERL_NIF_API_FUNC_MACRO(enif_equal_tids) +# define enif_thread_exit ERL_NIF_API_FUNC_MACRO(enif_thread_exit) +# define enif_thread_join ERL_NIF_API_FUNC_MACRO(enif_thread_join) + +# define enif_realloc ERL_NIF_API_FUNC_MACRO(enif_realloc) +# define enif_system_info ERL_NIF_API_FUNC_MACRO(enif_system_info) +# define enif_fprintf ERL_NIF_API_FUNC_MACRO(enif_fprintf) +# define enif_inspect_iolist_as_binary ERL_NIF_API_FUNC_MACRO(enif_inspect_iolist_as_binary) +# define enif_make_sub_binary ERL_NIF_API_FUNC_MACRO(enif_make_sub_binary) +# define enif_get_string ERL_NIF_API_FUNC_MACRO(enif_get_string) +# define enif_get_atom ERL_NIF_API_FUNC_MACRO(enif_get_atom) +# define enif_is_fun ERL_NIF_API_FUNC_MACRO(enif_is_fun) +# define enif_is_pid ERL_NIF_API_FUNC_MACRO(enif_is_pid) +# define enif_is_port ERL_NIF_API_FUNC_MACRO(enif_is_port) +# define enif_get_uint ERL_NIF_API_FUNC_MACRO(enif_get_uint) +# define enif_get_long ERL_NIF_API_FUNC_MACRO(enif_get_long) +# define enif_make_uint ERL_NIF_API_FUNC_MACRO(enif_make_uint) +# define enif_make_long ERL_NIF_API_FUNC_MACRO(enif_make_long) +# define enif_make_tuple_from_array ERL_NIF_API_FUNC_MACRO(enif_make_tuple_from_array) +# define enif_make_list_from_array ERL_NIF_API_FUNC_MACRO(enif_make_list_from_array) +# define enif_is_empty_list ERL_NIF_API_FUNC_MACRO(enif_is_empty_list) +# define enif_open_resource_type ERL_NIF_API_FUNC_MACRO(enif_open_resource_type) +# define enif_alloc_resource ERL_NIF_API_FUNC_MACRO(enif_alloc_resource) +# define enif_release_resource ERL_NIF_API_FUNC_MACRO(enif_release_resource) +# define enif_make_resource ERL_NIF_API_FUNC_MACRO(enif_make_resource) +# define enif_get_resource ERL_NIF_API_FUNC_MACRO(enif_get_resource) +# define enif_sizeof_resource ERL_NIF_API_FUNC_MACRO(enif_sizeof_resource) +# define enif_make_new_binary ERL_NIF_API_FUNC_MACRO(enif_make_new_binary) +# define enif_is_list ERL_NIF_API_FUNC_MACRO(enif_is_list) +# define enif_is_tuple ERL_NIF_API_FUNC_MACRO(enif_is_tuple) +# define enif_get_atom_length ERL_NIF_API_FUNC_MACRO(enif_get_atom_length) +# define enif_get_list_length ERL_NIF_API_FUNC_MACRO(enif_get_list_length) +# define enif_make_atom_len ERL_NIF_API_FUNC_MACRO(enif_make_atom_len) +# define enif_make_existing_atom_len ERL_NIF_API_FUNC_MACRO(enif_make_existing_atom_len) +# define enif_make_string_len ERL_NIF_API_FUNC_MACRO(enif_make_string_len) +# define enif_alloc_env ERL_NIF_API_FUNC_MACRO(enif_alloc_env) +# define enif_free_env ERL_NIF_API_FUNC_MACRO(enif_free_env) +# define enif_clear_env ERL_NIF_API_FUNC_MACRO(enif_clear_env) +# define enif_send ERL_NIF_API_FUNC_MACRO(enif_send) +# define enif_make_copy ERL_NIF_API_FUNC_MACRO(enif_make_copy) +# define enif_self ERL_NIF_API_FUNC_MACRO(enif_self) +# define enif_get_local_pid ERL_NIF_API_FUNC_MACRO(enif_get_local_pid) +# define enif_keep_resource ERL_NIF_API_FUNC_MACRO(enif_keep_resource) +# define enif_make_resource_binary ERL_NIF_API_FUNC_MACRO(enif_make_resource_binary) +#endif + +#ifndef enif_make_list1 +# define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1) +# define enif_make_list2(ENV,E1,E2) enif_make_list(ENV,2,E1,E2) +# define enif_make_list3(ENV,E1,E2,E3) enif_make_list(ENV,3,E1,E2,E3) +# define enif_make_list4(ENV,E1,E2,E3,E4) enif_make_list(ENV,4,E1,E2,E3,E4) +# define enif_make_list5(ENV,E1,E2,E3,E4,E5) enif_make_list(ENV,5,E1,E2,E3,E4,E5) +# define enif_make_list6(ENV,E1,E2,E3,E4,E5,E6) enif_make_list(ENV,6,E1,E2,E3,E4,E5,E6) +# define enif_make_list7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_list(ENV,7,E1,E2,E3,E4,E5,E6,E7) +# define enif_make_list8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_list(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8) +# define enif_make_list9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_list(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9) +# define enif_make_tuple1(ENV,E1) enif_make_tuple(ENV,1,E1) +# define enif_make_tuple2(ENV,E1,E2) enif_make_tuple(ENV,2,E1,E2) +# define enif_make_tuple3(ENV,E1,E2,E3) enif_make_tuple(ENV,3,E1,E2,E3) +# define enif_make_tuple4(ENV,E1,E2,E3,E4) enif_make_tuple(ENV,4,E1,E2,E3,E4) +# define enif_make_tuple5(ENV,E1,E2,E3,E4,E5) enif_make_tuple(ENV,5,E1,E2,E3,E4,E5) +# define enif_make_tuple6(ENV,E1,E2,E3,E4,E5,E6) enif_make_tuple(ENV,6,E1,E2,E3,E4,E5,E6) +# define enif_make_tuple7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_tuple(ENV,7,E1,E2,E3,E4,E5,E6,E7) +# define enif_make_tuple8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_tuple(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8) +# define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9) + +# define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid)) +#endif + diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_4/README b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/README new file mode 100644 index 0000000000..7abd0319a6 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/README @@ -0,0 +1,6 @@ +These are old genuine header files +checked out from tag OTP_R16B 05f11890bdfec4bfc3a78e191 + +I choose this API version (2.4) to test, as it's before +the addition of 'options' in ErlNifEntry and 'flags' in ErlNifFunc +and without include of generated erl_native_features_config.h. diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_drv_nif.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_drv_nif.h new file mode 100644 index 0000000000..3e5435e353 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_drv_nif.h @@ -0,0 +1,48 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2010-2017. 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% + */ + +/* + * Common structures for both erl_driver.h and erl_nif.h + */ + +#ifndef __ERL_DRV_NIF_H__ +#define __ERL_DRV_NIF_H__ + +typedef struct { + int driver_major_version; + int driver_minor_version; + char *erts_version; + char *otp_release; + int thread_support; + int smp_support; + int async_threads; + int scheduler_threads; + int nif_major_version; + int nif_minor_version; +} ErlDrvSysInfo; + +typedef struct { + int suggested_stack_size; +} ErlDrvThreadOpts; + +#endif /* __ERL_DRV_NIF_H__ */ + + + + diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif.h new file mode 100644 index 0000000000..c3013b6b74 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif.h @@ -0,0 +1,237 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2017. 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 file for writers of Native Implemented Functions. +*/ + +#ifndef __ERL_NIF_H__ +#define __ERL_NIF_H__ + + +#include "erl_drv_nif.h" + +/* Version history: +** 0.1: R13B03 +** 1.0: R13B04 +** 2.0: R14A +** 2.1: R14B02 "vm_variant" +** 2.2: R14B03 enif_is_exception +** 2.3: R15 enif_make_reverse_list, enif_is_number +** 2.4: R16 enif_consume_timeslice +*/ +#define ERL_NIF_MAJOR_VERSION 2 +#define ERL_NIF_MINOR_VERSION 4 + +#include <stdlib.h> + +#ifdef SIZEOF_CHAR +# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR +# undef SIZEOF_CHAR +#endif +#ifdef SIZEOF_SHORT +# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT +# undef SIZEOF_SHORT +#endif +#ifdef SIZEOF_INT +# define SIZEOF_INT_SAVED__ SIZEOF_INT +# undef SIZEOF_INT +#endif +#ifdef SIZEOF_LONG +# define SIZEOF_LONG_SAVED__ SIZEOF_LONG +# undef SIZEOF_LONG +#endif +#ifdef SIZEOF_LONG_LONG +# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG +# undef SIZEOF_LONG_LONG +#endif +#ifdef HALFWORD_HEAP_EMULATOR +# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR +# undef HALFWORD_HEAP_EMULATOR +#endif +#include "erl_int_sizes_config.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +typedef unsigned __int64 ErlNifUInt64; +typedef __int64 ErlNifSInt64; +#elif SIZEOF_LONG == 8 +typedef unsigned long ErlNifUInt64; +typedef long ErlNifSInt64; +#elif SIZEOF_LONG_LONG == 8 +typedef unsigned long long ErlNifUInt64; +typedef long long ErlNifSInt64; +#else +#error No 64-bit integer type +#endif + +#ifdef HALFWORD_HEAP_EMULATOR +# define ERL_NIF_VM_VARIANT "beam.halfword" +typedef unsigned int ERL_NIF_TERM; +#else +# define ERL_NIF_VM_VARIANT "beam.vanilla" +# if SIZEOF_LONG == SIZEOF_VOID_P +typedef unsigned long ERL_NIF_TERM; +# elif SIZEOF_LONG_LONG == SIZEOF_VOID_P +typedef unsigned long long ERL_NIF_TERM; +# endif +#endif + +struct enif_environment_t; +typedef struct enif_environment_t ErlNifEnv; + +typedef struct +{ + const char* name; + unsigned arity; + ERL_NIF_TERM (*fptr)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +}ErlNifFunc; + +typedef struct enif_entry_t +{ + int major; + int minor; + const char* name; + int num_of_funcs; + ErlNifFunc* funcs; + int (*load) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info); + int (*reload) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info); + int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); + void (*unload) (ErlNifEnv*, void* priv_data); + const char* vm_variant; +}ErlNifEntry; + + + +typedef struct +{ + size_t size; + unsigned char* data; + + /* Internals (avert your eyes) */ + ERL_NIF_TERM bin_term; + void* ref_bin; +}ErlNifBinary; + +typedef struct enif_resource_type_t ErlNifResourceType; +typedef void ErlNifResourceDtor(ErlNifEnv*, void*); +typedef enum +{ + ERL_NIF_RT_CREATE = 1, + ERL_NIF_RT_TAKEOVER = 2 +}ErlNifResourceFlags; + +typedef enum +{ + ERL_NIF_LATIN1 = 1 +}ErlNifCharEncoding; + +typedef struct +{ + ERL_NIF_TERM pid; /* internal, may change */ +}ErlNifPid; + +typedef ErlDrvSysInfo ErlNifSysInfo; + +typedef struct ErlDrvTid_ *ErlNifTid; +typedef struct ErlDrvMutex_ ErlNifMutex; +typedef struct ErlDrvCond_ ErlNifCond; +typedef struct ErlDrvRWLock_ ErlNifRWLock; +typedef int ErlNifTSDKey; + +typedef ErlDrvThreadOpts ErlNifThreadOpts; + +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) RET_TYPE (*NAME) ARGS +typedef struct { +# include "erl_nif_api_funcs.h" +} TWinDynNifCallbacks; +extern TWinDynNifCallbacks WinDynNifCallbacks; +# undef ERL_NIF_API_FUNC_DECL +#endif + +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) && !defined(STATIC_ERLANG_DRIVER) +# define ERL_NIF_API_FUNC_MACRO(NAME) (WinDynNifCallbacks.NAME) +# include "erl_nif_api_funcs.h" +/* note that we have to keep ERL_NIF_API_FUNC_MACRO defined */ + +#else /* non windows or included from emulator itself */ + +# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) extern RET_TYPE NAME ARGS +# include "erl_nif_api_funcs.h" +# undef ERL_NIF_API_FUNC_DECL +#endif + + +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +# define ERL_NIF_INIT_GLOB TWinDynNifCallbacks WinDynNifCallbacks; +# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks) +# define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks)) +#else +# define ERL_NIF_INIT_GLOB +# define ERL_NIF_INIT_BODY +# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* nif_init(void) +#endif + + +#ifdef __cplusplus +} +# define ERL_NIF_INIT_PROLOGUE extern "C" { +# define ERL_NIF_INIT_EPILOGUE } +#else +# define ERL_NIF_INIT_PROLOGUE +# define ERL_NIF_INIT_EPILOGUE +#endif + + +#define ERL_NIF_INIT(NAME, FUNCS, LOAD, RELOAD, UPGRADE, UNLOAD) \ +ERL_NIF_INIT_PROLOGUE \ +ERL_NIF_INIT_GLOB \ +ERL_NIF_INIT_DECL(NAME); \ +ERL_NIF_INIT_DECL(NAME) \ +{ \ + static ErlNifEntry entry = \ + { \ + ERL_NIF_MAJOR_VERSION, \ + ERL_NIF_MINOR_VERSION, \ + #NAME, \ + sizeof(FUNCS) / sizeof(*FUNCS), \ + FUNCS, \ + LOAD, RELOAD, UPGRADE, UNLOAD, \ + ERL_NIF_VM_VARIANT \ + }; \ + ERL_NIF_INIT_BODY; \ + return &entry; \ +} \ +ERL_NIF_INIT_EPILOGUE + +#if defined(USE_DYNAMIC_TRACE) && (defined(USE_DTRACE) || defined(USE_SYSTEMTAP)) +#define HAVE_USE_DTRACE 1 +#endif + +#ifdef HAVE_USE_DTRACE +ERL_NIF_TERM erl_nif_user_trace_s1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM erl_nif_user_trace_i4s4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM erl_nif_user_trace_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +#endif + +#endif /* __ERL_NIF_H__ */ + diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif_api_funcs.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif_api_funcs.h new file mode 100644 index 0000000000..92954403f3 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif_api_funcs.h @@ -0,0 +1,503 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2017. 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% + */ + +#if !defined(ERL_NIF_API_FUNC_DECL) && !defined(ERL_NIF_API_FUNC_MACRO) +# error This file should not be included directly +#endif + +/* +** WARNING: add new ERL_NIF_API_FUNC_DECL entries at the bottom of the list +** to keep compatibility on Windows!!! +** +** And don't forget to increase ERL_NIF_MINOR_VERSION in erl_nif.h +** when adding functions to the API. +*/ +#ifdef ERL_NIF_API_FUNC_DECL +ERL_NIF_API_FUNC_DECL(void*,enif_priv_data,(ErlNifEnv*)); +ERL_NIF_API_FUNC_DECL(void*,enif_alloc,(size_t size)); +ERL_NIF_API_FUNC_DECL(void,enif_free,(void* ptr)); +ERL_NIF_API_FUNC_DECL(int,enif_is_atom,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_binary,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_ref,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_inspect_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(int,enif_alloc_binary,(size_t size, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(int,enif_realloc_binary,(ErlNifBinary* bin, size_t size)); +ERL_NIF_API_FUNC_DECL(void,enif_release_binary,(ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(int,enif_get_int,(ErlNifEnv*, ERL_NIF_TERM term, int* ip)); +ERL_NIF_API_FUNC_DECL(int,enif_get_ulong,(ErlNifEnv*, ERL_NIF_TERM term, unsigned long* ip)); +ERL_NIF_API_FUNC_DECL(int,enif_get_double,(ErlNifEnv*, ERL_NIF_TERM term, double* dp)); +ERL_NIF_API_FUNC_DECL(int,enif_get_list_cell,(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM* head, ERL_NIF_TERM* tail)); +ERL_NIF_API_FUNC_DECL(int,enif_get_tuple,(ErlNifEnv* env, ERL_NIF_TERM tpl, int* arity, const ERL_NIF_TERM** array)); +ERL_NIF_API_FUNC_DECL(int,enif_is_identical,(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs)); +ERL_NIF_API_FUNC_DECL(int,enif_compare,(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_binary,(ErlNifEnv* env, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_badarg,(ErlNifEnv* env)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int,(ErlNifEnv* env, int i)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_ulong,(ErlNifEnv* env, unsigned long i)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_double,(ErlNifEnv* env, double d)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_atom,(ErlNifEnv* env, const char* name)); +ERL_NIF_API_FUNC_DECL(int,enif_make_existing_atom,(ErlNifEnv* env, const char* name, ERL_NIF_TERM* atom, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple,(ErlNifEnv* env, unsigned cnt, ...)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list,(ErlNifEnv* env, unsigned cnt, ...)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_cell,(ErlNifEnv* env, ERL_NIF_TERM car, ERL_NIF_TERM cdr)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_string,(ErlNifEnv* env, const char* string, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_ref,(ErlNifEnv* env)); + +ERL_NIF_API_FUNC_DECL(ErlNifMutex*,enif_mutex_create,(char *name)); +ERL_NIF_API_FUNC_DECL(void,enif_mutex_destroy,(ErlNifMutex *mtx)); +ERL_NIF_API_FUNC_DECL(int,enif_mutex_trylock,(ErlNifMutex *mtx)); +ERL_NIF_API_FUNC_DECL(void,enif_mutex_lock,(ErlNifMutex *mtx)); +ERL_NIF_API_FUNC_DECL(void,enif_mutex_unlock,(ErlNifMutex *mtx)); +ERL_NIF_API_FUNC_DECL(ErlNifCond*,enif_cond_create,(char *name)); +ERL_NIF_API_FUNC_DECL(void,enif_cond_destroy,(ErlNifCond *cnd)); +ERL_NIF_API_FUNC_DECL(void,enif_cond_signal,(ErlNifCond *cnd)); +ERL_NIF_API_FUNC_DECL(void,enif_cond_broadcast,(ErlNifCond *cnd)); +ERL_NIF_API_FUNC_DECL(void,enif_cond_wait,(ErlNifCond *cnd, ErlNifMutex *mtx)); +ERL_NIF_API_FUNC_DECL(ErlNifRWLock*,enif_rwlock_create,(char *name)); +ERL_NIF_API_FUNC_DECL(void,enif_rwlock_destroy,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(int,enif_rwlock_tryrlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(void,enif_rwlock_runlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(int,enif_rwlock_tryrwlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rwlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rwunlock,(ErlNifRWLock *rwlck)); +ERL_NIF_API_FUNC_DECL(int,enif_tsd_key_create,(char *name, ErlNifTSDKey *key)); +ERL_NIF_API_FUNC_DECL(void,enif_tsd_key_destroy,(ErlNifTSDKey key)); +ERL_NIF_API_FUNC_DECL(void,enif_tsd_set,(ErlNifTSDKey key, void *data)); +ERL_NIF_API_FUNC_DECL(void*,enif_tsd_get,(ErlNifTSDKey key)); +ERL_NIF_API_FUNC_DECL(ErlNifThreadOpts*,enif_thread_opts_create,(char *name)); +ERL_NIF_API_FUNC_DECL(void,enif_thread_opts_destroy,(ErlNifThreadOpts *opts)); +ERL_NIF_API_FUNC_DECL(int,enif_thread_create,(char *name,ErlNifTid *tid,void * (*func)(void *),void *args,ErlNifThreadOpts *opts)); +ERL_NIF_API_FUNC_DECL(ErlNifTid,enif_thread_self,(void)); +ERL_NIF_API_FUNC_DECL(int,enif_equal_tids,(ErlNifTid tid1, ErlNifTid tid2)); +ERL_NIF_API_FUNC_DECL(void,enif_thread_exit,(void *resp)); +ERL_NIF_API_FUNC_DECL(int,enif_thread_join,(ErlNifTid, void **respp)); + +ERL_NIF_API_FUNC_DECL(void*,enif_realloc,(void* ptr, size_t size)); +ERL_NIF_API_FUNC_DECL(void,enif_system_info,(ErlNifSysInfo *sip, size_t si_size)); +ERL_NIF_API_FUNC_DECL(int,enif_fprintf,(void/* FILE* */ *filep, const char *format, ...)); +ERL_NIF_API_FUNC_DECL(int,enif_inspect_iolist_as_binary,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_sub_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, size_t pos, size_t size)); +ERL_NIF_API_FUNC_DECL(int,enif_get_string,(ErlNifEnv*, ERL_NIF_TERM list, char* buf, unsigned len, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(int,enif_get_atom,(ErlNifEnv*, ERL_NIF_TERM atom, char* buf, unsigned len, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(int,enif_is_fun,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_pid,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_port,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_get_uint,(ErlNifEnv*, ERL_NIF_TERM term, unsigned* ip)); +ERL_NIF_API_FUNC_DECL(int,enif_get_long,(ErlNifEnv*, ERL_NIF_TERM term, long* ip)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint,(ErlNifEnv*, unsigned i)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_long,(ErlNifEnv*, long i)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple_from_array,(ErlNifEnv*, const ERL_NIF_TERM arr[], unsigned cnt)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_from_array,(ErlNifEnv*, const ERL_NIF_TERM arr[], unsigned cnt)); +ERL_NIF_API_FUNC_DECL(int,enif_is_empty_list,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(ErlNifResourceType*,enif_open_resource_type,(ErlNifEnv*, const char* module_str, const char* name_str, void (*dtor)(ErlNifEnv*,void *), ErlNifResourceFlags flags, ErlNifResourceFlags* tried)); +ERL_NIF_API_FUNC_DECL(void*,enif_alloc_resource,(ErlNifResourceType* type, size_t size)); +ERL_NIF_API_FUNC_DECL(void,enif_release_resource,(void* obj)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource,(ErlNifEnv*, void* obj)); +ERL_NIF_API_FUNC_DECL(int,enif_get_resource,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp)); +ERL_NIF_API_FUNC_DECL(size_t,enif_sizeof_resource,(void* obj)); +ERL_NIF_API_FUNC_DECL(unsigned char*,enif_make_new_binary,(ErlNifEnv*,size_t size,ERL_NIF_TERM* termp)); +ERL_NIF_API_FUNC_DECL(int,enif_is_list,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_tuple,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_get_atom_length,(ErlNifEnv*, ERL_NIF_TERM atom, unsigned* len, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(int,enif_get_list_length,(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_atom_len,(ErlNifEnv* env, const char* name, size_t len)); +ERL_NIF_API_FUNC_DECL(int, enif_make_existing_atom_len,(ErlNifEnv* env, const char* name, size_t len, ERL_NIF_TERM* atom, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_string_len,(ErlNifEnv* env, const char* string, size_t len, ErlNifCharEncoding)); +ERL_NIF_API_FUNC_DECL(ErlNifEnv*,enif_alloc_env,(void)); +ERL_NIF_API_FUNC_DECL(void,enif_free_env,(ErlNifEnv* env)); +ERL_NIF_API_FUNC_DECL(void,enif_clear_env,(ErlNifEnv* env)); +ERL_NIF_API_FUNC_DECL(int,enif_send,(ErlNifEnv* env, const ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_copy,(ErlNifEnv* dst_env, ERL_NIF_TERM src_term)); +ERL_NIF_API_FUNC_DECL(ErlNifPid*,enif_self,(ErlNifEnv* caller_env, ErlNifPid* pid)); +ERL_NIF_API_FUNC_DECL(int,enif_get_local_pid,(ErlNifEnv* env, ERL_NIF_TERM, ErlNifPid* pid)); +ERL_NIF_API_FUNC_DECL(void,enif_keep_resource,(void* obj)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource_binary,(ErlNifEnv*,void* obj,const void* data, size_t size)); +#if SIZEOF_LONG != 8 +ERL_NIF_API_FUNC_DECL(int,enif_get_int64,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifSInt64* ip)); +ERL_NIF_API_FUNC_DECL(int,enif_get_uint64,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifUInt64* ip)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int64,(ErlNifEnv*, ErlNifSInt64)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64)); +#endif +ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, ERL_NIF_TERM *list)); +ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(void*,enif_dlopen,(const char* lib, void (*err_handler)(void*,const char*), void* err_arg)); +ERL_NIF_API_FUNC_DECL(void*,enif_dlsym,(void* handle, const char* symbol, void (*err_handler)(void*,const char*), void* err_arg)); +ERL_NIF_API_FUNC_DECL(int,enif_consume_timeslice,(ErlNifEnv*, int percent)); + +/* +** Add new entries here to keep compatibility on Windows!!! +*/ +#endif + +/* +** Please keep the ERL_NIF_API_FUNC_MACRO list below in the same order +** as the ERL_NIF_API_FUNC_DECL list above +*/ +#ifdef ERL_NIF_API_FUNC_MACRO +# define enif_priv_data ERL_NIF_API_FUNC_MACRO(enif_priv_data) +# define enif_alloc ERL_NIF_API_FUNC_MACRO(enif_alloc) +# define enif_free ERL_NIF_API_FUNC_MACRO(enif_free) +# define enif_is_atom ERL_NIF_API_FUNC_MACRO(enif_is_atom) +# define enif_is_binary ERL_NIF_API_FUNC_MACRO(enif_is_binary) +# define enif_is_ref ERL_NIF_API_FUNC_MACRO(enif_is_ref) +# define enif_inspect_binary ERL_NIF_API_FUNC_MACRO(enif_inspect_binary) +# define enif_alloc_binary ERL_NIF_API_FUNC_MACRO(enif_alloc_binary) +# define enif_realloc_binary ERL_NIF_API_FUNC_MACRO(enif_realloc_binary) +# define enif_release_binary ERL_NIF_API_FUNC_MACRO(enif_release_binary) +# define enif_get_int ERL_NIF_API_FUNC_MACRO(enif_get_int) +# define enif_get_ulong ERL_NIF_API_FUNC_MACRO(enif_get_ulong) +# define enif_get_double ERL_NIF_API_FUNC_MACRO(enif_get_double) +# define enif_get_tuple ERL_NIF_API_FUNC_MACRO(enif_get_tuple) +# define enif_get_list_cell ERL_NIF_API_FUNC_MACRO(enif_get_list_cell) +# define enif_is_identical ERL_NIF_API_FUNC_MACRO(enif_is_identical) +# define enif_compare ERL_NIF_API_FUNC_MACRO(enif_compare) + +# define enif_make_binary ERL_NIF_API_FUNC_MACRO(enif_make_binary) +# define enif_make_badarg ERL_NIF_API_FUNC_MACRO(enif_make_badarg) +# define enif_make_int ERL_NIF_API_FUNC_MACRO(enif_make_int) +# define enif_make_ulong ERL_NIF_API_FUNC_MACRO(enif_make_ulong) +# define enif_make_double ERL_NIF_API_FUNC_MACRO(enif_make_double) +# define enif_make_atom ERL_NIF_API_FUNC_MACRO(enif_make_atom) +# define enif_make_existing_atom ERL_NIF_API_FUNC_MACRO(enif_make_existing_atom) +# define enif_make_tuple ERL_NIF_API_FUNC_MACRO(enif_make_tuple) +# define enif_make_list ERL_NIF_API_FUNC_MACRO(enif_make_list) +# define enif_make_list_cell ERL_NIF_API_FUNC_MACRO(enif_make_list_cell) +# define enif_make_string ERL_NIF_API_FUNC_MACRO(enif_make_string) +# define enif_make_ref ERL_NIF_API_FUNC_MACRO(enif_make_ref) + +# define enif_mutex_create ERL_NIF_API_FUNC_MACRO(enif_mutex_create) +# define enif_mutex_destroy ERL_NIF_API_FUNC_MACRO(enif_mutex_destroy) +# define enif_mutex_trylock ERL_NIF_API_FUNC_MACRO(enif_mutex_trylock) +# define enif_mutex_lock ERL_NIF_API_FUNC_MACRO(enif_mutex_lock) +# define enif_mutex_unlock ERL_NIF_API_FUNC_MACRO(enif_mutex_unlock) +# define enif_cond_create ERL_NIF_API_FUNC_MACRO(enif_cond_create) +# define enif_cond_destroy ERL_NIF_API_FUNC_MACRO(enif_cond_destroy) +# define enif_cond_signal ERL_NIF_API_FUNC_MACRO(enif_cond_signal) +# define enif_cond_broadcast ERL_NIF_API_FUNC_MACRO(enif_cond_broadcast) +# define enif_cond_wait ERL_NIF_API_FUNC_MACRO(enif_cond_wait) +# define enif_rwlock_create ERL_NIF_API_FUNC_MACRO(enif_rwlock_create) +# define enif_rwlock_destroy ERL_NIF_API_FUNC_MACRO(enif_rwlock_destroy) +# define enif_rwlock_tryrlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_tryrlock) +# define enif_rwlock_rlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rlock) +# define enif_rwlock_runlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_runlock) +# define enif_rwlock_tryrwlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_tryrwlock) +# define enif_rwlock_rwlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rwlock) +# define enif_rwlock_rwunlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rwunlock) +# define enif_tsd_key_create ERL_NIF_API_FUNC_MACRO(enif_tsd_key_create) +# define enif_tsd_key_destroy ERL_NIF_API_FUNC_MACRO(enif_tsd_key_destroy) +# define enif_tsd_set ERL_NIF_API_FUNC_MACRO(enif_tsd_set) +# define enif_tsd_get ERL_NIF_API_FUNC_MACRO(enif_tsd_get) +# define enif_thread_opts_create ERL_NIF_API_FUNC_MACRO(enif_thread_opts_create) +# define enif_thread_opts_destroy ERL_NIF_API_FUNC_MACRO(enif_thread_opts_destroy) +# define enif_thread_create ERL_NIF_API_FUNC_MACRO(enif_thread_create) +# define enif_thread_self ERL_NIF_API_FUNC_MACRO(enif_thread_self) +# define enif_equal_tids ERL_NIF_API_FUNC_MACRO(enif_equal_tids) +# define enif_thread_exit ERL_NIF_API_FUNC_MACRO(enif_thread_exit) +# define enif_thread_join ERL_NIF_API_FUNC_MACRO(enif_thread_join) + +# define enif_realloc ERL_NIF_API_FUNC_MACRO(enif_realloc) +# define enif_system_info ERL_NIF_API_FUNC_MACRO(enif_system_info) +# define enif_fprintf ERL_NIF_API_FUNC_MACRO(enif_fprintf) +# define enif_inspect_iolist_as_binary ERL_NIF_API_FUNC_MACRO(enif_inspect_iolist_as_binary) +# define enif_make_sub_binary ERL_NIF_API_FUNC_MACRO(enif_make_sub_binary) +# define enif_get_string ERL_NIF_API_FUNC_MACRO(enif_get_string) +# define enif_get_atom ERL_NIF_API_FUNC_MACRO(enif_get_atom) +# define enif_is_fun ERL_NIF_API_FUNC_MACRO(enif_is_fun) +# define enif_is_pid ERL_NIF_API_FUNC_MACRO(enif_is_pid) +# define enif_is_port ERL_NIF_API_FUNC_MACRO(enif_is_port) +# define enif_get_uint ERL_NIF_API_FUNC_MACRO(enif_get_uint) +# define enif_get_long ERL_NIF_API_FUNC_MACRO(enif_get_long) +# define enif_make_uint ERL_NIF_API_FUNC_MACRO(enif_make_uint) +# define enif_make_long ERL_NIF_API_FUNC_MACRO(enif_make_long) +# define enif_make_tuple_from_array ERL_NIF_API_FUNC_MACRO(enif_make_tuple_from_array) +# define enif_make_list_from_array ERL_NIF_API_FUNC_MACRO(enif_make_list_from_array) +# define enif_is_empty_list ERL_NIF_API_FUNC_MACRO(enif_is_empty_list) +# define enif_open_resource_type ERL_NIF_API_FUNC_MACRO(enif_open_resource_type) +# define enif_alloc_resource ERL_NIF_API_FUNC_MACRO(enif_alloc_resource) +# define enif_release_resource ERL_NIF_API_FUNC_MACRO(enif_release_resource) +# define enif_make_resource ERL_NIF_API_FUNC_MACRO(enif_make_resource) +# define enif_get_resource ERL_NIF_API_FUNC_MACRO(enif_get_resource) +# define enif_sizeof_resource ERL_NIF_API_FUNC_MACRO(enif_sizeof_resource) +# define enif_make_new_binary ERL_NIF_API_FUNC_MACRO(enif_make_new_binary) +# define enif_is_list ERL_NIF_API_FUNC_MACRO(enif_is_list) +# define enif_is_tuple ERL_NIF_API_FUNC_MACRO(enif_is_tuple) +# define enif_get_atom_length ERL_NIF_API_FUNC_MACRO(enif_get_atom_length) +# define enif_get_list_length ERL_NIF_API_FUNC_MACRO(enif_get_list_length) +# define enif_make_atom_len ERL_NIF_API_FUNC_MACRO(enif_make_atom_len) +# define enif_make_existing_atom_len ERL_NIF_API_FUNC_MACRO(enif_make_existing_atom_len) +# define enif_make_string_len ERL_NIF_API_FUNC_MACRO(enif_make_string_len) +# define enif_alloc_env ERL_NIF_API_FUNC_MACRO(enif_alloc_env) +# define enif_free_env ERL_NIF_API_FUNC_MACRO(enif_free_env) +# define enif_clear_env ERL_NIF_API_FUNC_MACRO(enif_clear_env) +# define enif_send ERL_NIF_API_FUNC_MACRO(enif_send) +# define enif_make_copy ERL_NIF_API_FUNC_MACRO(enif_make_copy) +# define enif_self ERL_NIF_API_FUNC_MACRO(enif_self) +# define enif_get_local_pid ERL_NIF_API_FUNC_MACRO(enif_get_local_pid) +# define enif_keep_resource ERL_NIF_API_FUNC_MACRO(enif_keep_resource) +# define enif_make_resource_binary ERL_NIF_API_FUNC_MACRO(enif_make_resource_binary) +#if SIZEOF_LONG != 8 +# define enif_get_int64 ERL_NIF_API_FUNC_MACRO(enif_get_int64) +# define enif_get_uint64 ERL_NIF_API_FUNC_MACRO(enif_get_uint64) +# define enif_make_int64 ERL_NIF_API_FUNC_MACRO(enif_make_int64) +# define enif_make_uint64 ERL_NIF_API_FUNC_MACRO(enif_make_uint64) +#endif + +# define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception) +# define enif_make_reverse_list ERL_NIF_API_FUNC_MACRO(enif_make_reverse_list) +# define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number) +# define enif_dlopen ERL_NIF_API_FUNC_MACRO(enif_dlopen) +# define enif_dlsym ERL_NIF_API_FUNC_MACRO(enif_dlsym) +# define enif_consume_timeslice ERL_NIF_API_FUNC_MACRO(enif_consume_timeslice) + +/* +** Add new entries here +*/ +#endif + + +#if defined(__GNUC__) && !(defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) + +/* Inline functions for compile time type checking of arguments to + variadic functions. +*/ + +# define ERL_NIF_INLINE __inline__ + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple1(ErlNifEnv* env, + ERL_NIF_TERM e1) +{ + return enif_make_tuple(env, 1, e1); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple2(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2) +{ + return enif_make_tuple(env, 2, e1, e2); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple3(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3) +{ + return enif_make_tuple(env, 3, e1, e2, e3); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple4(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4) +{ + return enif_make_tuple(env, 4, e1, e2, e3, e4); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple5(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5) +{ + return enif_make_tuple(env, 5, e1, e2, e3, e4, e5); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple6(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6) +{ + return enif_make_tuple(env, 6, e1, e2, e3, e4, e5, e6); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple7(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7) +{ + return enif_make_tuple(env, 7, e1, e2, e3, e4, e5, e6, e7); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple8(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8) +{ + return enif_make_tuple(env, 8, e1, e2, e3, e4, e5, e6, e7, e8); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple9(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8, + ERL_NIF_TERM e9) +{ + return enif_make_tuple(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list1(ErlNifEnv* env, + ERL_NIF_TERM e1) +{ + return enif_make_list(env, 1, e1); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list2(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2) +{ + return enif_make_list(env, 2, e1, e2); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list3(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3) +{ + return enif_make_list(env, 3, e1, e2, e3); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list4(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4) +{ + return enif_make_list(env, 4, e1, e2, e3, e4); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list5(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5) +{ + return enif_make_list(env, 5, e1, e2, e3, e4, e5); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list6(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6) +{ + return enif_make_list(env, 6, e1, e2, e3, e4, e5, e6); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list7(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7) +{ + return enif_make_list(env, 7, e1, e2, e3, e4, e5, e6, e7); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list8(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8) +{ + return enif_make_list(env, 8, e1, e2, e3, e4, e5, e6, e7, e8); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8, + ERL_NIF_TERM e9) +{ + return enif_make_list(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9); +} + +# undef ERL_NIF_INLINE + +#else /* fallback with macros */ + +#ifndef enif_make_list1 +# define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1) +# define enif_make_list2(ENV,E1,E2) enif_make_list(ENV,2,E1,E2) +# define enif_make_list3(ENV,E1,E2,E3) enif_make_list(ENV,3,E1,E2,E3) +# define enif_make_list4(ENV,E1,E2,E3,E4) enif_make_list(ENV,4,E1,E2,E3,E4) +# define enif_make_list5(ENV,E1,E2,E3,E4,E5) enif_make_list(ENV,5,E1,E2,E3,E4,E5) +# define enif_make_list6(ENV,E1,E2,E3,E4,E5,E6) enif_make_list(ENV,6,E1,E2,E3,E4,E5,E6) +# define enif_make_list7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_list(ENV,7,E1,E2,E3,E4,E5,E6,E7) +# define enif_make_list8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_list(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8) +# define enif_make_list9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_list(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9) +# define enif_make_tuple1(ENV,E1) enif_make_tuple(ENV,1,E1) +# define enif_make_tuple2(ENV,E1,E2) enif_make_tuple(ENV,2,E1,E2) +# define enif_make_tuple3(ENV,E1,E2,E3) enif_make_tuple(ENV,3,E1,E2,E3) +# define enif_make_tuple4(ENV,E1,E2,E3,E4) enif_make_tuple(ENV,4,E1,E2,E3,E4) +# define enif_make_tuple5(ENV,E1,E2,E3,E4,E5) enif_make_tuple(ENV,5,E1,E2,E3,E4,E5) +# define enif_make_tuple6(ENV,E1,E2,E3,E4,E5,E6) enif_make_tuple(ENV,6,E1,E2,E3,E4,E5,E6) +# define enif_make_tuple7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_tuple(ENV,7,E1,E2,E3,E4,E5,E6,E7) +# define enif_make_tuple8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_tuple(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8) +# define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9) +#endif + +#endif /* __GNUC__ && !WIN32 */ + +#ifndef enif_make_pid + +# define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid)) + +#if SIZEOF_LONG == 8 +# define enif_get_int64 enif_get_long +# define enif_get_uint64 enif_get_ulong +# define enif_make_int64 enif_make_long +# define enif_make_uint64 enif_make_ulong +#endif + +#endif + diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_0.c b/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_0.c new file mode 100644 index 0000000000..a554cc7f25 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_0.c @@ -0,0 +1,4 @@ +#include "nif_api_2_0/erl_nif.h" + +#define NIF_LIB_VER 1 +#include "nif_mod.c" diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_4.c b/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_4.c new file mode 100644 index 0000000000..6d28dbb8ba --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_4.c @@ -0,0 +1,4 @@ +#include "nif_api_2_4/erl_nif.h" + +#define NIF_LIB_VER 1 +#include "nif_mod.c" diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_0.c b/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_0.c new file mode 100644 index 0000000000..0731e6b5d0 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_0.c @@ -0,0 +1,4 @@ +#include "nif_api_2_0/erl_nif.h" + +#define NIF_LIB_VER 2 +#include "nif_mod.c" diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_4.c b/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_4.c new file mode 100644 index 0000000000..628fd42b52 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_4.c @@ -0,0 +1,4 @@ +#include "nif_api_2_4/erl_nif.h" + +#define NIF_LIB_VER 2 +#include "nif_mod.c" diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_0.c b/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_0.c new file mode 100644 index 0000000000..d7e676b668 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_0.c @@ -0,0 +1,4 @@ +#include "nif_api_2_0/erl_nif.h" + +#define NIF_LIB_VER 3 +#include "nif_mod.c" diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_4.c b/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_4.c new file mode 100644 index 0000000000..bdbe8cf381 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_4.c @@ -0,0 +1,4 @@ +#include "nif_api_2_4/erl_nif.h" + +#define NIF_LIB_VER 3 +#include "nif_mod.c" diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c index 11b5d0cc35..885b8ebaf8 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.c +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c @@ -1,22 +1,23 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-2017. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ -#include "erl_nif.h" +#include <erl_nif.h> #include <string.h> #include <stdio.h> @@ -175,6 +176,7 @@ static void do_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info, int* retvalp) CHECK(enif_is_empty_list(env, head)); } +#if NIF_LIB_VER != 3 static int load(ErlNifEnv* env, void** priv, ERL_NIF_TERM load_info) { NifModPrivData* data; @@ -229,6 +231,7 @@ static void unload(ErlNifEnv* env, void* priv) add_call(env, data, "unload"); NifModPrivData_release(data); } +#endif /* NIF_LIB_VER != 3 */ static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -236,10 +239,22 @@ static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg return enif_make_int(env, NIF_LIB_VER); } +static ERL_NIF_TERM nif_api_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + /*ADD_CALL("nif_api_version");*/ + return enif_make_tuple2(env, + enif_make_int(env, ERL_NIF_MAJOR_VERSION), + enif_make_int(env, ERL_NIF_MINOR_VERSION)); +} + static ERL_NIF_TERM get_priv_data_ptr(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + NifModPrivData** bin_data; + ERL_NIF_TERM res; ADD_CALL("get_priv_data_ptr"); - return enif_make_ulong(env, (unsigned long)priv_data(env)); + bin_data = (NifModPrivData**)enif_make_new_binary(env, sizeof(void*), &res); + *bin_data = priv_data(env); + return res; } static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -278,6 +293,7 @@ static ERL_NIF_TERM get_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, + {"nif_api_version", 0, nif_api_version}, {"get_priv_data_ptr", 0, get_priv_data_ptr}, {"make_new_resource", 2, make_new_resource}, {"get_resource", 2, get_resource} diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.erl b/erts/emulator/test/nif_SUITE_data/nif_mod.erl index 6634624698..8019cfcf82 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.erl +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.erl @@ -1,44 +1,66 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(nif_mod). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([load_nif_lib/2, load_nif_lib/3, start/0, lib_version/0, call_history/0, +-export([load_nif_lib/2, load_nif_lib/3, start/0, lib_version/0, get_priv_data_ptr/0, make_new_resource/2, get_resource/2]). -export([loop/0, upgrade/1]). -define(nif_stub,nif_stub_error(?LINE)). +-ifdef(USE_ON_LOAD). +-on_load(on_load/0). + +on_load() -> + [{data_dir, Path}] = ets:lookup(nif_SUITE, data_dir), + [{lib_version, Ver}] = ets:lookup(nif_SUITE, lib_version), + [{nif_api_version, API}] = ets:lookup(nif_SUITE, nif_api_version), + R = erlang:load_nif(filename:join(Path,libname(Ver,API)), []), + check_api_version(R, API). + +-endif. + +check_api_version(Err, _) when Err =/= ok -> Err; +check_api_version(ok, []) -> ok; +check_api_version(ok, [$., MajC, $_ | MinS]) -> + {Maj, Min} = {list_to_integer([MajC]), list_to_integer(MinS)}, + {Maj, Min} = nif_api_version(), + ok. + load_nif_lib(Config, Ver) -> load_nif_lib(Config, Ver, []). load_nif_lib(Config, Ver, LoadInfo) -> - ?line Path = ?config(data_dir, Config), - erlang:load_nif(filename:join(Path,libname(Ver)), LoadInfo). - -libname(no_init) -> libname(3); -libname(Ver) when is_integer(Ver) -> - "nif_mod." ++ integer_to_list(Ver). + Path = proplists:get_value(data_dir, Config), + API = proplists:get_value(nif_api_version, Config, ""), + R = erlang:load_nif(filename:join(Path,libname(Ver,API)), LoadInfo), + check_api_version(R, API). +libname(no_init,API) -> libname(3,API); +libname(Ver,API) when is_integer(Ver) -> + "nif_mod." ++ integer_to_list(Ver) ++ API. + start() -> spawn_opt(?MODULE,loop,[], [link, monitor]). @@ -61,7 +83,9 @@ upgrade(Pid) -> lib_version() -> % NIF undefined. -call_history() -> ?nif_stub. +nif_api_version() -> %NIF + {undefined,undefined}. + get_priv_data_ptr() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. get_resource(_,_) -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/testcase_driver.h b/erts/emulator/test/nif_SUITE_data/testcase_driver.h index 98339e4746..feb10ecaea 100644 --- a/erts/emulator/test/nif_SUITE_data/testcase_driver.h +++ b/erts/emulator/test/nif_SUITE_data/testcase_driver.h @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings @@ -19,7 +20,7 @@ #ifndef TESTCASE_DRIVER_H__ #define TESTCASE_DRIVER_H__ -#include "erl_nif.h" +#include <erl_nif.h> #include <stdlib.h> #include <stdio.h> diff --git a/erts/emulator/test/nif_SUITE_data/tester.c b/erts/emulator/test/nif_SUITE_data/tester.c index 257b116322..ea4afd924d 100644 --- a/erts/emulator/test/nif_SUITE_data/tester.c +++ b/erts/emulator/test/nif_SUITE_data/tester.c @@ -1,4 +1,4 @@ -#include "erl_nif.h" +#include <erl_nif.h> #include <stdio.h> #include <stdarg.h> @@ -53,7 +53,7 @@ void testcase_free(void *ptr) void testcase_run(TestCaseState_t *tcs); -static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info) { return 0; } @@ -70,5 +70,5 @@ static ErlNifFunc nif_funcs[] = {"run", 0, run} }; -ERL_NIF_INIT(tester,nif_funcs,NULL,reload,NULL,NULL) +ERL_NIF_INIT(tester,nif_funcs,NULL,NULL,upgrade,NULL) diff --git a/erts/emulator/test/nif_SUITE_data/tester.erl b/erts/emulator/test/nif_SUITE_data/tester.erl index b393e29b82..f955f99c9a 100644 --- a/erts/emulator/test/nif_SUITE_data/tester.erl +++ b/erts/emulator/test/nif_SUITE_data/tester.erl @@ -1,12 +1,11 @@ -module(tester). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([load_nif_lib/2, run/0]). - load_nif_lib(Config, LibName) -> - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erlang:load_nif(filename:join(Path,LibName), []). run() -> diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index 3f9b339ed2..be90f929df 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,84 +28,70 @@ -module(node_container_SUITE). -author('[email protected]'). -%-define(line_trace, 1). +-include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server.hrl"). - -%-compile(export_all). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, init_per_testcase/2, - end_per_testcase/2, - node_container_refc_check/1]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2, + node_container_refc_check/1]). -export([term_to_binary_to_term_eq/1, - round_trip_eq/1, - cmp/1, - ref_eq/1, - node_table_gc/1, - dist_link_refc/1, - dist_monitor_refc/1, - node_controller_refc/1, - ets_refc/1, - match_spec_refc/1, - timer_refc/1, - otp_4715/1, - pid_wrap/1, - port_wrap/1, - bad_nc/1, - unique_pid/1, - iter_max_procs/1]). - --define(DEFAULT_TIMEOUT, ?t:minutes(10)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. + round_trip_eq/1, + cmp/1, + ref_eq/1, + node_table_gc/1, + dist_link_refc/1, + dist_monitor_refc/1, + node_controller_refc/1, + ets_refc/1, + match_spec_refc/1, + timer_refc/1, + pid_wrap/1, + port_wrap/1, + bad_nc/1, + unique_pid/1, + iter_max_procs/1, + magic_ref/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 12}}]. + all() -> [term_to_binary_to_term_eq, round_trip_eq, cmp, ref_eq, node_table_gc, dist_link_refc, dist_monitor_refc, node_controller_refc, ets_refc, match_spec_refc, - timer_refc, otp_4715, pid_wrap, port_wrap, bad_nc, - unique_pid, iter_max_procs]. - -groups() -> - []. + timer_refc, pid_wrap, port_wrap, bad_nc, + unique_pid, iter_max_procs, magic_ref]. init_per_suite(Config) -> Config. end_per_suite(_Config) -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value available_internal_state(false). -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - available_internal_state(Bool) when Bool == true; Bool == false -> case {Bool, - (catch erts_debug:get_internal_state(available_internal_state))} of - {true, true} -> - true; - {false, true} -> - erts_debug:set_internal_state(available_internal_state, false), - true; - {true, _} -> - erts_debug:set_internal_state(available_internal_state, true), - false; - {false, _} -> - false + (catch erts_debug:get_internal_state(available_internal_state))} of + {true, true} -> + true; + {false, true} -> + erts_debug:set_internal_state(available_internal_state, false), + true; + {true, _} -> + erts_debug:set_internal_state(available_internal_state, true), + false; + {false, _} -> + false end. init_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), available_internal_state(true), - [{watchdog, Dog}|Config]. + Config. end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), ok. %%% @@ -116,111 +103,108 @@ end_per_testcase(_Case, Config) when is_list(Config) -> %% %% Test case: term_to_binary_to_term_eq %% -term_to_binary_to_term_eq(doc) -> - ["Tests that node container terms that are converted to external format " - "and back stay equal to themselves."]; -term_to_binary_to_term_eq(suite) -> []; +%% Tests that node container terms that are converted to external format +%% and back stay equal to themselves. term_to_binary_to_term_eq(Config) when is_list(Config) -> - ?line ThisNode = {node(), erlang:system_info(creation)}, + ThisNode = {node(), erlang:system_info(creation)}, % Get local node containers - ?line LPid = self(), - ?line LXPid = mk_pid(ThisNode, 32767, 8191), - ?line LPort = hd(erlang:ports()), - ?line LXPort = mk_port(ThisNode, 268435455), - ?line LLRef = make_ref(), - ?line LHLRef = mk_ref(ThisNode, [47, 11]), - ?line LSRef = mk_ref(ThisNode, [4711]), + LPid = self(), + LXPid = mk_pid(ThisNode, 32767, 8191), + LPort = hd(erlang:ports()), + LXPort = mk_port(ThisNode, 268435455), + LLRef = make_ref(), + LHLRef = mk_ref(ThisNode, [47, 11]), + LSRef = mk_ref(ThisNode, [4711]), % Test local nc:s - ?line LPid = binary_to_term(term_to_binary(LPid)), - ?line LXPid = binary_to_term(term_to_binary(LXPid)), - ?line LPort = binary_to_term(term_to_binary(LPort)), - ?line LXPort = binary_to_term(term_to_binary(LXPort)), - ?line LLRef = binary_to_term(term_to_binary(LLRef)), - ?line LHLRef = binary_to_term(term_to_binary(LHLRef)), - ?line LSRef = binary_to_term(term_to_binary(LSRef)), + LPid = binary_to_term(term_to_binary(LPid)), + LXPid = binary_to_term(term_to_binary(LXPid)), + LPort = binary_to_term(term_to_binary(LPort)), + LXPort = binary_to_term(term_to_binary(LXPort)), + LLRef = binary_to_term(term_to_binary(LLRef)), + LHLRef = binary_to_term(term_to_binary(LHLRef)), + LSRef = binary_to_term(term_to_binary(LSRef)), % Get remote node containers - ?line RNode = {get_nodename(), 3}, - ?line RPid = mk_pid(RNode, 4711, 1), - ?line RXPid = mk_pid(RNode, 32767, 8191), - ?line RPort = mk_port(RNode, 4711), - ?line RXPort = mk_port(RNode, 268435455), - ?line RLRef = mk_ref(RNode, [4711, 4711, 4711]), - ?line RHLRef = mk_ref(RNode, [4711, 4711]), - ?line RSRef = mk_ref(RNode, [4711]), + ttbtteq_do_remote({get_nodename(), 3}), + ttbtteq_do_remote({get_nodename(), 4}), + ttbtteq_do_remote({get_nodename(), 16#adec0ded}), + nc_refc_check(node()), + ok. + +ttbtteq_do_remote(RNode) -> + RPid = mk_pid(RNode, 4711, 1), + RXPid = mk_pid(RNode, 32767, 8191), + RPort = mk_port(RNode, 4711), + RXPort = mk_port(RNode, 268435455), + RLRef = mk_ref(RNode, [4711, 4711, 4711]), + RHLRef = mk_ref(RNode, [4711, 4711]), + RSRef = mk_ref(RNode, [4711]), % Test remote nc:s - ?line RPid = binary_to_term(term_to_binary(RPid)), - ?line RXPid = binary_to_term(term_to_binary(RXPid)), - ?line RPort = binary_to_term(term_to_binary(RPort)), - ?line RXPort = binary_to_term(term_to_binary(RXPort)), - ?line RLRef = binary_to_term(term_to_binary(RLRef)), - ?line RHLRef = binary_to_term(term_to_binary(RHLRef)), - ?line RSRef = binary_to_term(term_to_binary(RSRef)), - ?line nc_refc_check(node()), - ?line ok. + RPid = binary_to_term(term_to_binary(RPid)), + RXPid = binary_to_term(term_to_binary(RXPid)), + RPort = binary_to_term(term_to_binary(RPort)), + RXPort = binary_to_term(term_to_binary(RXPort)), + RLRef = binary_to_term(term_to_binary(RLRef)), + RHLRef = binary_to_term(term_to_binary(RHLRef)), + RSRef = binary_to_term(term_to_binary(RSRef)), + ok. %% %% Test case: round_trip_eq %% -round_trip_eq(doc) -> - ["Tests that node containers that are sent beteen nodes stay equal to " - "themselves."]; -round_trip_eq(suite) -> []; +%% Tests that node containers that are sent between nodes stay equal to themselves. round_trip_eq(Config) when is_list(Config) -> - ?line ThisNode = {node(), erlang:system_info(creation)}, - ?line NodeFirstName = get_nodefirstname(), - ?line ?line {ok, Node} = start_node(NodeFirstName), - ?line Self = self(), - ?line RPid = spawn_link(Node, - fun () -> - receive - {Self, Data} -> - Self ! {self(), Data} - end - end), - ?line SentPid = self(), - ?line SentXPid = mk_pid(ThisNode, 17471, 8190), - ?line SentPort = hd(erlang:ports()), - ?line SentXPort = mk_port(ThisNode, 268435451), - ?line SentLRef = make_ref(), - ?line SentHLRef = mk_ref(ThisNode, [4711, 17]), - ?line SentSRef = mk_ref(ThisNode, [4711]), - ?line RPid ! {Self, {SentPid, - SentXPid, - SentPort, - SentXPort, - SentLRef, - SentHLRef, - SentSRef}}, + ThisNode = {node(), erlang:system_info(creation)}, + NodeFirstName = get_nodefirstname(), + {ok, Node} = start_node(NodeFirstName), + Self = self(), + RPid = spawn_link(Node, + fun () -> + receive + {Self, Data} -> + Self ! {self(), Data} + end + end), + SentPid = self(), + SentXPid = mk_pid(ThisNode, 17471, 8190), + SentPort = hd(erlang:ports()), + SentXPort = mk_port(ThisNode, 268435451), + SentLRef = make_ref(), + SentHLRef = mk_ref(ThisNode, [4711, 17]), + SentSRef = mk_ref(ThisNode, [4711]), + RPid ! {Self, {SentPid, + SentXPid, + SentPort, + SentXPort, + SentLRef, + SentHLRef, + SentSRef}}, receive - {RPid, {RecPid, - RecXPid, - RecPort, - RecXPort, - RecLRef, - RecHLRef, - RecSRef}} -> - ?line stop_node(Node), - ?line SentPid = RecPid, - ?line SentXPid = RecXPid, - ?line SentPort = RecPort, - ?line SentXPort = RecXPort, - ?line SentLRef = RecLRef, - ?line SentHLRef = RecHLRef, - ?line SentSRef = RecSRef, - ?line nc_refc_check(node()), - ?line ok + {RPid, {RecPid, + RecXPid, + RecPort, + RecXPort, + RecLRef, + RecHLRef, + RecSRef}} -> + stop_node(Node), + SentPid = RecPid, + SentXPid = RecXPid, + SentPort = RecPort, + SentXPort = RecXPort, + SentLRef = RecLRef, + SentHLRef = RecHLRef, + SentSRef = RecSRef, + nc_refc_check(node()), + ok end. - + %% %% Test case: cmp %% -cmp(doc) -> - ["Tests that Erlang term comparison works as it should on node " - "containers."]; -cmp(suite) -> []; +%% Tests that Erlang term comparison works as it should on node containers. cmp(Config) when is_list(Config) -> %% Inter type comparison --------------------------------------------------- @@ -231,103 +215,103 @@ cmp(Config) when is_list(Config) -> IRef = make_ref(), ERef = mk_ref({get_nodename(), 2}, [1,2,3]), - + IPid = self(), EPid = mk_pid(RNode, 1, 2), IPort = hd(erlang:ports()), EPort = mk_port(RNode, 1), - + %% Test pids ---------------------------------------------------- - ?line true = 1 < IPid, - ?line true = 1.3 < IPid, - ?line true = (1 bsl 64) < IPid, - ?line true = an_atom < IPid, - ?line true = IRef < IPid, - ?line true = ERef < IPid, - ?line true = fun () -> a_fun end < IPid, - ?line true = IPort < IPid, - ?line true = EPort < IPid, - ?line true = IPid < {a, tuple}, - ?line true = IPid < [], - ?line true = IPid < [a|cons], - ?line true = IPid < <<"a binary">>, - - ?line true = 1 < EPid, - ?line true = 1.3 < EPid, - ?line true = (1 bsl 64) < EPid, - ?line true = an_atom < EPid, - ?line true = IRef < EPid, - ?line true = ERef < EPid, - ?line true = fun () -> a_fun end < EPid, - ?line true = IPort < EPid, - ?line true = EPort < EPid, - ?line true = EPid < {a, tuple}, - ?line true = EPid < [], - ?line true = EPid < [a|cons], - ?line true = EPid < <<"a binary">>, + true = 1 < IPid, + true = 1.3 < IPid, + true = (1 bsl 64) < IPid, + true = an_atom < IPid, + true = IRef < IPid, + true = ERef < IPid, + true = fun () -> a_fun end < IPid, + true = IPort < IPid, + true = EPort < IPid, + true = IPid < {a, tuple}, + true = IPid < [], + true = IPid < [a|cons], + true = IPid < <<"a binary">>, + + true = 1 < EPid, + true = 1.3 < EPid, + true = (1 bsl 64) < EPid, + true = an_atom < EPid, + true = IRef < EPid, + true = ERef < EPid, + true = fun () -> a_fun end < EPid, + true = IPort < EPid, + true = EPort < EPid, + true = EPid < {a, tuple}, + true = EPid < [], + true = EPid < [a|cons], + true = EPid < <<"a binary">>, %% Test ports -------------------------------------------------- - ?line true = 1 < IPort, - ?line true = 1.3 < IPort, - ?line true = (1 bsl 64) < IPort, - ?line true = an_atom < IPort, - ?line true = IRef < IPort, - ?line true = ERef < IPort, - ?line true = fun () -> a_fun end < IPort, - ?line true = IPort < IPid, - ?line true = IPort < EPid, - ?line true = IPort < {a, tuple}, - ?line true = IPort < [], - ?line true = IPort < [a|cons], - ?line true = IPort < <<"a binary">>, - - ?line true = 1 < EPort, - ?line true = 1.3 < EPort, - ?line true = (1 bsl 64) < EPort, - ?line true = an_atom < EPort, - ?line true = IRef < EPort, - ?line true = ERef < EPort, - ?line true = fun () -> a_fun end < EPort, - ?line true = EPort < IPid, - ?line true = EPort < EPid, - ?line true = EPort < {a, tuple}, - ?line true = EPort < [], - ?line true = EPort < [a|cons], - ?line true = EPort < <<"a binary">>, + true = 1 < IPort, + true = 1.3 < IPort, + true = (1 bsl 64) < IPort, + true = an_atom < IPort, + true = IRef < IPort, + true = ERef < IPort, + true = fun () -> a_fun end < IPort, + true = IPort < IPid, + true = IPort < EPid, + true = IPort < {a, tuple}, + true = IPort < [], + true = IPort < [a|cons], + true = IPort < <<"a binary">>, + + true = 1 < EPort, + true = 1.3 < EPort, + true = (1 bsl 64) < EPort, + true = an_atom < EPort, + true = IRef < EPort, + true = ERef < EPort, + true = fun () -> a_fun end < EPort, + true = EPort < IPid, + true = EPort < EPid, + true = EPort < {a, tuple}, + true = EPort < [], + true = EPort < [a|cons], + true = EPort < <<"a binary">>, %% Test refs ---------------------------------------------------- - ?line true = 1 < IRef, - ?line true = 1.3 < IRef, - ?line true = (1 bsl 64) < IRef, - ?line true = an_atom < IRef, - ?line true = IRef < fun () -> a_fun end, - ?line true = IRef < IPort, - ?line true = IRef < EPort, - ?line true = IRef < IPid, - ?line true = IRef < EPid, - ?line true = IRef < {a, tuple}, - ?line true = IRef < [], - ?line true = IRef < [a|cons], - ?line true = IRef < <<"a binary">>, - - ?line true = 1 < ERef, - ?line true = 1.3 < ERef, - ?line true = (1 bsl 64) < ERef, - ?line true = an_atom < ERef, - ?line true = ERef < fun () -> a_fun end, - ?line true = ERef < IPort, - ?line true = ERef < EPort, - ?line true = ERef < IPid, - ?line true = ERef < EPid, - ?line true = ERef < {a, tuple}, - ?line true = ERef < [], - ?line true = ERef < [a|cons], - ?line true = ERef < <<"a binary">>, + true = 1 < IRef, + true = 1.3 < IRef, + true = (1 bsl 64) < IRef, + true = an_atom < IRef, + true = IRef < fun () -> a_fun end, + true = IRef < IPort, + true = IRef < EPort, + true = IRef < IPid, + true = IRef < EPid, + true = IRef < {a, tuple}, + true = IRef < [], + true = IRef < [a|cons], + true = IRef < <<"a binary">>, + + true = 1 < ERef, + true = 1.3 < ERef, + true = (1 bsl 64) < ERef, + true = an_atom < ERef, + true = ERef < fun () -> a_fun end, + true = ERef < IPort, + true = ERef < EPort, + true = ERef < IPid, + true = ERef < EPid, + true = ERef < {a, tuple}, + true = ERef < [], + true = ERef < [a|cons], + true = ERef < <<"a binary">>, %% Intra type comparison --------------------------------------------------- - + %% Test pids ---------------------------------------------------- %% @@ -335,13 +319,13 @@ cmp(Config) when is_list(Config) -> %% serial, number, nodename, creation %% - ?line Pid = mk_pid({b@b, 2}, 4711, 1), + Pid = mk_pid({b@b, 2}, 4711, 1), - ?line true = mk_pid({a@b, 1}, 4710, 2) > Pid, - ?line true = mk_pid({a@b, 1}, 4712, 1) > Pid, - ?line true = mk_pid({c@b, 1}, 4711, 1) > Pid, - ?line true = mk_pid({b@b, 3}, 4711, 1) > Pid, - ?line true = mk_pid({b@b, 2}, 4711, 1) =:= Pid, + true = mk_pid({a@b, 1}, 4710, 2) > Pid, + true = mk_pid({a@b, 1}, 4712, 1) > Pid, + true = mk_pid({c@b, 1}, 4711, 1) > Pid, + true = mk_pid({b@b, 3}, 4711, 1) > Pid, + true = mk_pid({b@b, 2}, 4711, 1) =:= Pid, %% Test ports --------------------------------------------------- %% @@ -353,12 +337,12 @@ cmp(Config) when is_list(Config) -> %% Significance used to be: dist_slot, number, %% creation. - ?line Port = mk_port({b@b, 2}, 4711), + Port = mk_port({b@b, 2}, 4711), - ?line true = mk_port({c@b, 1}, 4710) > Port, - ?line true = mk_port({b@b, 3}, 4710) > Port, - ?line true = mk_port({b@b, 2}, 4712) > Port, - ?line true = mk_port({b@b, 2}, 4711) =:= Port, + true = mk_port({c@b, 1}, 4710) > Port, + true = mk_port({b@b, 3}, 4710) > Port, + true = mk_port({b@b, 2}, 4712) > Port, + true = mk_port({b@b, 2}, 4711) =:= Port, %% Test refs ---------------------------------------------------- %% Significance (most -> least): @@ -370,96 +354,97 @@ cmp(Config) when is_list(Config) -> %% creation. %% - ?line Ref = mk_ref({b@b, 2}, [4711, 4711, 4711]), + Ref = mk_ref({b@b, 2}, [4711, 4711, 4711]), - ?line true = mk_ref({c@b, 1}, [4710, 4710, 4710]) > Ref, - ?line true = mk_ref({b@b, 3}, [4710, 4710, 4710]) > Ref, - ?line true = mk_ref({b@b, 2}, [4710, 4710, 4712]) > Ref, - ?line true = mk_ref({b@b, 2}, [4710, 4712, 4711]) > Ref, - ?line true = mk_ref({b@b, 2}, [4712, 4711, 4711]) > Ref, - ?line true = mk_ref({b@b, 2}, [4711, 4711, 4711]) =:= Ref, + true = mk_ref({c@b, 1}, [4710, 4710, 4710]) > Ref, + true = mk_ref({b@b, 3}, [4710, 4710, 4710]) > Ref, + true = mk_ref({b@b, 2}, [4710, 4710, 4712]) > Ref, + true = mk_ref({b@b, 2}, [4710, 4712, 4711]) > Ref, + true = mk_ref({b@b, 2}, [4712, 4711, 4711]) > Ref, + true = mk_ref({b@b, 2}, [4711, 4711, 4711]) =:= Ref, ok. %% %% Test case: ref_eq %% -ref_eq(doc) -> ["Test that one word refs \"works\"."]; -ref_eq(suite) -> []; +%% Test that one word refs works ref_eq(Config) when is_list(Config) -> - ?line ThisNode = {node(), erlang:system_info(creation)}, - ?line AnotherNode = {get_nodename(),2}, - ?line LLongRef = mk_ref(ThisNode, [4711, 0, 0]), - ?line LHalfLongRef = mk_ref(ThisNode, [4711, 0]), - ?line LShortRef = mk_ref(ThisNode, [4711]), - ?line true = LLongRef =:= LShortRef, - ?line true = LLongRef =:= LHalfLongRef, - ?line true = LLongRef =:= LLongRef, - ?line true = LHalfLongRef =:= LShortRef, - ?line true = LHalfLongRef =:= LHalfLongRef, - ?line true = LShortRef =:= LShortRef, - ?line false = LShortRef == mk_ref(ThisNode, [4711, 0, 1]), % Not any more - ?line RLongRef = mk_ref(AnotherNode, [4711, 0, 0]), - ?line RHalfLongRef = mk_ref(AnotherNode, [4711, 0]), - ?line RShortRef = mk_ref(AnotherNode, [4711]), - ?line true = RLongRef =:= RShortRef, - ?line true = RLongRef =:= RHalfLongRef, - ?line true = RLongRef =:= RLongRef, - ?line true = RHalfLongRef =:= RShortRef, - ?line true = RHalfLongRef =:= RHalfLongRef, - ?line true = RShortRef =:= RShortRef, - ?line false = RShortRef == mk_ref(AnotherNode, [4711, 0, 1]), % Not any more - ?line nc_refc_check(node()), - ?line ok. - + ThisNode = {node(), erlang:system_info(creation)}, + AnotherNode = {get_nodename(),2}, + LLongRef = mk_ref(ThisNode, [4711, 0, 0]), + LHalfLongRef = mk_ref(ThisNode, [4711, 0]), + LShortRef = mk_ref(ThisNode, [4711]), + true = LLongRef =:= LShortRef, + true = LLongRef =:= LHalfLongRef, + true = LLongRef =:= LLongRef, + true = LHalfLongRef =:= LShortRef, + true = LHalfLongRef =:= LHalfLongRef, + true = LShortRef =:= LShortRef, + false = LShortRef == mk_ref(ThisNode, [4711, 0, 1]), % Not any more + RLongRef = mk_ref(AnotherNode, [4711, 0, 0]), + RHalfLongRef = mk_ref(AnotherNode, [4711, 0]), + RShortRef = mk_ref(AnotherNode, [4711]), + true = RLongRef =:= RShortRef, + true = RLongRef =:= RHalfLongRef, + true = RLongRef =:= RLongRef, + true = RHalfLongRef =:= RShortRef, + true = RHalfLongRef =:= RHalfLongRef, + true = RShortRef =:= RShortRef, + false = RShortRef == mk_ref(AnotherNode, [4711, 0, 1]), % Not any more + nc_refc_check(node()), + ok. + %% %% Test case: node_table_gc %% -node_table_gc(doc) -> - ["Tests that node tables are garbage collected."]; -node_table_gc(suite) -> []; +%% Tests that node tables are garbage collected. node_table_gc(Config) when is_list(Config) -> - ?line PreKnown = nodes(known), - ?line ?t:format("PreKnown = ~p~n", [PreKnown]), - ?line make_node_garbage(0, 200000, 1000, []), - ?line PostKnown = nodes(known), - ?line PostAreas = erlang:system_info(allocated_areas), - ?line ?t:format("PostKnown = ~p~n", [PostKnown]), - ?line ?t:format("PostAreas = ~p~n", [PostAreas]), - ?line true = length(PostKnown) =< length(PreKnown), - ?line nc_refc_check(node()), - ?line ok. + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(node_tab_delayed_delete, 0), + PreKnown = nodes(known), + io:format("PreKnown = ~p~n", [PreKnown]), + make_node_garbage(0, 200000, 1000, []), + receive after 1000 -> ok end, %% Wait for thread progress... + PostKnown = nodes(known), + PostAreas = erlang:system_info(allocated_areas), + io:format("PostKnown = ~p~n", [PostKnown]), + io:format("PostAreas = ~p~n", [PostAreas]), + true = length(PostKnown) =< length(PreKnown), + nc_refc_check(node()), + erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value + ok. make_node_garbage(N, L, I, Ps) when N < L -> - ?line Self = self(), - ?line P = spawn_link(fun () -> - % Generate two node entries and one dist - % entry per node name - ?line PL1 = make_faked_pid_list(N, - I div 2, - 1), - ?line put(a, PL1), - ?line PL2 = make_faked_pid_list(N, - I div 2, - 2), - ?line put(b, PL2), - ?line Self ! {self(), length(nodes(known))} - end), - ?line receive - {P, KnownLength} -> - ?line true = KnownLength >= I div 2 - end, - ?line make_node_garbage(N+(I div 2)*2, L, I, [P|Ps]); + Self = self(), + P = spawn_link(fun () -> + % Generate two node entries and one dist + % entry per node name + PL1 = make_faked_pid_list(N, + I div 2, + 1), + put(a, PL1), + PL2 = make_faked_pid_list(N, + I div 2, + 2), + put(b, PL2), + Self ! {self(), length(nodes(known))} + end), + receive + {P, KnownLength} -> + true = KnownLength >= I div 2 + end, + make_node_garbage(N+(I div 2)*2, L, I, [P|Ps]); make_node_garbage(_, _, _, Ps) -> %% Cleanup garbage... ProcIsCleanedUp - = fun (Proc) -> - undefined == erts_debug:get_internal_state({process_status, - Proc}) - end, + = fun (Proc) -> + undefined == erts_debug:get_internal_state({process_status, + Proc}) + end, lists:foreach(fun (P) -> wait_until(fun () -> ProcIsCleanedUp(P) end) end, - Ps), - ?line ok. + Ps), + ok. make_faked_pid_list(Start, No, Creation) -> @@ -469,289 +454,245 @@ make_faked_pid_list(_Start, 0, _Creation, Acc) -> Acc; make_faked_pid_list(Start, No, Creation, Acc) -> make_faked_pid_list(Start+1, - No-1, - Creation, - [mk_pid({"faked_node-" - ++ integer_to_list(Start rem 50000) - ++ "@" - ++ atom_to_list(?MODULE), - Creation}, - 4711, - 3) | Acc]). + No-1, + Creation, + [mk_pid({"faked_node-" + ++ integer_to_list(Start rem 50000) + ++ "@" + ++ atom_to_list(?MODULE), + Creation}, + 4711, + 3) | Acc]). %% %% Test case: dist_link_refc %% -dist_link_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for distributed links"]; -dist_link_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for distributed links dist_link_refc(Config) when is_list(Config) -> - ?line NodeFirstName = get_nodefirstname(), - ?line ?line {ok, Node} = start_node(NodeFirstName), - ?line RP = spawn_execer(Node), - ?line LP = spawn_link_execer(node()), - ?line true = sync_exec(RP, fun () -> link(LP) end), - ?line wait_until(fun () -> - ?line {links, Links} = process_info(LP, links), - ?line lists:member(RP, Links) - end), - ?line NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end), - ?line 1 = reference_type_count( - link, - refering_entity_id({process, LP}, - get_node_references({Node, NodeCre}))), - ?line exec(RP, fun() -> exit(normal) end), - ?line wait_until(fun () -> - ?line {links, Links} = process_info(LP, links), - ?line not lists:member(RP, Links) - end), - ?line 0 = reference_type_count( - link, - refering_entity_id({process, LP}, - get_node_references({Node, NodeCre}))), - ?line exit(LP, normal), - ?line stop_node(Node), - ?line nc_refc_check(node()), - ?line ok. + NodeFirstName = get_nodefirstname(), + {ok, Node} = start_node(NodeFirstName), + RP = spawn_execer(Node), + LP = spawn_link_execer(node()), + true = sync_exec(RP, fun () -> link(LP) end), + wait_until(fun () -> + {links, Links} = process_info(LP, links), + lists:member(RP, Links) + end), + NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end), + 1 = reference_type_count( + link, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + exec(RP, fun() -> exit(normal) end), + wait_until(fun () -> + {links, Links} = process_info(LP, links), + not lists:member(RP, Links) + end), + 0 = reference_type_count( + link, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + exit(LP, normal), + stop_node(Node), + nc_refc_check(node()), + ok. %% %% Test case: dist_monitor_refc %% -dist_monitor_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for distributed monitors"]; -dist_monitor_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for distributed monitors dist_monitor_refc(Config) when is_list(Config) -> - ?line NodeFirstName = get_nodefirstname(), - ?line {ok, Node} = start_node(NodeFirstName), - ?line RP = spawn_execer(Node), - ?line LP = spawn_link_execer(node()), - ?line RMon = sync_exec(RP, fun () -> erlang:monitor(process, LP) end), - ?line true = is_reference(RMon), - ?line LMon = sync_exec(LP, fun () -> erlang:monitor(process, RP) end), - ?line true = is_reference(LMon), - ?line NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end), - ?line wait_until(fun () -> - ?line {monitored_by, MonBy} - = process_info(LP, monitored_by), - ?line {monitors, Mon} - = process_info(LP, monitors), - ?line (lists:member(RP, MonBy) - and lists:member({process,RP}, Mon)) - end), - ?line 3 = reference_type_count( - monitor, - refering_entity_id({process, LP}, - get_node_references({Node, NodeCre}))), - ?line exec(RP, fun () -> exit(normal) end), - ?line wait_until(fun () -> - ?line {monitored_by, MonBy} - = process_info(LP, monitored_by), - ?line {monitors, Mon} - = process_info(LP, monitors), - ?line ((not lists:member(RP, MonBy)) - and (not lists:member({process,RP}, Mon))) - end), - ?line ok = sync_exec(LP, - fun () -> - receive - {'DOWN', LMon, process, _, _} -> - ok - end - end), - ?line 0 = reference_type_count( - link, - refering_entity_id({process, LP}, - get_node_references({Node, NodeCre}))), - ?line exit(LP, normal), - ?line stop_node(Node), - ?line nc_refc_check(node()), - ?line ok. + NodeFirstName = get_nodefirstname(), + {ok, Node} = start_node(NodeFirstName), + RP = spawn_execer(Node), + LP = spawn_link_execer(node()), + RMon = sync_exec(RP, fun () -> erlang:monitor(process, LP) end), + true = is_reference(RMon), + LMon = sync_exec(LP, fun () -> erlang:monitor(process, RP) end), + true = is_reference(LMon), + NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end), + wait_until(fun () -> + {monitored_by, MonBy} + = process_info(LP, monitored_by), + {monitors, Mon} + = process_info(LP, monitors), + (lists:member(RP, MonBy) + and lists:member({process,RP}, Mon)) + end), + 3 = reference_type_count( + monitor, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + exec(RP, fun () -> exit(normal) end), + wait_until(fun () -> + {monitored_by, MonBy} + = process_info(LP, monitored_by), + {monitors, Mon} + = process_info(LP, monitors), + ((not lists:member(RP, MonBy)) + and (not lists:member({process,RP}, Mon))) + end), + ok = sync_exec(LP, + fun () -> + receive + {'DOWN', LMon, process, _, _} -> + ok + end + end), + 0 = reference_type_count( + link, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + exit(LP, normal), + stop_node(Node), + nc_refc_check(node()), + ok. %% %% Test case: node_controller_refc %% -node_controller_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for entities controlling a connections."]; -node_controller_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for entities controlling a connections. node_controller_refc(Config) when is_list(Config) -> - ?line NodeFirstName = get_nodefirstname(), - ?line ?line {ok, Node} = start_node(NodeFirstName), - ?line true = lists:member(Node, nodes()), - ?line 1 = reference_type_count(control, get_dist_references(Node)), - ?line P = spawn_link_execer(node()), - ?line Node - = sync_exec(P, - fun () -> - put(remote_net_kernel, - rpc:call(Node,erlang,whereis,[net_kernel])), - node(get(remote_net_kernel)) - end), - ?line Creation = rpc:call(Node, erlang, system_info, [creation]), - ?line monitor_node(Node,true), - ?line stop_node(Node), - ?line receive {nodedown, Node} -> ok end, - ?line DistRefs = get_dist_references(Node), - ?line true = reference_type_count(node, DistRefs) > 0, - ?line 0 = reference_type_count(control, DistRefs), + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(node_tab_delayed_delete, 0), + NodeFirstName = get_nodefirstname(), + {ok, Node} = start_node(NodeFirstName), + true = lists:member(Node, nodes()), + 1 = reference_type_count(control, get_dist_references(Node)), + P = spawn_link_execer(node()), + Node + = sync_exec(P, + fun () -> + put(remote_net_kernel, + rpc:call(Node,erlang,whereis,[net_kernel])), + node(get(remote_net_kernel)) + end), + Creation = rpc:call(Node, erlang, system_info, [creation]), + monitor_node(Node,true), + stop_node(Node), + receive {nodedown, Node} -> ok end, + DistRefs = get_dist_references(Node), + true = reference_type_count(node, DistRefs) > 0, + 0 = reference_type_count(control, DistRefs), % Get rid of all references to Node - ?line exec(P, fun () -> exit(normal) end), - ?line wait_until(fun () -> not is_process_alive(P) end), + exec(P, fun () -> exit(normal) end), + wait_until(fun () -> not is_process_alive(P) end), lists:foreach(fun (Proc) -> garbage_collect(Proc) end, processes()), - ?line false = get_node_references({Node,Creation}), - ?line false = get_dist_references(Node), - ?line false = lists:member(Node, nodes(known)), - ?line nc_refc_check(node()), - ?line ok. + false = get_node_references({Node,Creation}), + false = get_dist_references(Node), + false = lists:member(Node, nodes(known)), + nc_refc_check(node()), + erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value + ok. %% %% Test case: ets_refc %% -ets_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for data stored in ets tables."]; -ets_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for data stored in ets tables. ets_refc(Config) when is_list(Config) -> - ?line RNode = {get_nodename(), 1}, - ?line RPid = mk_pid(RNode, 4711, 2), - ?line RPort = mk_port(RNode, 4711), - ?line RRef = mk_ref(RNode, [4711, 47, 11]), - ?line Tab = ets:new(ets_refc, []), - ?line 0 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:insert(Tab, [{a, self()}, - {b, RPid}, - {c, hd(erlang:ports())}, - {d, RPort}, - {e, make_ref()}]), - ?line 2 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:insert(Tab, {f, RRef}), - ?line 3 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:delete(Tab, d), - ?line 2 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:delete_all_objects(Tab), - ?line 0 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:insert(Tab, [{b, RPid}, {e, make_ref()}]), - ?line 1 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:delete(Tab), - ?line 0 = reference_type_count(ets, get_node_references(RNode)), - ?line nc_refc_check(node()), - ?line ok. + RNode = {get_nodename(), 1}, + RPid = mk_pid(RNode, 4711, 2), + RPort = mk_port(RNode, 4711), + RRef = mk_ref(RNode, [4711, 47, 11]), + Tab = ets:new(ets_refc, []), + 0 = reference_type_count(ets, get_node_references(RNode)), + true = ets:insert(Tab, [{a, self()}, + {b, RPid}, + {c, hd(erlang:ports())}, + {d, RPort}, + {e, make_ref()}]), + 2 = reference_type_count(ets, get_node_references(RNode)), + true = ets:insert(Tab, {f, RRef}), + 3 = reference_type_count(ets, get_node_references(RNode)), + true = ets:delete(Tab, d), + 2 = reference_type_count(ets, get_node_references(RNode)), + true = ets:delete_all_objects(Tab), + 0 = reference_type_count(ets, get_node_references(RNode)), + true = ets:insert(Tab, [{b, RPid}, {e, make_ref()}]), + 1 = reference_type_count(ets, get_node_references(RNode)), + true = ets:delete(Tab), + 0 = reference_type_count(ets, get_node_references(RNode)), + nc_refc_check(node()), + ok. %% %% Test case: match_spec_refc %% -match_spec_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for data stored in match specifications."]; -match_spec_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for data stored in match specifications. match_spec_refc(Config) when is_list(Config) -> - ?line RNode = {get_nodename(), 1}, - ?line RPid = mk_pid(RNode, 4711, 2), - ?line RPort = mk_port(RNode, 4711), - ?line RRef = mk_ref(RNode, [4711, 47, 11]), - ?line ok = do_match_spec_test(RNode, RPid, RPort, RRef), - ?line garbage_collect(), - ?line NodeRefs = get_node_references(RNode), - ?line 0 = reference_type_count(binary, NodeRefs), - ?line 0 = reference_type_count(ets, NodeRefs), - ?line nc_refc_check(node()), - ?line ok. + RNode = {get_nodename(), 1}, + RPid = mk_pid(RNode, 4711, 2), + RPort = mk_port(RNode, 4711), + RRef = mk_ref(RNode, [4711, 47, 11]), + ok = do_match_spec_test(RNode, RPid, RPort, RRef), + garbage_collect(), + NodeRefs = get_node_references(RNode), + 0 = reference_type_count(binary, NodeRefs), + 0 = reference_type_count(ets, NodeRefs), + nc_refc_check(node()), + ok. do_match_spec_test(RNode, RPid, RPort, RRef) -> - ?line Tab = ets:new(match_spec_refc, []), - ?line true = ets:insert(Tab, [{a, RPid, RPort, RRef}, - {b, self(), RPort, RRef}, - {c, RPid, RPort, make_ref()}, - {d, RPid, RPort, RRef}]), - ?line {M1, C1} = ets:select(Tab, [{{'$1',RPid,RPort,RRef},[],['$1']}], 1), - ?line NodeRefs = get_node_references(RNode), - ?line 3 = reference_type_count(binary, NodeRefs), - ?line 10 = reference_type_count(ets, NodeRefs), - ?line {M2, C2} = ets:select(C1), - ?line '$end_of_table' = ets:select(C2), - ?line ets:delete(Tab), - ?line [a,d] = lists:sort(M1++M2), - ?line ok. - + Tab = ets:new(match_spec_refc, []), + true = ets:insert(Tab, [{a, RPid, RPort, RRef}, + {b, self(), RPort, RRef}, + {c, RPid, RPort, make_ref()}, + {d, RPid, RPort, RRef}]), + {M1, C1} = ets:select(Tab, [{{'$1',RPid,RPort,RRef},[],['$1']}], 1), + NodeRefs = get_node_references(RNode), + 3 = reference_type_count(binary, NodeRefs), + 10 = reference_type_count(ets, NodeRefs), + {M2, C2} = ets:select(C1), + '$end_of_table' = ets:select(C2), + ets:delete(Tab), + [a,d] = lists:sort(M1++M2), + ok. + %% %% Test case: ets_refc %% -timer_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for data stored in bif timers."]; -timer_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for data stored in bif timers. timer_refc(Config) when is_list(Config) -> - ?line RNode = {get_nodename(), 1}, - ?line RPid = mk_pid(RNode, 4711, 2), - ?line RPort = mk_port(RNode, 4711), - ?line RRef = mk_ref(RNode, [4711, 47, 11]), - ?line 0 = reference_type_count(timer, get_node_references(RNode)), - ?line Pid = spawn(fun () -> receive after infinity -> ok end end), - ?line erlang:start_timer(10000, Pid, {RPid, RPort, RRef}), - ?line 3 = reference_type_count(timer, get_node_references(RNode)), - ?line exit(Pid, kill), - ?line Mon = erlang:monitor(process, Pid), - ?line receive {'DOWN', Mon, process, Pid, _} -> ok end, - ?line 0 = reference_type_count(timer, get_node_references(RNode)), - ?line erlang:send_after(500, Pid, {timer, RPid, RPort, RRef}), - ?line 0 = reference_type_count(timer, get_node_references(RNode)), - ?line erlang:send_after(500, self(), {timer, RPid, RPort, RRef}), - ?line erlang:send_after(400, bananfluga, {timer, RPid, RPort, RRef}), - ?line 6 = reference_type_count(timer, get_node_references(RNode)), - ?line receive {timer, RPid, RPort, RRef} -> ok end, - ?line 0 = reference_type_count(timer, get_node_references(RNode)), - ?line nc_refc_check(node()), - ?line ok. - -otp_4715(doc) -> []; -otp_4715(suite) -> []; -otp_4715(Config) when is_list(Config) -> - case ?t:is_release_available("r9b") of - true -> otp_4715_1(Config); - false -> {skip,"No R9B found"} - end. - -otp_4715_1(Config) -> - case erlang:system_info(compat_rel) of - 9 -> - ?line run_otp_4715(Config); - _ -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line ?t:run_on_shielded_node(fun () -> - run_otp_4715(Config) - end, - "+R9 -pa " ++ Pa) - end. - -run_otp_4715(Config) when is_list(Config) -> - ?line erts_debug:set_internal_state(available_internal_state, true), - ?line PidList = [mk_pid({a@b, 1}, 4710, 2), - mk_pid({a@b, 1}, 4712, 1), - mk_pid({c@b, 1}, 4711, 1), - mk_pid({b@b, 3}, 4711, 1), - mk_pid({b@b, 2}, 4711, 1)], - - ?line R9Sorted = old_mod:sort_on_old_node(PidList), - ?line R9Sorted = lists:sort(PidList). + RNode = {get_nodename(), 1}, + RPid = mk_pid(RNode, 4711, 2), + RPort = mk_port(RNode, 4711), + RRef = mk_ref(RNode, [4711, 47, 11]), + 0 = reference_type_count(timer, get_node_references(RNode)), + Pid = spawn(fun () -> receive after infinity -> ok end end), + erlang:start_timer(10000, Pid, {RPid, RPort, RRef}), + 3 = reference_type_count(timer, get_node_references(RNode)), + exit(Pid, kill), + Mon = erlang:monitor(process, Pid), + receive {'DOWN', Mon, process, Pid, _} -> ok end, + 0 = reference_type_count(timer, get_node_references(RNode)), + erlang:send_after(500, Pid, {timer, RPid, RPort, RRef}), + 0 = reference_type_count(timer, get_node_references(RNode)), + erlang:send_after(500, self(), {timer, RPid, RPort, RRef}), + erlang:send_after(400, bananfluga, {timer, RPid, RPort, RRef}), + 6 = reference_type_count(timer, get_node_references(RNode)), + receive {timer, RPid, RPort, RRef} -> ok end, + 0 = reference_type_count(timer, get_node_references(RNode)), + nc_refc_check(node()), + ok. -pid_wrap(doc) -> []; -pid_wrap(suite) -> []; -pid_wrap(Config) when is_list(Config) -> ?line pp_wrap(pid). +pid_wrap(Config) when is_list(Config) -> pp_wrap(pid). -port_wrap(doc) -> []; -port_wrap(suite) -> []; port_wrap(Config) when is_list(Config) -> - ?line case ?t:os_type() of - {unix, _} -> - ?line pp_wrap(port); - _ -> - ?line {skip, "Only run on unix"} - end. + case os:type() of + {unix, _} -> + pp_wrap(port); + _ -> + {skip, "Only run on unix"} + end. get_next_id(pid) -> erts_debug:get_internal_state(next_pid); @@ -764,173 +705,202 @@ set_next_id(port, N) -> erts_debug:set_internal_state(next_port, N). pp_wrap(What) -> - ?line N = set_high_pp_next(What), - ?line Cre = N + 100, - ?line ?t:format("no creations = ~p~n", [Cre]), - ?line PreCre = get_next_id(What), - ?line ?t:format("pre creations = ~p~n", [PreCre]), - ?line true = is_integer(PreCre), - ?line do_pp_creations(What, Cre), - ?line PostCre = get_next_id(What), - ?line ?t:format("post creations = ~p~n", [PostCre]), - ?line true = is_integer(PostCre), - ?line true = PreCre > PostCre, - ?line Now = set_next_id(What, ?MAX_PIDS_PORTS div 2), - ?line ?t:format("reset to = ~p~n", [Now]), - ?line true = is_integer(Now), - ?line ok. + N = set_high_pp_next(What), + Cre = N + 100, + io:format("no creations = ~p~n", [Cre]), + PreCre = get_next_id(What), + io:format("pre creations = ~p~n", [PreCre]), + true = is_integer(PreCre), + do_pp_creations(What, Cre), + PostCre = get_next_id(What), + io:format("post creations = ~p~n", [PostCre]), + true = is_integer(PostCre), + true = PreCre > PostCre, + Now = set_next_id(What, ?MAX_PIDS_PORTS div 2), + io:format("reset to = ~p~n", [Now]), + true = is_integer(Now), + ok. set_high_pp_next(What) -> - ?line set_high_pp_next(What, ?MAX_PIDS_PORTS-1). - + set_high_pp_next(What, ?MAX_PIDS_PORTS-1). + set_high_pp_next(What, N) -> - ?line M = set_next_id(What, N), - ?line true = is_integer(M), - ?line case {M >= N, M =< ?MAX_PIDS_PORTS} of - {true, true} -> - ?line ?MAX_PIDS_PORTS - M + 1; - _ -> - ?line set_high_pp_next(What, N - 100) - end. + M = set_next_id(What, N), + true = is_integer(M), + case {M >= N, M =< ?MAX_PIDS_PORTS} of + {true, true} -> + ?MAX_PIDS_PORTS - M + 1; + _ -> + set_high_pp_next(What, N - 100) + end. do_pp_creations(_What, N) when is_integer(N), N =< 0 -> - ?line done; + done; do_pp_creations(pid, N) when is_integer(N) -> %% Create new pid and make sure it works... - ?line Me = self(), - ?line Ref = make_ref(), - ?line Pid = spawn_link(fun () -> - receive - Ref -> - Me ! Ref - end - end), - ?line Pid ! Ref, - ?line receive - Ref -> - ?line do_pp_creations(pid, N - 1) - end; + Me = self(), + Ref = make_ref(), + Pid = spawn_link(fun () -> + receive + Ref -> + Me ! Ref + end + end), + Pid ! Ref, + receive + Ref -> + do_pp_creations(pid, N - 1) + end; do_pp_creations(port, N) when is_integer(N) -> %% Create new port and make sure it works... - ?line "hej" = os:cmd("echo hej") -- "\n", - ?line do_pp_creations(port, N - 1). + "hej" = os:cmd("echo hej") -- "\n", + do_pp_creations(port, N - 1). -bad_nc(doc) -> []; -bad_nc(suite) -> []; bad_nc(Config) when is_list(Config) -> % Make sure emulator don't crash on bad node containers... - ?line MaxPidNum = (1 bsl 15) - 1, - ?line MaxPidSer = ?MAX_PIDS_PORTS bsr 15, - ?line ThisNode = {node(), erlang:system_info(creation)}, - ?line {'EXIT', {badarg, mk_pid, _}} - = (catch mk_pid(ThisNode, MaxPidNum + 1, 17)), - ?line {'EXIT', {badarg, mk_pid, _}} - = (catch mk_pid(ThisNode, 4711, MaxPidSer + 1)), - ?line {'EXIT', {badarg, mk_port, _}} - = (catch mk_port(ThisNode, ?MAX_PIDS_PORTS + 1)), - ?line {'EXIT', {badarg, mk_ref, _}} - = (catch mk_ref(ThisNode,[(1 bsl 18), 4711, 4711])), - ?line {'EXIT', {badarg, mk_ref, _}} - = (catch mk_ref(ThisNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), - ?line RemNode = {x@y, 2}, - ?line {'EXIT', {badarg, mk_pid, _}} - = (catch mk_pid(RemNode, MaxPidNum + 1, MaxPidSer)), - ?line {'EXIT', {badarg, mk_pid, _}} - = (catch mk_pid(RemNode, MaxPidNum, MaxPidSer + 1)), - ?line {'EXIT', {badarg, mk_port, _}} - = (catch mk_port(RemNode, ?MAX_PIDS_PORTS + 1)), - ?line {'EXIT', {badarg, mk_ref, _}} - = (catch mk_ref(RemNode, [(1 bsl 18), 4711, 4711])), - ?line {'EXIT', {badarg, mk_ref, _}} - = (catch mk_ref(RemNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), - ?line BadNode = {x@y, 4}, - ?line {'EXIT', {badarg, mk_pid, _}} - = (catch mk_pid(BadNode, 4711, 17)), - ?line {'EXIT', {badarg, mk_port, _}} - = (catch mk_port(BadNode, 4711)), - ?line {'EXIT', {badarg, mk_ref, _}} - = (catch mk_ref(BadNode, [4711, 4711, 17])), - ?line ok. + MaxPidNum = (1 bsl 15) - 1, + MaxPidSer = ?MAX_PIDS_PORTS bsr 15, + ThisNode = {node(), erlang:system_info(creation)}, + {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(ThisNode, MaxPidNum + 1, 17)), + {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(ThisNode, 4711, MaxPidSer + 1)), + {'EXIT', {badarg, mk_port, _}} + = (catch mk_port(ThisNode, ?MAX_PIDS_PORTS + 1)), + {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(ThisNode,[(1 bsl 18), 4711, 4711])), + {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(ThisNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), + RemNode = {x@y, 2}, + {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(RemNode, MaxPidNum + 1, MaxPidSer)), + {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(RemNode, MaxPidNum, MaxPidSer + 1)), + {'EXIT', {badarg, mk_port, _}} + = (catch mk_port(RemNode, ?MAX_PIDS_PORTS + 1)), + {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(RemNode, [(1 bsl 18), 4711, 4711])), + {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(RemNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), + BadNode = {x@y, bad_creation}, + {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(BadNode, 4711, 17)), + {'EXIT', {badarg, mk_port, _}} + = (catch mk_port(BadNode, 4711)), + {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(BadNode, [4711, 4711, 17])), + ok. -define(NO_PIDS, 1000000). -unique_pid(doc) -> []; -unique_pid(suite) -> []; unique_pid(Config) when is_list(Config) -> case catch erlang:system_info(modified_timing_level) of - Level when is_integer(Level) -> - {skip, - "Modified timing (level " ++ integer_to_list(Level) - ++ ") is enabled. spawn() is too slow for this " - " test when modified timing is enabled."}; - _ -> - ?line ?NO_PIDS = length(lists:usort(mkpidlist(?NO_PIDS, []))), - ?line ok + Level when is_integer(Level) -> + {skip, + "Modified timing (level " ++ integer_to_list(Level) + ++ ") is enabled. spawn() is too slow for this " + " test when modified timing is enabled."}; + _ -> + ?NO_PIDS = length(lists:usort(mkpidlist(?NO_PIDS, []))), + ok end. - + mkpidlist(0, Ps) -> Ps; mkpidlist(N, Ps) -> mkpidlist(N-1, [spawn(fun () -> ok end)|Ps]). -iter_max_procs(doc) -> []; -iter_max_procs(suite) -> []; iter_max_procs(Config) when is_list(Config) -> - ?line NoMoreTests = make_ref(), - ?line erlang:send_after(10000, self(), NoMoreTests), - ?line Res = chk_max_proc_line(), - ?line Res = chk_max_proc_line(), - ?line done = chk_max_proc_line_until(NoMoreTests, Res), - ?line {comment, - io_lib:format("max processes = ~p; " - "process line length = ~p", - [element(2, Res), element(1, Res)])}. - - + NoMoreTests = make_ref(), + erlang:send_after(10000, self(), NoMoreTests), + Res = chk_max_proc_line(), + Res = chk_max_proc_line(), + done = chk_max_proc_line_until(NoMoreTests, Res), + Cmt = io_lib:format("max processes = ~p; " + "process line length = ~p", + [element(2, Res), element(1, Res)]), + {comment, lists:flatten(Cmt)}. + max_proc_line(Root, Parent, N) -> Me = self(), case catch spawn_link(fun () -> max_proc_line(Root, Me, N+1) end) of - {'EXIT', {system_limit, _}} when Root /= self() -> - Root ! {proc_line_length, N, self()}, - receive remove_proc_line -> Parent ! {exiting, Me} end; - P when is_pid(P), Root =/= self() -> - receive {exiting, P} -> Parent ! {exiting, Me} end; - P when is_pid(P) -> - P; - Unexpected -> - exit({unexpected_spawn_result, Unexpected}) + {'EXIT', {system_limit, _}} when Root /= self() -> + Root ! {proc_line_length, N, self()}, + receive remove_proc_line -> Parent ! {exiting, Me} end; + P when is_pid(P), Root =/= self() -> + receive {exiting, P} -> Parent ! {exiting, Me} end; + P when is_pid(P) -> + P; + Unexpected -> + exit({unexpected_spawn_result, Unexpected}) end. chk_max_proc_line() -> - ?line Child = max_proc_line(self(), self(), 0), - ?line receive - {proc_line_length, PLL, End} -> - ?line PC = erlang:system_info(process_count), - ?line LP = length(processes()), - ?line ?t:format("proc line length = ~p; " - "process count = ~p; " - "length processes = ~p~n", - [PLL, PC, LP]), - ?line End ! remove_proc_line, - ?line PC = LP, - ?line receive {exiting, Child} -> ok end, - ?line {PLL, PC} - end. + Child = max_proc_line(self(), self(), 0), + receive + {proc_line_length, PLL, End} -> + PC = erlang:system_info(process_count), + LP = length(processes()), + io:format("proc line length = ~p; " + "process count = ~p; " + "length processes = ~p~n", + [PLL, PC, LP]), + End ! remove_proc_line, + PC = LP, + receive {exiting, Child} -> ok end, + {PLL, PC} + end. chk_max_proc_line_until(NoMoreTests, Res) -> receive - NoMoreTests -> - ?line done + NoMoreTests -> + done after 0 -> - ?line Res = chk_max_proc_line(), - ?line chk_max_proc_line_until(NoMoreTests, Res) + Res = chk_max_proc_line(), + chk_max_proc_line_until(NoMoreTests, Res) end. +magic_ref(Config) when is_list(Config) -> + {MRef0, Addr0} = erts_debug:set_internal_state(make, magic_ref), + true = is_reference(MRef0), + {Addr0, 1, true} = erts_debug:get_internal_state({magic_ref,MRef0}), + MRef1 = binary_to_term(term_to_binary(MRef0)), + {Addr0, 2, true} = erts_debug:get_internal_state({magic_ref,MRef1}), + MRef0 = MRef1, + Me = self(), + {Pid, Mon} = spawn_opt(fun () -> + receive + {Me, MRef} -> + Me ! {self(), erts_debug:get_internal_state({magic_ref,MRef})} + end + end, + [link, monitor]), + Pid ! {self(), MRef0}, + receive + {Pid, Info} -> + {Addr0, 3, true} = Info + end, + receive + {'DOWN', Mon, process, Pid, _} -> + ok + end, + {Addr0, 2, true} = erts_debug:get_internal_state({magic_ref,MRef0}), + id(MRef0), + id(MRef1), + MRefExt = term_to_binary(erts_debug:set_internal_state(make, magic_ref)), + garbage_collect(), + {MRef2, _Addr2} = binary_to_term(MRefExt), + true = is_reference(MRef2), + true = erts_debug:get_internal_state({magic_ref,MRef2}), + ok. %% %% -- Internal utils --------------------------------------------------------- %% +id(X) -> + X. + -define(ND_REFS, erts_debug:get_internal_state(node_and_dist_references)). node_container_refc_check(Node) when is_atom(Node) -> @@ -941,116 +911,126 @@ node_container_refc_check(Node) when is_atom(Node) -> nc_refc_check(Node) when is_atom(Node) -> Ref = make_ref(), Self = self(), - ?t:format("Starting reference count check of node ~w~n", [Node]), + io:format("Starting reference count check of node ~w~n", [Node]), spawn_link(Node, - fun () -> - {{node_references, NodeRefs}, - {dist_references, DistRefs}} = ?ND_REFS, - check_nd_refc({node(), erlang:system_info(creation)}, - NodeRefs, - DistRefs, - fun (ErrMsg) -> - Self ! {Ref, ErrMsg, failed}, - exit(normal) - end), - Self ! {Ref, succeded} - end), + fun () -> + {{node_references, NodeRefs}, + {dist_references, DistRefs}} = ?ND_REFS, + check_nd_refc({node(), erlang:system_info(creation)}, + NodeRefs, + DistRefs, + fun (ErrMsg) -> + Self ! {Ref, ErrMsg, failed}, + exit(normal) + end), + Self ! {Ref, succeded} + end), receive - {Ref, ErrorMsg, failed} -> - ?t:format("~s~n", [ErrorMsg]), - ?t:fail(reference_count_check_failed); - {Ref, succeded} -> - ?t:format("Reference count check of node ~w succeded!~n", [Node]), - ok + {Ref, ErrorMsg, failed} -> + io:format("~s~n", [ErrorMsg]), + ct:fail(reference_count_check_failed); + {Ref, succeded} -> + io:format("Reference count check of node ~w succeded!~n", [Node]), + ok end. check_nd_refc({ThisNodeName, ThisCreation}, NodeRefs, DistRefs, Fail) -> case catch begin - check_refc(ThisNodeName,ThisCreation,"node table",NodeRefs), - check_refc(ThisNodeName,ThisCreation,"dist table",DistRefs), - ok - end of - ok -> - ok; - {'EXIT', Reason} -> - {Y,Mo,D} = date(), - {H,Mi,S} = time(), - ErrMsg = io_lib:format("~n" - "*** Reference count check of node ~w " - "failed (~p) at ~w~w~w ~w:~w:~w~n" - "*** Node table references:~n ~p~n" - "*** Dist table references:~n ~p~n", - [node(), Reason, Y, Mo, D, H, Mi, S, - NodeRefs, DistRefs]), - Fail(lists:flatten(ErrMsg)) + check_refc(ThisNodeName,ThisCreation,"node table",NodeRefs), + check_refc(ThisNodeName,ThisCreation,"dist table",DistRefs), + ok + end of + ok -> + ok; + {'EXIT', Reason} -> + {Y,Mo,D} = date(), + {H,Mi,S} = time(), + ErrMsg = io_lib:format("~n" + "*** Reference count check of node ~w " + "failed (~p) at ~w~w~w ~w:~w:~w~n" + "*** Node table references:~n ~p~n" + "*** Dist table references:~n ~p~n", + [node(), Reason, Y, Mo, D, H, Mi, S, + NodeRefs, DistRefs]), + Fail(lists:flatten(ErrMsg)) end. check_refc(ThisNodeName,ThisCreation,Table,EntryList) when is_list(EntryList) -> lists:foreach( fun ({Entry, Refc, ReferrerList}) -> - FoundRefs = - lists:foldl( - fun ({_Referrer, ReferencesList}, A1) -> - A1 + lists:foldl(fun ({_T,Rs},A2) -> - A2+Rs - end, - 0, - ReferencesList) - end, - 0, - ReferrerList), - - %% Reference count equals found references ? - case Refc =:= FoundRefs of - true -> - ok; - false -> - exit({invalid_reference_count, Table, Entry}) - end, - - %% All entries in table referred to? - case {Entry, Refc} of - {ThisNodeName, 0} -> ok; - {{ThisNodeName, ThisCreation}, 0} -> ok; - {_, 0} -> exit({not_referred_entry_in_table, Table, Entry}); - {_, _} -> ok - end + {DelayedDeleteTimer, + FoundRefs} = + lists:foldl( + fun ({Referrer, ReferencesList}, {DDT, A1}) -> + {case Referrer of + {system,delayed_delete_timer} -> + true; + _ -> + DDT + end, + A1 + lists:foldl(fun ({_T,Rs},A2) -> + A2+Rs + end, + 0, + ReferencesList)} + end, + {false, 0}, + ReferrerList), + + %% Reference count equals found references? + case {Refc, FoundRefs, DelayedDeleteTimer} of + {X, X, _} -> + ok; + {0, 1, true} -> + ok; + _ -> + exit({invalid_reference_count, Table, Entry}) + end, + + %% All entries in table referred to? + case {Entry, Refc} of + {ThisNodeName, 0} -> ok; + {{ThisNodeName, ThisCreation}, 0} -> ok; + {_, 0} when DelayedDeleteTimer == false -> + exit({not_referred_entry_in_table, Table, Entry}); + {_, _} -> ok + end end, EntryList), ok. get_node_references({NodeName, Creation} = Node) when is_atom(NodeName), - is_integer(Creation) -> + is_integer(Creation) -> {{node_references, NodeRefs}, - {dist_references, DistRefs}} = ?ND_REFS, + {dist_references, DistRefs}} = ?ND_REFS, check_nd_refc({node(), erlang:system_info(creation)}, - NodeRefs, - DistRefs, - fun (ErrMsg) -> - ?t:format("~s", [ErrMsg]), - ?t:fail(reference_count_check_failed) - end), + NodeRefs, + DistRefs, + fun (ErrMsg) -> + io:format("~s", [ErrMsg]), + ct:fail(reference_count_check_failed) + end), find_references(Node, NodeRefs). get_dist_references(NodeName) when is_atom(NodeName) -> - ?line {{node_references, NodeRefs}, - {dist_references, DistRefs}} = ?ND_REFS, - ?line check_nd_refc({node(), erlang:system_info(creation)}, - NodeRefs, - DistRefs, - fun (ErrMsg) -> - ?line ?t:format("~s", [ErrMsg]), - ?line ?t:fail(reference_count_check_failed) - end), - ?line find_references(NodeName, DistRefs). + {{node_references, NodeRefs}, + {dist_references, DistRefs}} = ?ND_REFS, + check_nd_refc({node(), erlang:system_info(creation)}, + NodeRefs, + DistRefs, + fun (ErrMsg) -> + io:format("~s", [ErrMsg]), + ct:fail(reference_count_check_failed) + end), + find_references(NodeName, DistRefs). find_references(N, NRefList) -> case lists:keysearch(N, 1, NRefList) of - {value, {N, _, ReferrersList}} -> ReferrersList; - _ -> false - end. + {value, {N, _, ReferrersList}} -> ReferrersList; + _ -> false + end. %% Currently unused % refering_entity_type(RefererType, ReferingEntities) -> @@ -1062,7 +1042,7 @@ find_references(N, NRefList) -> % ReferingEntities). refering_entity_id(ReferingEntityId, [{ReferingEntityId,_} = ReferingEntity - | _ReferingEntities]) -> + | _ReferingEntities]) -> ReferingEntity; refering_entity_id(ReferingEntityId, [_ | ReferingEntities]) -> refering_entity_id(ReferingEntityId, ReferingEntities); @@ -1075,34 +1055,34 @@ reference_type_count(Type, {_, _ReferenceCountList} = ReferingEntity) -> reference_type_count(Type, [ReferingEntity]); reference_type_count(Type, ReferingEntities) when is_list(ReferingEntities) -> lists:foldl(fun ({_, ReferenceCountList}, Acc1) -> - lists:foldl(fun ({T, N}, Acc2) when T == Type -> - N + Acc2; - (_, Acc2) -> - Acc2 - end, - Acc1, - ReferenceCountList) - end, - 0, - ReferingEntities). + lists:foldl(fun ({T, N}, Acc2) when T == Type -> + N + Acc2; + (_, Acc2) -> + Acc2 + end, + Acc1, + ReferenceCountList) + end, + 0, + ReferingEntities). start_node(Name, Args) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line Res = test_server:start_node(Name, - slave, - [{args, "-pa "++Pa++" "++Args}]), - ?line {ok, Node} = Res, - ?line rpc:call(Node, erts_debug, set_internal_state, - [available_internal_state, true]), - ?line Res. - + Pa = filename:dirname(code:which(?MODULE)), + Res = test_server:start_node(Name, + slave, + [{args, "-pa "++Pa++" "++Args}]), + {ok, Node} = Res, + rpc:call(Node, erts_debug, set_internal_state, + [available_internal_state, true]), + Res. + start_node(Name) -> - ?line start_node(Name, ""). + start_node(Name, ""). stop_node(Node) -> - ?line nc_refc_check(Node), - ?line true = test_server:stop_node(Node). + nc_refc_check(Node), + true = test_server:stop_node(Node). hostname() -> from($@, atom_to_list(node())). @@ -1113,33 +1093,25 @@ from(_H, []) -> []. wait_until(Pred) -> case Pred() of - true -> ok; - false -> receive after 100 -> wait_until(Pred) end + true -> ok; + false -> receive after 100 -> wait_until(Pred) end end. +get_nodefirstname_string() -> + atom_to_list(?MODULE) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive])). get_nodefirstname() -> - {A, B, C} = now(), - list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)). + list_to_atom(get_nodefirstname_string()). get_nodename() -> - {A, B, C} = now(), - list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C) - ++ "@" - ++ hostname()). - + list_to_atom(get_nodefirstname_string() + ++ "@" + ++ hostname()). + -define(VERSION_MAGIC, 131). @@ -1149,6 +1121,9 @@ get_nodename() -> -define(PORT_EXT, 102). -define(PID_EXT, 103). -define(NEW_REFERENCE_EXT, 114). +-define(NEW_PID_EXT, $X). +-define(NEW_PORT_EXT, $Y). +-define(NEWER_REFERENCE_EXT, $Z). uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> [(Uint bsr 24) band 16#ff, @@ -1171,18 +1146,25 @@ uint8(Uint) -> exit({badarg, uint8, [Uint]}). +pid_tag(bad_creation) -> ?PID_EXT; +pid_tag(Creation) when Creation =< 3 -> ?PID_EXT; +pid_tag(_Creation) -> ?NEW_PID_EXT. + +enc_creation(bad_creation) -> uint8(4); +enc_creation(Creation) when Creation =< 3 -> uint8(Creation); +enc_creation(Creation) -> uint32_be(Creation). mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> mk_pid({atom_to_list(NodeName), Creation}, Number, Serial); mk_pid({NodeName, Creation}, Number, Serial) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PID_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint32_be(Serial), - uint8(Creation)])) of + pid_tag(Creation), + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint32_be(Serial), + enc_creation(Creation)])) of Pid when is_pid(Pid) -> Pid; {'EXIT', {badarg, _}} -> @@ -1191,16 +1173,20 @@ mk_pid({NodeName, Creation}, Number, Serial) -> exit({unexpected_binary_to_term_result, Other}) end. +port_tag(bad_creation) -> ?PORT_EXT; +port_tag(Creation) when Creation =< 3 -> ?PORT_EXT; +port_tag(_Creation) -> ?NEW_PORT_EXT. + mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> mk_port({atom_to_list(NodeName), Creation}, Number); mk_port({NodeName, Creation}, Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PORT_EXT, + port_tag(Creation), ?ATOM_EXT, uint16_be(length(NodeName)), NodeName, uint32_be(Number), - uint8(Creation)])) of + enc_creation(Creation)])) of Port when is_port(Port) -> Port; {'EXIT', {badarg, _}} -> @@ -1209,37 +1195,39 @@ mk_port({NodeName, Creation}, Number) -> exit({unexpected_binary_to_term_result, Other}) end. +ref_tag(bad_creation) -> ?NEW_REFERENCE_EXT; +ref_tag(Creation) when Creation =< 3 -> ?NEW_REFERENCE_EXT; +ref_tag(_Creation) -> ?NEWER_REFERENCE_EXT. + mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), - is_integer(Creation), is_list(Numbers) -> mk_ref({atom_to_list(NodeName), Creation}, Numbers); mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName), - is_integer(Creation), + Creation =< 3, is_integer(Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?REFERENCE_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint8(Creation)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?REFERENCE_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end; mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), - is_integer(Creation), is_list(Numbers) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEW_REFERENCE_EXT, + ref_tag(Creation), uint16_be(length(Numbers)), ?ATOM_EXT, uint16_be(length(NodeName)), NodeName, - uint8(Creation), + enc_creation(Creation), lists:map(fun (N) -> uint32_be(N) end, @@ -1254,10 +1242,10 @@ mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), exec_loop() -> receive - {exec_fun, Fun} when is_function(Fun) -> - Fun(); - {sync_exec_fun, From, Fun} when is_pid(From), is_function(Fun) -> - From ! {sync_exec_fun_res, self(), Fun()} + {exec_fun, Fun} when is_function(Fun) -> + Fun(); + {sync_exec_fun, From, Fun} when is_pid(From), is_function(Fun) -> + From ! {sync_exec_fun_res, self(), Fun()} end, exec_loop(). @@ -1273,6 +1261,6 @@ exec(Pid, Fun) when is_pid(Pid), is_function(Fun) -> sync_exec(Pid, Fun) when is_pid(Pid), is_function(Fun) -> Pid ! {sync_exec_fun, self(), Fun}, receive - {sync_exec_fun_res, Pid, Res} -> - Res + {sync_exec_fun_res, Pid, Res} -> + Res end. diff --git a/erts/emulator/test/nofrag_SUITE.erl b/erts/emulator/test/nofrag_SUITE.erl index 57eec87e63..8b1519ae36 100644 --- a/erts/emulator/test/nofrag_SUITE.erl +++ b/erts/emulator/test/nofrag_SUITE.erl @@ -1,75 +1,52 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(nofrag_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - error_handler/1,error_handler_apply/1, - error_handler_fixed_apply/1,error_handler_fun/1, - debug_breakpoint/1]). +-export([all/0, suite/0, + error_handler/1,error_handler_apply/1, + error_handler_fixed_apply/1,error_handler_fun/1, + debug_breakpoint/1]). %% Exported functions for an error_handler module. -export([undefined_function/3,undefined_lambda/3,breakpoint/3]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [error_handler, error_handler_apply, error_handler_fixed_apply, error_handler_fun, debug_breakpoint]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(3)), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - error_handler(Config) when is_list(Config) -> - ?line process_flag(error_handler, ?MODULE), + process_flag(error_handler, ?MODULE), %% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way %% to traverse the entire term. - ?line Term = collect(1024), - ?line Term = binary_to_term(term_to_binary(Term)), - ?line 1024 = length(Term), - ?line [[a,b,c,d,[e,f,g]]] = lists:usort(Term), + Term = collect(1024), + Term = binary_to_term(term_to_binary(Term)), + 1024 = length(Term), + [[a,b,c,d,[e,f,g]]] = lists:usort(Term), ok. collect(0) -> @@ -104,25 +81,25 @@ collect_apply(N, Mod) -> [C|Res]. error_handler_apply(Config) when is_list(Config) -> - ?line process_flag(error_handler, ?MODULE), + process_flag(error_handler, ?MODULE), %% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way %% to traverse the entire term. - ?line Term = collect_apply(1024, fooblurfbar), - ?line Term = binary_to_term(term_to_binary(Term)), - ?line 1024 = length(Term), - ?line [[{a,42},b,c,d,[e,f,g]]] = lists:usort(Term), + Term = collect_apply(1024, fooblurfbar), + Term = binary_to_term(term_to_binary(Term)), + 1024 = length(Term), + [[{a,42},b,c,d,[e,f,g]]] = lists:usort(Term), ok. error_handler_fixed_apply(Config) when is_list(Config) -> - ?line process_flag(error_handler, ?MODULE), + process_flag(error_handler, ?MODULE), %% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way %% to traverse the entire term. - ?line Term = collect_fixed_apply(1024, fooblurfbar), - ?line Term = binary_to_term(term_to_binary(Term)), - ?line 1024 = length(Term), - ?line [[{a,2},b,c,d,[e,f,g]]] = lists:usort(Term), + Term = collect_fixed_apply(1024, fooblurfbar), + Term = binary_to_term(term_to_binary(Term)), + 1024 = length(Term), + [[{a,2},b,c,d,[e,f,g]]] = lists:usort(Term), ok. collect_fixed_apply(0, _) -> @@ -144,19 +121,19 @@ undefined_function(_Mod, _Name, Args) -> Args. error_handler_fun(Config) when is_list(Config) -> - ?line process_flag(error_handler, ?MODULE), + process_flag(error_handler, ?MODULE), %% fun(A, B, C) -> {A,B,C,X} end in module foobarblurf. B = <<131,112,0,0,0,84,3,109,96,69,208,5,175,207,75,36,93,112,218,232,222,22,251,0, - 0,0,0,0,0,0,1,100,0,11,102,111,111,98,97,114,98,108,117,114,102,97,0,98,5, - 244,197,144,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116, - 0,0,0,46,0,0,0,0,0,104,3,97,1,97,2,97,3>>, - ?line Fun = binary_to_term(B), - ?line Term = collect_fun(1024, Fun), - ?line Term = binary_to_term(term_to_binary(Term)), - ?line 1024 = length(Term), - ?line [[{foo,bar},{99,1.0},[e,f,g]]] = lists:usort(Term), - ?line {env,[{1,2,3}]} = erlang:fun_info(Fun, env), + 0,0,0,0,0,0,1,100,0,11,102,111,111,98,97,114,98,108,117,114,102,97,0,98,5, + 244,197,144,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116, + 0,0,0,46,0,0,0,0,0,104,3,97,1,97,2,97,3>>, + Fun = binary_to_term(B), + Term = collect_fun(1024, Fun), + Term = binary_to_term(term_to_binary(Term)), + 1024 = length(Term), + [[{foo,bar},{99,1.0},[e,f,g]]] = lists:usort(Term), + {env,[{1,2,3}]} = erlang:fun_info(Fun, env), ok. collect_fun(0, _) -> @@ -178,13 +155,13 @@ undefined_lambda(foobarblurf, Fun, Args) when is_function(Fun) -> Args. debug_breakpoint(Config) when is_list(Config) -> - ?line process_flag(error_handler, ?MODULE), - ?line erts_debug:breakpoint({?MODULE,foobar,5}, true), - ?line Term = break_collect(1024), - ?line Term = binary_to_term(term_to_binary(Term)), - ?line 1024 = length(Term), - ?line [[a,b,c,{d,e},[f,g,h]]] = lists:usort(Term), - ?line erts_debug:breakpoint({?MODULE,foobar,5}, false), + process_flag(error_handler, ?MODULE), + erts_debug:breakpoint({?MODULE,foobar,5}, true), + Term = break_collect(1024), + Term = binary_to_term(term_to_binary(Term)), + 1024 = length(Term), + [[a,b,c,{d,e},[f,g,h]]] = lists:usort(Term), + erts_debug:breakpoint({?MODULE,foobar,5}, false), ok. break_collect(0) -> @@ -201,5 +178,3 @@ foobar(_, _, _, _, _) -> exit(dont_execute_me). id(I) -> I. - - diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index ff8d18eef8..17555d63c6 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -1,25 +1,26 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2013. 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. -%% +%% +%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(num_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Tests the BIFs: %% abs/1 @@ -31,26 +32,28 @@ %% list_to_integer/1 %% round/1 %% trunc/1 +%% floor/1 +%% ceil/1 %% integer_to_binary/1 %% integer_to_binary/2 %% binary_to_integer/1 --export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, init_per_group/2, end_per_group/2, t_abs/1, t_float/1, t_float_to_string/1, t_integer_to_string/1, - t_string_to_integer/1, + t_string_to_integer/1, t_list_to_integer_edge_cases/1, t_string_to_float_safe/1, t_string_to_float_risky/1, - t_round/1, t_trunc/1 + t_round/1, t_trunc_and_friends/1 ]). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [t_abs, t_float, t_float_to_string, t_integer_to_string, {group, t_string_to_float}, t_string_to_integer, t_round, - t_trunc]. + t_trunc_and_friends, t_list_to_integer_edge_cases]. -groups() -> +groups() -> [{t_string_to_float, [], [t_string_to_float_safe, t_string_to_float_risky]}]. @@ -72,7 +75,7 @@ t_abs(Config) when is_list(Config) -> 5.5 = abs(id(5.5)), 0.0 = abs(id(0.0)), 100.0 = abs(id(-100.0)), - + %% Integers. 5 = abs(id(5)), 0 = abs(id(0)), @@ -92,7 +95,7 @@ t_abs(Config) when is_list(Config) -> BigNum = abs(BigNum), BigNum = abs(-BigNum), ok. - + t_float(Config) when is_list(Config) -> 0.0 = float(id(0)), 2.5 = float(id(2.5)), @@ -105,10 +108,10 @@ t_float(Config) when is_list(Config) -> 4294967305.0 = float(id(4294967305)), -4294967305.0 = float(id(-4294967305)), - %% Extremly big bignums. + %% Extremely big bignums. Big = id(list_to_integer(id(lists:duplicate(2000, $1)))), {'EXIT', {badarg, _}} = (catch float(Big)), - + ok. @@ -142,7 +145,7 @@ t_float_to_string(Config) when is_list(Config) -> 123456789012345678.0, [{decimals, 237}])), {'EXIT', {badarg, _}} = (catch float_to_binary( 123456789012345678.0, [{decimals, 237}])), - test_fts("1." ++ string:copies("0", 249) ++ "e+00", + test_fts("1." ++ lists:duplicate(249, $0) ++ "e+00", 1.0, [{scientific, 249}, compact]), X1 = float_to_list(1.0), @@ -182,7 +185,7 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]), test_fts("1.23000000000000000000e+20",1.23e20, []), ok. - + test_fts(Expect, Float) -> Expect = float_to_list(Float), BinExpect = list_to_binary(Expect), @@ -254,7 +257,7 @@ t_round(Config) when is_list(Config) -> 256 = round(id(255.6)), -1033 = round(id(-1033.3)), -1034 = round(id(-1033.6)), - + % OTP-3722: X = id((1 bsl 27) - 1), MX = -X, @@ -292,32 +295,83 @@ t_round(Config) when is_list(Config) -> 4294967297 = round(id(4294967296.9)), -4294967296 = -round(id(4294967296.1)), -4294967297 = -round(id(4294967296.9)), + + 6209607916799025 = round(id(6209607916799025.0)), + -6209607916799025 = round(id(-6209607916799025.0)), ok. -t_trunc(Config) when is_list(Config) -> - 0 = trunc(id(0.0)), - 5 = trunc(id(5.3333)), - -10 = trunc(id(-10.978987)), +%% Test trunc/1, floor/1, ceil/1, and round/1. +t_trunc_and_friends(_Config) -> + MinusZero = 0.0 / (-1.0), + 0 = trunc_and_friends(MinusZero), + 0 = trunc_and_friends(0.0), + 5 = trunc_and_friends(5.3333), + -10 = trunc_and_friends(-10.978987), - % The largest smallnum, converted to float (OTP-3722): + %% The largest smallnum, converted to float (OTP-3722): X = id((1 bsl 27) - 1), - F = id(X + 0.0), + F = X + 0.0, io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n", [X, X, binary_to_list(term_to_binary(X)), F, F, binary_to_list(term_to_binary(F)), - trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]), - X = trunc(F), - X = trunc(F+1)-1, - X = trunc(F-1)+1, - X = -trunc(-F), - X = -trunc(-F-1)-1, - X = -trunc(-F+1)+1, + trunc_and_friends(F), + trunc_and_friends(F), + binary_to_list(term_to_binary(trunc_and_friends(F)))]), + X = trunc_and_friends(F), + X = trunc_and_friends(F+1)-1, + X = trunc_and_friends(F-1)+1, + X = -trunc_and_friends(-F), + X = -trunc_and_friends(-F-1)-1, + X = -trunc_and_friends(-F+1)+1, %% Bignums. - 4294967305 = trunc(id(4294967305.7)), - -4294967305 = trunc(id(-4294967305.7)), + 4294967305 = trunc_and_friends(4294967305.7), + -4294967305 = trunc_and_friends(-4294967305.7), + 18446744073709551616 = trunc_and_friends(float(1 bsl 64)), + -18446744073709551616 = trunc_and_friends(-float(1 bsl 64)), + + %% Random. + t_trunc_and_friends_rand(100), ok. +t_trunc_and_friends_rand(0) -> + ok; +t_trunc_and_friends_rand(N) -> + F0 = rand:uniform() * math:pow(10, 50*rand:normal()), + F = case rand:uniform() of + U when U < 0.5 -> -F0; + _ -> F0 + end, + _ = trunc_and_friends(F), + t_trunc_and_friends_rand(N-1). + +trunc_and_friends(F) -> + Trunc = trunc(F), + Floor = floor(F), + Ceil = ceil(F), + Round = round(F), + + Trunc = trunc(Trunc), + Floor = floor(Floor), + Ceil = ceil(Ceil), + Round = round(Round), + + Trunc = trunc(float(Trunc)), + Floor = floor(float(Floor)), + Ceil = ceil(float(Ceil)), + Round = round(float(Round)), + + true = Floor =< Trunc andalso Trunc =< Ceil, + true = Ceil - Floor =< 1, + true = Round =:= Floor orelse Round =:= Ceil, + + if + F < 0 -> + Trunc = Ceil; + true -> + Trunc = Floor + end, + Trunc. %% Tests integer_to_binary/1. @@ -344,9 +398,9 @@ t_integer_to_string(Config) when is_list(Config) -> %% Invalid types lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:integer_to_binary(Value)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:integer_to_list(Value)) end,[atom,1.2,0.0,[$1,[$2]]]), @@ -394,18 +448,15 @@ t_string_to_integer(Config) when is_list(Config) -> test_sti(268435455), test_sti(-268435455), - %% 1 bsl 28 - 1, just before 32 bit bignum - test_sti(1 bsl 28 - 1), - %% 1 bsl 28, just beyond 32 bit small - test_sti(1 bsl 28), - %% 1 bsl 33, just beyond 32 bit - test_sti(1 bsl 33), - %% 1 bsl 60 - 1, just before 64 bit bignum - test_sti(1 bsl 60 - 1), - %% 1 bsl 60, just beyond 64 bit small - test_sti(1 bsl 60), - %% 1 bsl 65, just beyond 64 bit - test_sti(1 bsl 65), + % Interesting values around 2-pows, such as MIN_SMALL and MAX_SMALL. + lists:foreach(fun(Bits) -> + N = 1 bsl Bits, + test_sti(N - 1), + test_sti(N), + test_sti(N + 1) + end, + lists:seq(16, 130)), + %% Bignums. test_sti(123456932798748738738,16), test_sti(list_to_integer(lists:duplicate(2000, $1))), @@ -418,46 +469,102 @@ t_string_to_integer(Config) when is_list(Config) -> %% Invalid types lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch binary_to_integer(Value)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value)) end,[atom,1.2,0.0,[$1,[$2]]]), - + % Default base error cases lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:binary_to_integer( list_to_binary(Value))), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value)) - end,["1.0"," 1"," -1",""]), - + end,["1.0"," 1"," -1","","+"]), + % Custom base error cases lists:foreach(fun({Value,Base}) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch binary_to_integer( list_to_binary(Value),Base)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value,Base)) end,[{" 1",1},{" 1",37},{"2",2},{"C",11}, {"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16}, {"1z111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111",16}, {"111z11111111",16}]), - + + %% log2 calculation overflow bug in do_integer_to_list (OTP-12624) + %% Would crash with segv + 0 = list_to_integer(lists:duplicate(10000000,$0)), + + ok. + +%% Tests edge cases for list_to_integer; compares with known good values + +t_list_to_integer_edge_cases(Config) when is_list(Config) -> + %% Take integer literals and compare to their representation in ExtTerm + T = [ + {16, "0", <<131,97,0>>}, + {16, "-0", <<131,97,0>>}, + + {16, "f", <<131,97,15>>}, + {16, "-f", <<131,98,255,255,255,241>>}, + + {16, "0000000000000000000000000000000000000000000000000f", + <<131,97,15>>}, + {16, "-0000000000000000000000000000000000000000000000000f", + <<131,98,255,255,255,241>>}, + + {16, "ffffffff", <<131,110,4,0,255,255,255,255>>}, + {16, "-ffffffff", <<131,110,4,1,255,255,255,255>>}, + + {16, "7fffffff", <<131,110,4,0,255,255,255,127>>}, + {16, "-7fffffff", <<131,98,128,0,0,1>>}, + + {16, "ffffffffffffffff", + <<131,110,8,0,255,255,255,255,255,255,255,255>>}, + {16, "-ffffffffffffffff", + <<131,110,8,1,255,255,255,255,255,255,255,255>>}, + + {16, "7fffffffffffffff", + <<131,110,8,0,255,255,255,255,255,255,255,127>>}, + {16, "-7fffffffffffffff", + <<131,110,8,1,255,255,255,255,255,255,255,127>>}, + + %% Alleged 32-bit corner case (should not happen on 64-bit). At 32-4 + %% bits we may corrupt sign bit and fall out of SMALL_INT range. + {2, "1000000000000000000000000000", <<131,98,8,0,0,0>>}, + {2, "-1000000000000000000000000000", <<131,98,248,0,0,0>>}, + + %% 64-bit corner case (should not happen on 32-bit) at 64-4 bits we + %% corrupt sign bit and fall out of SMALL_INT range (bam! all dead) + {2, "100000000000000000000000000000000000000000000000000000000000", + <<131,110,8,0,0,0,0,0,0,0,0,8>>}, + {2, "-100000000000000000000000000000000000000000000000000000000000", + <<131,110,8,1,0,0,0,0,0,0,0,8>>} + ], + [begin + io:format("~s base ~p vs ~p~n", [Str, Base, Bin]), + FromStr = list_to_integer(Str, Base), + FromStr = binary_to_term(Bin) + end || {Base, Str, Bin} <- T], ok. test_sti(Num) -> [begin io:format("Testing ~p:~p",[Num,Base]), - test_sti(Num,Base) + test_sti(Num,Base) end|| Base <- lists:seq(2,36)]. test_sti(Num,Base) -> - Num = list_to_integer(int2list(Num,Base),Base), - Num = -1*list_to_integer(int2list(Num*-1,Base),Base), - Num = binary_to_integer(int2bin(Num,Base),Base), - Num = -1*binary_to_integer(int2bin(Num*-1,Base),Base). + Neg = -Num, + Num = list_to_integer(int2list(Num,Base),Base), + Neg = list_to_integer(int2list(Num*-1,Base),Base), + Num = binary_to_integer(int2bin(Num,Base),Base), + Neg = binary_to_integer(int2bin(Num*-1,Base),Base). % Calling this function (which is not supposed to be inlined) prevents % the compiler from calculating the answer, so we don't test the compiler diff --git a/erts/emulator/test/old_mod.erl b/erts/emulator/test/old_mod.erl deleted file mode 100644 index 124842390a..0000000000 --- a/erts/emulator/test/old_mod.erl +++ /dev/null @@ -1,47 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-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(old_mod). --compile(r10). - --export([sort_on_old_node/1, sorter/3]). - --include("test_server.hrl"). - -sorter(Receiver, Ref, List) -> - Receiver ! {Ref, lists:sort(List)}. - -sort_on_old_node(List) when is_list(List) -> - OldVersion = "r10", - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {X, Y, Z} = now(), - ?line NodeName = list_to_atom(OldVersion - ++ "_" - ++ integer_to_list(X) - ++ integer_to_list(Y) - ++ integer_to_list(Z)), - ?line {ok, Node} = ?t:start_node(NodeName, - peer, - [{args, " -pa " ++ Pa}, - {erl, [{release, OldVersion++"b_patched"}]}]), - ?line Ref = make_ref(), - ?line spawn_link(Node, ?MODULE, sorter, [self(), Ref, List]), - ?line SortedPids = receive {Ref, SP} -> SP end, - ?line true = ?t:stop_node(Node), - ?line SortedPids. diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl deleted file mode 100644 index 262536a068..0000000000 --- a/erts/emulator/test/old_scheduler_SUITE.erl +++ /dev/null @@ -1,414 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(old_scheduler_SUITE). - --include_lib("test_server/include/test_server.hrl"). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2]). --export([equal/1, many_low/1, few_low/1, max/1, high/1]). - --define(default_timeout, ?t:minutes(11)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - case catch erlang:system_info(modified_timing_level) of - Level when is_integer(Level) -> - {skipped, - "Modified timing (level " ++ - integer_to_list(Level) ++ - ") is enabled. Testcases gets messed " - "up by modfied timing."}; - _ -> [equal, many_low, few_low, max, high] - end. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%----------------------------------------------------------------------------------- -%% TEST SUITE DESCRIPTION -%% -%% The test case function spawns two controlling processes: Starter and Receiver. -%% Starter spawns a number of prio A and a number of prio B test processes. Each -%% test process loops for a number of times, sends a report to the Receiver, then -%% loops again. For each report, the Receiver increases a counter that corresponds -%% to the priority of the sender. After a certain amount of time, the Receiver -%% sends the collected data to the main test process and waits for the test case -%% to terminate. From this data, it's possible to calculate the average run time -%% relationship between the prio A and B test processes. -%% -%% Note that in order to be able to run tests with high or max prio test processes, -%% the main test process and the Receiver needs to run at max prio, or they will -%% be starved by the test processes. The controlling processes must not wait for -%% messages from a normal (or low) prio process while max or high prio test processes -%% are running (which happens e.g. if an io function is called). -%%----------------------------------------------------------------------------------- - -init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?default_timeout), - %% main test process needs max prio - ?line Prio = process_flag(priority, max), - ?line MS = erlang:system_flag(multi_scheduling, block), - [{prio,Prio},{watchdog,Dog},{multi_scheduling, MS}|Config]. - -end_per_testcase(_Case, Config) -> - erlang:system_flag(multi_scheduling, unblock), - Dog=?config(watchdog, Config), - Prio=?config(prio, Config), - process_flag(priority, Prio), - test_server:timetrap_cancel(Dog), - ok. - -ok(Config) when is_list(Config) -> - case ?config(multi_scheduling, Config) of - blocked -> - {comment, - "Multi-scheduling blocked during test. This testcase was not " - "written to work with multiple schedulers."}; - _ -> ok - end. - -%% Run equal number of low and normal prio processes. - -equal(suite) -> []; -equal(doc) -> []; -equal(Config) when is_list(Config) -> - ?line Self = self(), - - %% specify number of test processes to run - Normal = {normal,500}, - Low = {low,500}, - - %% specify time of test (in seconds) - Time = 30, - - %% start controllers - ?line Receiver = - spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end), - ?line Starter = - spawn(fun() -> starter(Normal, Low, Receiver) end), - - %% receive test data from Receiver - ?line {NRs,NAvg,LRs,LAvg,Ratio} = - receive - {Receiver,Res} -> Res - end, - - %% stop controllers and test processes - ?line exit(Starter, kill), - ?line exit(Receiver, kill), - - io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", - [NRs,NAvg,LRs,LAvg,Ratio]), - - %% runtime ratio between normal and low should be ~8 - if Ratio < 7.5 ; Ratio > 8.5 -> - ?t:fail({bad_ratio,Ratio}); - true -> - ok(Config) - end. - - -%% Run many low and few normal prio processes. - -many_low(suite) -> []; -many_low(doc) -> []; -many_low(Config) when is_list(Config) -> - ?line Self = self(), - Normal = {normal,1}, - Low = {low,1000}, - - %% specify time of test (in seconds) - Time = 30, - - ?line Receiver = - spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end), - ?line Starter = - spawn(fun() -> starter(Normal, Low, Receiver) end), - ?line {NRs,NAvg,LRs,LAvg,Ratio} = - receive - {Receiver,Res} -> Res - end, - ?line exit(Starter, kill), - ?line exit(Receiver, kill), - io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", - [NRs,NAvg,LRs,LAvg,Ratio]), - if Ratio < 7.5 ; Ratio > 8.5 -> - ?t:fail({bad_ratio,Ratio}); - true -> - ok(Config) - end. - - -%% Run few low and many normal prio processes. - -few_low(suite) -> []; -few_low(doc) -> []; -few_low(Config) when is_list(Config) -> - ?line Self = self(), - Normal = {normal,1000}, - Low = {low,1}, - - %% specify time of test (in seconds) - Time = 30, - - ?line Receiver = - spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end), - ?line Starter = - spawn(fun() -> starter(Normal, Low, Receiver) end), - ?line {NRs,NAvg,LRs,LAvg,Ratio} = - receive - {Receiver,Res} -> Res - end, - ?line exit(Starter, kill), - ?line exit(Receiver, kill), - io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", - [NRs,NAvg,LRs,LAvg,Ratio]), - if Ratio < 7.0 ; Ratio > 8.5 -> - ?t:fail({bad_ratio,Ratio}); - true -> - ok(Config) - end. - - -%% Run max prio processes and verify they get at least as much -%% runtime as high, normal and low. - -max(suite) -> []; -max(doc) -> []; -max(Config) when is_list(Config) -> - max = process_flag(priority, max), % should already be max (init_per_tc) - ?line Self = self(), - Max = {max,2}, - High = {high,2}, - Normal = {normal,100}, - Low = {low,100}, - - %% specify time of test (in seconds) - Time = 30, - - ?line Receiver1 = - spawn(fun() -> receiver(now(), Time, Self, Max, High) end), - ?line Starter1 = - spawn(fun() -> starter(Max, High, Receiver1) end), - ?line {M1Rs,M1Avg,HRs,HAvg,Ratio1} = - receive - {Receiver1,Res1} -> Res1 - end, - ?line exit(Starter1, kill), - ?line exit(Receiver1, kill), - io:format("Reports: ~w max (~w/proc), ~w high (~w/proc). Ratio: ~w~n", - [M1Rs,M1Avg,HRs,HAvg,Ratio1]), - if Ratio1 < 1.0 -> - ?t:fail({bad_ratio,Ratio1}); - true -> - ok(Config) - end, - - ?line Receiver2 = - spawn(fun() -> receiver(now(), Time, Self, Max, Normal) end), - ?line Starter2 = - spawn(fun() -> starter(Max, Normal, Receiver2) end), - ?line {M2Rs,M2Avg,NRs,NAvg,Ratio2} = - receive - {Receiver2,Res2} -> Res2 - end, - ?line exit(Starter2, kill), - ?line exit(Receiver2, kill), - io:format("Reports: ~w max (~w/proc), ~w normal (~w/proc). Ratio: ~w~n", - [M2Rs,M2Avg,NRs,NAvg,Ratio2]), - if Ratio2 < 1.0 -> - ?t:fail({bad_ratio,Ratio2}); - true -> - ok - end, - - ?line Receiver3 = - spawn(fun() -> receiver(now(), Time, Self, Max, Low) end), - ?line Starter3 = - spawn(fun() -> starter(Max, Low, Receiver3) end), - ?line {M3Rs,M3Avg,LRs,LAvg,Ratio3} = - receive - {Receiver3,Res3} -> Res3 - end, - ?line exit(Starter3, kill), - ?line exit(Receiver3, kill), - io:format("Reports: ~w max (~w/proc), ~w low (~w/proc). Ratio: ~w~n", - [M3Rs,M3Avg,LRs,LAvg,Ratio3]), - if Ratio3 < 1.0 -> - ?t:fail({bad_ratio,Ratio3}); - true -> - ok(Config) - end. - - -%% Run high prio processes and verify they get at least as much -%% runtime as normal and low. - -high(suite) -> []; -high(doc) -> []; -high(Config) when is_list(Config) -> - max = process_flag(priority, max), % should already be max (init_per_tc) - ?line Self = self(), - High = {high,2}, - Normal = {normal,100}, - Low = {low,100}, - - %% specify time of test (in seconds) - Time = 30, - - ?line Receiver1 = - spawn(fun() -> receiver(now(), Time, Self, High, Normal) end), - ?line Starter1 = - spawn(fun() -> starter(High, Normal, Receiver1) end), - ?line {H1Rs,H1Avg,NRs,NAvg,Ratio1} = - receive - {Receiver1,Res1} -> Res1 - end, - ?line exit(Starter1, kill), - ?line exit(Receiver1, kill), - io:format("Reports: ~w high (~w/proc), ~w normal (~w/proc). Ratio: ~w~n", - [H1Rs,H1Avg,NRs,NAvg,Ratio1]), - if Ratio1 < 1.0 -> - ?t:fail({bad_ratio,Ratio1}); - true -> - ok - end, - - ?line Receiver2 = - spawn(fun() -> receiver(now(), Time, Self, High, Low) end), - ?line Starter2 = - spawn(fun() -> starter(High, Low, Receiver2) end), - ?line {H2Rs,H2Avg,LRs,LAvg,Ratio2} = - receive - {Receiver2,Res2} -> Res2 - end, - ?line exit(Starter2, kill), - ?line exit(Receiver2, kill), - io:format("Reports: ~w high (~w/proc), ~w low (~w/proc). Ratio: ~w~n", - [H2Rs,H2Avg,LRs,LAvg,Ratio2]), - if Ratio2 < 1.0 -> - ?t:fail({bad_ratio,Ratio2}); - true -> - ok(Config) - end. - - -%%----------------------------------------------------------------------------------- -%% Controller processes and help functions -%%----------------------------------------------------------------------------------- - -receiver(T0, TimeSec, Main, {P1,P1N}, {P2,P2N}) -> - %% prio should be max so that mailbox doesn't overflow - process_flag(priority, max), - receiver(T0, TimeSec*1000, Main, P1,P1N,0, P2,P2N,0, 100000). - -%% uncomment lines below to get life sign (debug) -receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 0) -> -% T = elapsed_ms(T0, now()), -% erlang:display({round(T/1000),P1Rs,P2Rs}), - receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 100000); - -receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, C) -> - Remain = Time - elapsed_ms(T0, now()), % test time remaining - Remain1 = if Remain < 0 -> - 0; - true -> - Remain - end, - {P1Rs1,P2Rs1} = - receive - {_Pid,P1} -> % report from a P1 process - {P1Rs+1,P2Rs}; - {_Pid,P2} -> % report from a P2 process - {P1Rs,P2Rs+1} - after Remain1 -> - {P1Rs,P2Rs} - end, - if Remain > 0 -> % keep going - receiver(T0, Time, Main, P1,P1N,P1Rs1, P2,P2N,P2Rs1, C-1); - true -> % finish - %% calculate results and send to main test process - P1Avg = P1Rs1/P1N, - P2Avg = P2Rs1/P2N, - Ratio = if P2Avg < 1.0 -> P1Avg; - true -> P1Avg/P2Avg - end, - Main ! {self(),{P1Rs1,round(P1Avg),P2Rs1,round(P2Avg),Ratio}}, - flush_loop() - end. - -starter({P1,P1N}, {P2,P2N}, Receiver) -> - %% start N1 processes with prio P1 - start_p(P1, P1N, Receiver), - %% start N2 processes with prio P2 - start_p(P2, P2N, Receiver), - erlang:display({started,P1N+P2N}), - flush_loop(). - -start_p(_, 0, _) -> - ok; -start_p(Prio, N, Receiver) -> - spawn_link(fun() -> p(Prio, Receiver) end), - start_p(Prio, N-1, Receiver). - -p(Prio, Receiver) -> - %% set process priority - process_flag(priority, Prio), - p_loop(0, Prio, Receiver). - -p_loop(100, Prio, Receiver) -> - receive after 0 -> ok end, - %% if Receiver gone, we're done - case is_process_alive(Receiver) of - false -> exit(bye); - true -> ok - end, - %% send report - Receiver ! {self(),Prio}, - p_loop(0, Prio, Receiver); - -p_loop(N, Prio, Receiver) -> - p_loop(N+1, Prio, Receiver). - - -flush_loop() -> - receive _ -> - ok - end, - flush_loop(). - -elapsed_ms({_MS0,S0,MuS0},{_MS1,S1,MuS1}) -> - round(((S1-S0)*1000)+((MuS1-MuS0)/1000)). diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl index ef4689b850..08655d32a5 100644 --- a/erts/emulator/test/op_SUITE.erl +++ b/erts/emulator/test/op_SUITE.erl @@ -1,86 +1,70 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(op_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - bsl_bsr/1,logical/1,t_not/1,relop_simple/1,relop/1,complex_relop/1]). +-export([all/0, suite/0, + bsl_bsr/1,logical/1,t_not/1,relop_simple/1,relop/1,complex_relop/1]). -export([]). -import(lists, [foldl/3,flatmap/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> [bsl_bsr, logical, t_not, relop_simple, relop, complex_relop]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - %% Test the bsl and bsr operators. bsl_bsr(Config) when is_list(Config) -> Vs = [unvalue(V) || V <- [-16#8000009-2,-1,0,1,2,73,16#8000000,bad,[]]], - Cases = [{Op,X,Y} || Op <- ['bsr','bsl'], X <- Vs, Y <- Vs], - ?line run_test_module(Cases, false), - {comment,integer_to_list(length(Cases)) ++ " cases"}. + %% Try to use less memory by splitting the cases + + Cases1 = [{Op,X,Y} || Op <- ['bsl'], X <- Vs, Y <- Vs], + N1 = length(Cases1), + run_test_module(Cases1, false), -logical(doc) -> "Test the logical operators and internal BIFs."; + Cases2 = [{Op,X,Y} || Op <- ['bsr'], X <- Vs, Y <- Vs], + N2 = length(Cases2), + run_test_module(Cases2, false), + {comment,integer_to_list(N1 + N2) ++ " cases"}. + +%% Test the logical operators and internal BIFs. logical(Config) when is_list(Config) -> Vs0 = [true,false,bad], Vs = [unvalue(V) || V <- Vs0], Cases = [{Op,X,Y} || Op <- ['and','or','xor'], X <- Vs, Y <- Vs], - ?line run_test_module(Cases, false), + run_test_module(Cases, false), {comment,integer_to_list(length(Cases)) ++ " cases"}. -t_not(doc) -> "Test the not operator and internal BIFs."; +%% Test the not operator and internal BIFs. t_not(Config) when is_list(Config) -> - ?line Cases = [{'not',unvalue(V)} || V <- [true,false,42,bad]], - ?line run_test_module(Cases, false), + Cases = [{'not',unvalue(V)} || V <- [true,false,42,bad]], + run_test_module(Cases, false), {comment,integer_to_list(length(Cases)) ++ " cases"}. -relop_simple(doc) -> "Test that simlpe relations between relation operators hold."; +%% Test that simlpe relations between relation operators hold. relop_simple(Config) when is_list(Config) -> Big1 = 19738924729729787487784874, Big2 = 38374938373887374983978484, @@ -89,51 +73,52 @@ relop_simple(Config) when is_list(Config) -> T1 = erlang:make_tuple(3,87), T2 = erlang:make_tuple(3,87), Terms = [-F2,Big2,-F1,-Big1,-33,-33.0,0,0.0,42,42.0,Big1,F1,Big2,F2,a,b, - {T1,a},{T2,b},[T1,Big1],[T2,Big2]], - - ?line Combos = [{V1,V2} || V1 <- Terms, V2 <- Terms], - + {T1,a},{T2,b},[T1,Big1],[T2,Big2]], + + Combos = [{V1,V2} || V1 <- Terms, V2 <- Terms], + lists:foreach(fun({A,B}) -> relop_simple_do(A,B) end, - Combos), - - repeat(fun() -> Size = random:uniform(100), - Rnd1 = make_rand_term(Size), - {Rnd2,0} = clone_and_mutate(Rnd1, random:uniform(Size)), - relop_simple_do(Rnd1,Rnd2) - end, - 1000), + Combos), + + repeat(fun() -> + Size = rand:uniform(100), + Rnd1 = make_rand_term(Size), + {Rnd2,0} = clone_and_mutate(Rnd1, rand:uniform(Size)), + relop_simple_do(Rnd1,Rnd2) + end, + 1000), ok. relop_simple_do(V1,V2) -> %%io:format("compare ~p\n and ~p\n",[V1,V2]), L = V1 < V2, - ?line L = not (V1 >= V2), - ?line L = V2 > V1, - ?line L = not (V2 =< V1), + L = not (V1 >= V2), + L = V2 > V1, + L = not (V2 =< V1), G = V1 > V2, - ?line G = not (V1 =< V2), - ?line G = V2 < V1, - ?line G = not (V2 >= V1), - + G = not (V1 =< V2), + G = V2 < V1, + G = not (V2 >= V1), + ID = V1 =:= V2, - ?line ID = V2 =:= V1, - ?line ID = not (V1 =/= V2), - ?line ID = not (V2 =/= V1), - + ID = V2 =:= V1, + ID = not (V1 =/= V2), + ID = not (V2 =/= V1), + EQ = V1 == V2, - ?line EQ = V2 == V1, - ?line EQ = not (V1 /= V2), - ?line EQ = not (V2 /= V1), - - ?line case {L, EQ, ID, G, cmp_emu(V1,V2)} of - { true, false, false, false, -1} -> ok; - {false, true, false, false, 0} -> ok; - {false, true, true, false, 0} -> ok; - {false, false, false, true, +1} -> ok - end. - + EQ = V2 == V1, + EQ = not (V1 /= V2), + EQ = not (V2 /= V1), + + case {L, EQ, ID, G, cmp_emu(V1,V2)} of + { true, false, false, false, -1} -> ok; + {false, true, false, false, 0} -> ok; + {false, true, true, false, 0} -> ok; + {false, false, false, true, +1} -> ok + end. + %% Emulate internal "cmp" cmp_emu(A,B) when is_tuple(A), is_tuple(B) -> SA = size(A), @@ -144,8 +129,8 @@ cmp_emu(A,B) when is_tuple(A), is_tuple(B) -> end; cmp_emu([A|TA],[B|TB]) -> case cmp_emu(A,B) of - 0 -> cmp_emu(TA,TB); - CMP -> CMP + 0 -> cmp_emu(TA,TB); + CMP -> CMP end; cmp_emu(A,B) -> %% We cheat and use real "cmp" for the primitive types. @@ -153,48 +138,48 @@ cmp_emu(A,B) -> A > B -> +1; true -> 0 end. - + make_rand_term(1) -> make_rand_term_single(); make_rand_term(Arity) -> - case random:uniform(3) of - 1 -> - make_rand_list(Arity); - 2 -> - list_to_tuple(make_rand_list(Arity)); - 3 -> - {Car,Rest} = make_rand_term_rand_size(Arity), - [Car|make_rand_term(Rest)] + case rand:uniform(3) of + 1 -> + make_rand_list(Arity); + 2 -> + list_to_tuple(make_rand_list(Arity)); + 3 -> + {Car,Rest} = make_rand_term_rand_size(Arity), + [Car|make_rand_term(Rest)] end. make_rand_term_single() -> - Range = 1 bsl random:uniform(200), - case random:uniform(12) of - 1 -> random; - 2 -> uniform; - 3 -> random:uniform(Range) - (Range div 2); - 4 -> Range * (random:uniform() - 0.5); - 5 -> 0; - 6 -> 0.0; - 7 -> make_ref(); - 8 -> self(); - 9 -> term_to_binary(random:uniform(Range)); - 10 -> fun(X) -> X*Range end; - 11 -> fun(X) -> X/Range end; - 12 -> [] + Range = 1 bsl rand:uniform(200), + case rand:uniform(12) of + 1 -> random; + 2 -> uniform; + 3 -> rand:uniform(Range) - (Range div 2); + 4 -> Range * (rand:uniform() - 0.5); + 5 -> 0; + 6 -> 0.0; + 7 -> make_ref(); + 8 -> self(); + 9 -> term_to_binary(rand:uniform(Range)); + 10 -> fun(X) -> X*Range end; + 11 -> fun(X) -> X/Range end; + 12 -> [] end. make_rand_term_rand_size(1) -> {make_rand_term(1), 0}; make_rand_term_rand_size(MaxArity) -> - Arity = random:uniform(MaxArity-1), + Arity = rand:uniform(MaxArity-1), {make_rand_term(Arity), MaxArity-Arity}. make_rand_list(0) -> []; make_rand_list(Arity) -> {Term, Rest} = make_rand_term_rand_size(Arity), [Term | make_rand_list(Rest)]. - + clone_and_mutate(Term, 0) -> {clone(Term), 0}; @@ -217,81 +202,81 @@ clone(Term) -> my_list_to_tuple(List) -> try list_to_tuple(List) catch - error:badarg -> - %%io:format("my_list_to_tuple got badarg exception.\n"), - list_to_tuple(purify_list(List)) + error:badarg -> + %%io:format("my_list_to_tuple got badarg exception.\n"), + list_to_tuple(purify_list(List)) end. - + purify_list(List) -> lists:reverse(purify_list(List, [])). purify_list([], Acc) -> Acc; purify_list([H|T], Acc) -> purify_list(T, [H|Acc]); purify_list(Other, Acc) -> [Other|Acc]. - -relop(doc) -> "Test the relational operators and internal BIFs on literals."; + +%% Test the relational operators and internal BIFs on literals. relop(Config) when is_list(Config) -> Big1 = -38374938373887374983978484, Big2 = 19738924729729787487784874, F1 = float(Big1), F2 = float(Big2), Vs0 = [a,b,-33,-33.0,0,0.0,42,42.0,Big1,Big2,F1,F2], - ?line Vs = [unvalue(V) || V <- Vs0], + Vs = [unvalue(V) || V <- Vs0], Ops = ['==', '/=', '=:=', '=/=', '<', '=<', '>', '>='], - ?line binop(Ops, Vs). + binop(Ops, Vs). -complex_relop(doc) -> - "Test the relational operators and internal BIFs on lists and tuples."; +%% Test the relational operators and internal BIFs on lists and tuples. complex_relop(Config) when is_list(Config) -> Big = 99678557475484872464269855544643333, Float = float(Big), Vs0 = [an_atom,42.0,42,Big,Float], Vs = flatmap(fun(X) -> [unvalue({X}),unvalue([X])] end, Vs0), Ops = ['==', '/=', '=:=', '=/=', '<', '=<', '>', '>='], - ?line binop(Ops, Vs). + binop(Ops, Vs). binop(Ops, Vs) -> - Run = fun(Op, N) -> ?line Cases = [{Op,V1,V2} || V1 <- Vs, V2 <- Vs], - ?line run_test_module(Cases, true), - N + length(Cases) end, - ?line NumCases = foldl(Run, 0, Ops), + Run = fun(Op, N) -> Cases = [{Op,V1,V2} || V1 <- Vs, V2 <- Vs], + run_test_module(Cases, true), + N + length(Cases) end, + NumCases = foldl(Run, 0, Ops), {comment,integer_to_list(NumCases) ++ " cases"}. - + run_test_module(Cases, GuardsOk) -> - ?line Es = [expr(C) || C <- Cases], - ?line Ok = unvalue(ok), - ?line Gts = case GuardsOk of - true -> - Ges = [guard_expr(C) || C <- Cases], - ?line lists:foldr(fun guard_test/2, [Ok], Ges); - false -> - [Ok] - end, - ?line Fun1 = make_function(guard_tests, Gts), - ?line Bts = lists:foldr(fun body_test/2, [Ok], Es), - ?line Fun2 = make_function(body_tests, Bts), - ?line Bbts = lists:foldr(fun internal_bif/2, [Ok], Es), - ?line Fun3 = make_function(bif_tests, Bbts), - ?line Id = {function,1,id,1,[{clause,1,[{var,1,'I'}],[],[{var,1,'I'}]}]}, - ?line Module = make_module(op_tests, [Fun1,Fun2,Fun3,Id]), - ?line lists:foreach(fun(F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Module), + Es = [expr(C) || C <- Cases], + Ok = unvalue(ok), + Gts = case GuardsOk of + true -> + Ges = [guard_expr(C) || C <- Cases], + lists:foldr(fun guard_test/2, [Ok], Ges); + false -> + [Ok] + end, + Fun1 = make_function(guard_tests, Gts), + Bts = lists:foldr(fun body_test/2, [Ok], Es), + Fun2 = make_function(body_tests, Bts), + Bbts = lists:foldr(fun internal_bif/2, [Ok], Es), + Fun3 = make_function(bif_tests, Bbts), + Id = {function,1,id,1,[{clause,1,[{var,1,'I'}],[],[{var,1,'I'}]}]}, + Module0 = make_module(op_tests, [Fun1,Fun2,Fun3,Id]), + Module = erl_parse:new_anno(Module0), + lists:foreach(fun(F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Module), %% Compile, load, and run the generated module. - Native = case ?t:is_native(?MODULE) of - true -> [native]; - false -> [] - end, - ?line {ok,Mod,Code1} = compile:forms(Module, [time|Native]), - ?line code:delete(Mod), - ?line code:purge(Mod), - ?line {module,Mod} = code:load_binary(Mod, Mod, Code1), - ?line run_function(Mod, guard_tests), - ?line run_function(Mod, body_tests), - ?line run_function(Mod, bif_tests), - - ?line true = code:delete(Mod), - ?line code:purge(Mod), + Native = case test_server:is_native(?MODULE) of + true -> [native]; + false -> [] + end, + {ok,Mod,Code1} = compile:forms(Module, [time|Native]), + code:delete(Mod), + code:purge(Mod), + {module,Mod} = code:load_binary(Mod, Mod, Code1), + run_function(Mod, guard_tests), + run_function(Mod, body_tests), + run_function(Mod, bif_tests), + + true = code:delete(Mod), + code:purge(Mod), ok. @@ -315,19 +300,19 @@ guard_expr({Op,X,Y}) -> run_function(Mod, Name) -> case catch Mod:Name() of - {'EXIT',Reason} -> - io:format("~p", [get(last)]), - ?t:fail({'EXIT',Reason}); - _Other -> - ok + {'EXIT',Reason} -> + io:format("~p", [get(last)]), + ct:fail({'EXIT',Reason}); + _Other -> + ok end. - + guard_test({E,Expr,Res}, Tail) -> True = unvalue(true), [save_term(Expr), {match,1,unvalue(Res), {'if',1,[{clause,1,[],[[E]],[True]}, - {clause,1,[],[[True]],[unvalue(false)]}]}}|Tail]. + {clause,1,[],[[True]],[unvalue(false)]}]}}|Tail]. body_test({E,Expr,{'EXIT',_}}, Tail) -> [save_term(Expr), @@ -353,8 +338,8 @@ internal_bif(Op, Args, Expr, Res, Tail) -> save_term(Term) -> {call,1, - {atom,1,put}, - [{atom,1,last},unvalue(Term)]}. + {atom,1,put}, + [{atom,1,last},unvalue(Term)]}. make_module(Name, Funcs) -> [{attribute,1,module,Name}, @@ -364,15 +349,18 @@ make_module(Name, Funcs) -> make_function(Name, Body) -> {function,1,Name,0,[{clause,1,[],[],Body}]}. - -eval(E) -> - ?line case catch erl_eval:exprs(E, []) of - {'EXIT',Reason} -> {'EXIT',Reason}; - {value,Val,_Bs} -> Val - end. - -unvalue(V) -> erl_parse:abstract(V). - + +eval(E0) -> + E = erl_parse:new_anno(E0), + case catch erl_eval:exprs(E, []) of + {'EXIT',Reason} -> {'EXIT',Reason}; + {value,Val,_Bs} -> Val + end. + +unvalue(V) -> + Abstr = erl_parse:abstract(V), + erl_parse:anno_to_term(Abstr). + value({nil,_}) -> []; value({integer,_,X}) -> X; value({string,_,X}) -> X; diff --git a/erts/emulator/test/os_signal_SUITE.erl b/erts/emulator/test/os_signal_SUITE.erl new file mode 100644 index 0000000000..6bafb0e18c --- /dev/null +++ b/erts/emulator/test/os_signal_SUITE.erl @@ -0,0 +1,357 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% File: os_signal_SUITE.erl +%% Author: Björn-Egil Dahlberg +%% Created: 2017-01-13 +%% + +-module(os_signal_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-export([all/0, suite/0]). +-export([init_per_testcase/2, end_per_testcase/2]). +-export([init_per_suite/1, end_per_suite/1]). + +-export([set_alarm/1, fork/0, get_exit_code/1]). + +% Test cases +-export([set_unset/1, + t_sighup/1, + t_sigusr1/1, + t_sigusr2/1, + t_sigterm/1, + t_sigalrm/1, + t_sigchld/1, + t_sigchld_fork/1]). + +-define(signal_server, erl_signal_server). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. + +all() -> + case os:type() of + {win32, _} -> []; + _ -> [set_unset, + t_sighup, + t_sigusr1, + t_sigusr2, + t_sigterm, + t_sigalrm, + t_sigchld, + t_sigchld_fork] + end. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Pid = erlang:whereis(?signal_server), + true = erlang:unregister(?signal_server), + [{signal_server, Pid}|Config]. + +end_per_testcase(_Func, Config) -> + case proplists:get_value(signal_server, Config) of + undefined -> ok; + Pid -> + true = erlang:register(?signal_server, Pid), + ok + end. + +init_per_suite(Config) -> + load_nif(Config), + Config. + +end_per_suite(_Config) -> + ok. + +%% tests + +set_unset(_Config) -> + Signals = [sighup, %sigint, + sigquit, %sigill, + sigabrt, + sigalrm, sigterm, + sigusr1, sigusr2, + sigchld, + sigstop, sigtstp], + F1 = fun(Sig) -> ok = os:set_signal(Sig,handle) end, + F2 = fun(Sig) -> ok = os:set_signal(Sig,default) end, + F3 = fun(Sig) -> ok = os:set_signal(Sig,ignore) end, + %% set handle + ok = lists:foreach(F1, Signals), + %% set ignore + ok = lists:foreach(F2, Signals), + %% set default + ok = lists:foreach(F3, Signals), + ok. + +t_sighup(_Config) -> + Pid1 = setup_service(), + OsPid = os:getpid(), + os:set_signal(sighup, handle), + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sighup}, + {notify,sighup}, + {notify,sighup}] = Msgs1, + %% no proc + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + %% ignore + Pid2 = setup_service(), + os:set_signal(sighup, ignore), + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + Msgs2 = fetch_msgs(Pid2), + io:format("Msgs2: ~p~n", [Msgs2]), + [] = Msgs2, + %% reset to handle (it's the default) + os:set_signal(sighup, handle), + ok. + +t_sigusr1(_Config) -> + Pid1 = setup_service(), + OsPid = os:getpid(), + os:set_signal(sigusr1, handle), + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sigusr1}, + {notify,sigusr1}, + {notify,sigusr1}] = Msgs1, + %% no proc + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + %% ignore + Pid2 = setup_service(), + os:set_signal(sigusr1, ignore), + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + Msgs2 = fetch_msgs(Pid2), + io:format("Msgs2: ~p~n", [Msgs2]), + [] = Msgs2, + %% reset to ignore (it's the default) + os:set_signal(sigusr1, handle), + ok. + +t_sigusr2(_Config) -> + Pid1 = setup_service(), + OsPid = os:getpid(), + os:set_signal(sigusr2, handle), + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sigusr2}, + {notify,sigusr2}, + {notify,sigusr2}] = Msgs1, + %% no proc + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + %% ignore + Pid2 = setup_service(), + os:set_signal(sigusr2, ignore), + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + Msgs2 = fetch_msgs(Pid2), + io:format("Msgs2: ~p~n", [Msgs2]), + [] = Msgs2, + %% reset to ignore (it's the default) + os:set_signal(sigusr2, ignore), + ok. + +t_sigterm(_Config) -> + Pid1 = setup_service(), + OsPid = os:getpid(), + os:set_signal(sigterm, handle), + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sigterm}, + {notify,sigterm}, + {notify,sigterm}] = Msgs1, + %% no proc + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + %% ignore + Pid2 = setup_service(), + os:set_signal(sigterm, ignore), + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + Msgs2 = fetch_msgs(Pid2), + io:format("Msgs2: ~p~n", [Msgs2]), + [] = Msgs2, + %% reset to handle (it's the default) + os:set_signal(sigterm, handle), + ok. + +t_sigchld(_Config) -> + Pid1 = setup_service(), + OsPid = os:getpid(), + os:set_signal(sigchld, handle), + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sigchld}, + {notify,sigchld}, + {notify,sigchld}] = Msgs1, + %% no proc + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + %% ignore + Pid2 = setup_service(), + os:set_signal(sigchld, ignore), + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + Msgs2 = fetch_msgs(Pid2), + io:format("Msgs2: ~p~n", [Msgs2]), + [] = Msgs2, + %% reset to handle (it's the default) + os:set_signal(sigchld, ignore), + ok. + + +t_sigalrm(_Config) -> + Pid1 = setup_service(), + ok = os:set_signal(sigalrm, handle), + ok = os_signal_SUITE:set_alarm(1), + receive after 3000 -> ok end, + Msgs1 = fetch_msgs(Pid1), + [{notify,sigalrm}] = Msgs1, + io:format("Msgs1: ~p~n", [Msgs1]), + os:set_signal(sigalrm, ignore), + Pid2 = setup_service(), + ok = os_signal_SUITE:set_alarm(1), + receive after 3000 -> ok end, + Msgs2 = fetch_msgs(Pid2), + [] = Msgs2, + io:format("Msgs2: ~p~n", [Msgs2]), + Pid3 = setup_service(), + os:set_signal(sigalrm, handle), + ok = os_signal_SUITE:set_alarm(1), + receive after 3000 -> ok end, + Msgs3 = fetch_msgs(Pid3), + [{notify,sigalrm}] = Msgs3, + io:format("Msgs3: ~p~n", [Msgs3]), + os:set_signal(sigalrm, ignore), + ok. + +t_sigchld_fork(_Config) -> + Pid1 = setup_service(), + ok = os:set_signal(sigchld, handle), + {ok,OsPid} = os_signal_SUITE:fork(), + receive after 3000 -> ok end, + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sigchld}] = Msgs1, + {ok,Status} = os_signal_SUITE:get_exit_code(OsPid), + io:format("exit status from ~w : ~w~n", [OsPid,Status]), + 42 = Status, + %% reset to ignore (it's the default) + os:set_signal(sigchld, ignore), + ok. + + +%% nif stubs + +set_alarm(_Secs) -> no. +fork() -> no. +get_exit_code(_OsPid) -> no. + +%% aux + +setup_service() -> + Pid = spawn_link(fun msgs/0), + true = erlang:register(?signal_server, Pid), + Pid. + +msgs() -> + msgs([]). +msgs(Ms) -> + receive + {Pid, fetch_msgs} -> Pid ! {self(), lists:reverse(Ms)}; + Msg -> + msgs([Msg|Ms]) + end. + +fetch_msgs(Pid) -> + Pid ! {self(), fetch_msgs}, + receive {Pid, Msgs} -> Msgs end. + +kill(Signal, Pid) -> + {0,_} = run("kill", ["-s", Signal, Pid]), + receive after 200 -> ok end, + ok. + +load_nif(Config) -> + Path = proplists:get_value(data_dir, Config), + case erlang:load_nif(filename:join(Path,"os_signal_nif"), 0) of + ok -> ok; + {error,{reload,_}} -> ok + end. + +run(Program0, Args) -> run(".", Program0, Args). +run(Cwd, Program0, Args) when is_list(Cwd) -> + Program = case os:find_executable(Program0) of + Path when is_list(Path) -> + Path; + false -> + exit(no) + end, + Options = [{args,Args},binary,exit_status,stderr_to_stdout, + {line,4096}, {cd, Cwd}], + try open_port({spawn_executable,Program}, Options) of + Port -> + run_loop(Port, []) + catch + error:_ -> + exit(no) + end. + +run_loop(Port, Output) -> + receive + {Port,{exit_status,Status}} -> + {Status,lists:reverse(Output)}; + {Port,{data,{eol,Bin}}} -> + run_loop(Port, [Bin|Output]); + _Msg -> + run_loop(Port, Output) + end. diff --git a/erts/emulator/test/os_signal_SUITE_data/Makefile.src b/erts/emulator/test/os_signal_SUITE_data/Makefile.src new file mode 100644 index 0000000000..a7f5cdbba5 --- /dev/null +++ b/erts/emulator/test/os_signal_SUITE_data/Makefile.src @@ -0,0 +1,6 @@ + +NIF_LIBS = os_signal_nif@dll@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ diff --git a/erts/emulator/test/os_signal_SUITE_data/os_signal_nif.c b/erts/emulator/test/os_signal_SUITE_data/os_signal_nif.c new file mode 100644 index 0000000000..78e1348383 --- /dev/null +++ b/erts/emulator/test/os_signal_SUITE_data/os_signal_nif.c @@ -0,0 +1,66 @@ +#include <sys/wait.h> +#include <stdlib.h> +#include <unistd.h> +#include <stdio.h> + +#include <erl_nif.h> + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static ERL_NIF_TERM set_alarm(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int t; + if (!enif_get_int(env, argv[0], &t)) { + return enif_make_badarg(env); + } + + alarm(t); + + return enif_make_atom(env, "ok"); +} + +static ERL_NIF_TERM fork_0(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + pid_t pid; + + pid = fork(); + + if (pid == 0) { + /* child */ + exit(42); + } + + return enif_make_tuple(env, 2, + enif_make_atom(env, "ok"), + enif_make_int(env, (int)pid)); +} + +static ERL_NIF_TERM get_exit_code(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int x; + pid_t pid; + if (!enif_get_int(env, argv[0], &x)) { + return enif_make_badarg(env); + } + + pid = (pid_t) x; + + waitpid(pid, &x, 0); + + return enif_make_tuple(env, 2, + enif_make_atom(env, "ok"), + enif_make_int(env, WEXITSTATUS(x))); +} + + +static ErlNifFunc nif_funcs[] = +{ + {"set_alarm", 1, set_alarm}, + {"fork", 0, fork_0}, + {"get_exit_code", 1, get_exit_code} +}; + +ERL_NIF_INIT(os_signal_SUITE,nif_funcs,load,NULL,NULL,NULL) diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index e01b2f253b..e46665a881 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -73,65 +74,128 @@ %% --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2, - init_per_suite/1, end_per_suite/1, - stream_small/1, stream_big/1, - basic_ping/1, slow_writes/1, bad_packet/1, bad_port_messages/1, - mul_basic/1, mul_slow_writes/1, - dying_port/1, port_program_with_path/1, - open_input_file_port/1, open_output_file_port/1, - iter_max_ports/1, eof/1, input_only/1, output_only/1, - name1/1, - t_binary/1, parallell/1, t_exit/1, - env/1, bad_env/1, cd/1, exit_status/1, - tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1, - 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, close_deaf_port/1, - unregister_name/1, parallelism_option/1]). - --export([do_iter_max_ports/2]). +-export([all/0, suite/0, groups/0, init_per_testcase/2, end_per_testcase/2, + init_per_suite/1, end_per_suite/1]). +-export([ + bad_args/1, + bad_env/1, + bad_packet/1, + bad_port_messages/1, + basic_ping/1, + cd/1, + cd_relative/1, + close_deaf_port/1, + count_fds/1, + dropped_commands/1, + dying_port/1, + env/1, + eof/1, + exit_status/1, + exit_status_multi_scheduling_block/1, + huge_env/1, + pipe_limit_env/1, + input_only/1, + iter_max_ports/1, + line/1, + mix_up_ports/1, + mon_port_invalid_type/1, + mon_port_bad_named/1, + mon_port_bad_remote_on_local/1, + mon_port_local/1, + mon_port_name_demonitor/1, + mon_port_named/1, + mon_port_origin_dies/1, + mon_port_owner_dies/1, + mon_port_pid_demonitor/1, + mon_port_remote_on_remote/1, + mon_port_driver_die/1, + mon_port_driver_die_demonitor/1, + mul_basic/1, + mul_slow_writes/1, + name1/1, + open_input_file_port/1, + open_output_file_port/1, + otp_3906/1, + otp_4389/1, + otp_5112/1, + otp_5119/1, + otp_6224/1, + output_only/1, + parallelism_option/1, + parallell/1, + port_program_with_path/1, + port_setget_data/1, + ports/1, + slow_writes/1, + spawn_driver/1, + spawn_executable/1, + stderr_to_stdout/1, + stream_big/1, + stream_small/1, + t_binary/1, + t_exit/1, + tps_16_bytes/1, + tps_1K/1, + unregister_name/1, + win_massive/1, + win_massive_client/1 +]). + +-export([do_iter_max_ports/2, relative_cd/0]). %% Internal exports. -export([tps/3]). -export([otp_3906_forker/5, otp_3906_start_forker_starter/4]). -export([env_slave_main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). +-include_lib("eunit/include/eunit.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. -all() -> +all() -> [otp_6224, {group, stream}, basic_ping, slow_writes, bad_packet, bad_port_messages, {group, options}, - {group, multiple_packets}, parallell, dying_port, + {group, multiple_packets}, parallell, dying_port, dropped_commands, port_program_with_path, open_input_file_port, - open_output_file_port, name1, env, bad_env, cd, - exit_status, iter_max_ports, t_exit, {group, tps}, line, + open_output_file_port, name1, env, huge_env, bad_env, cd, + cd_relative, pipe_limit_env, bad_args, + exit_status, iter_max_ports, count_fds, t_exit, {group, tps}, line, stderr_to_stdout, otp_3906, otp_4389, win_massive, mix_up_ports, otp_5112, otp_5119, exit_status_multi_scheduling_block, ports, spawn_driver, spawn_executable, close_deaf_port, unregister_name, - parallelism_option]. - -groups() -> + port_setget_data, + parallelism_option, + mon_port_invalid_type, + mon_port_local, + mon_port_remote_on_remote, + mon_port_bad_remote_on_local, + mon_port_origin_dies, + mon_port_owner_dies, + mon_port_named, + mon_port_bad_named, + mon_port_pid_demonitor, + mon_port_name_demonitor, + mon_port_driver_die, + mon_port_driver_die_demonitor + ]. + +groups() -> [{stream, [], [stream_small, stream_big]}, {options, [], [t_binary, eof, input_only, output_only]}, {multiple_packets, [], [mul_basic, mul_slow_writes]}, {tps, [], [tps_16_bytes, tps_1K]}]. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - --define(DEFAULT_TIMEOUT, ?t:minutes(5)). - +init_per_testcase(Case, Config) when Case =:= mon_port_driver_die; + Case =:= mon_port_driver_die_demonitor -> + case erlang:system_info(schedulers_online) of + 1 -> {skip, "Need 2 schedulers to run testcase"}; + _ -> Config + end; init_per_testcase(Case, Config) -> [{testcase, Case} |Config]. @@ -151,69 +215,63 @@ end_per_suite(Config) when is_list(Config) -> %% on a Windows machine given the correct environment. win_massive(Config) when is_list(Config) -> case os:type() of - {win32,_} -> - do_win_massive(); - _ -> - {skip,"Only on Windows."} + {win32,_} -> + do_win_massive(); + _ -> + {skip,"Only on Windows."} end. do_win_massive() -> - Dog = test_server:timetrap(test_server:seconds(360)), + ct:timetrap({minutes, 6}), SuiteDir = filename:dirname(code:which(?MODULE)), Ports = " +Q 8192", - {ok, Node} = - test_server:start_node(win_massive, - slave, - [{args, " -pa " ++ SuiteDir ++ Ports}]), + {ok, Node} = + test_server:start_node(win_massive, + slave, + [{args, " -pa " ++ SuiteDir ++ Ports}]), ok = rpc:call(Node,?MODULE,win_massive_client,[3000]), test_server:stop_node(Node), - test_server:timetrap_cancel(Dog), ok. - + win_massive_client(N) -> - {ok,P}=gen_tcp:listen(?WIN_MASSIVE_PORT,[{reuseaddr,true}]), + {ok,P}=gen_tcp:listen(?WIN_MASSIVE_PORT,[{reuseaddr,true}]), L = win_massive_loop(P,N), Len = length(L), lists:foreach(fun(E) -> - gen_tcp:close(E) - end, - L), + gen_tcp:close(E) + end, + L), case Len div 2 of - N -> - ok; - _Else -> - {too_few, Len} + N -> + ok; + _Else -> + {too_few, Len} end. win_massive_loop(_,0) -> []; win_massive_loop(P,N) -> case (catch gen_tcp:connect("localhost",?WIN_MASSIVE_PORT,[])) of - {ok,A} -> - case (catch gen_tcp:accept(P)) of - {ok,B} -> - %erlang:display(N), - [A,B|win_massive_loop(P,N-1)]; - _Else -> - [A] - end; - _Else0 -> - [] + {ok,A} -> + case (catch gen_tcp:accept(P)) of + {ok,B} -> + %erlang:display(N), + [A,B|win_massive_loop(P,N-1)]; + _Else -> + [A] + end; + _Else0 -> + [] end. - - - %% Test that we can send a stream of bytes and get it back. %% We will send only a small amount of data, to avoid deadlock. stream_small(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), stream_ping(Config, 512, "", []), stream_ping(Config, 1777, "", []), stream_ping(Config, 1777, "-s512", []), - test_server:timetrap_cancel(Dog), ok. %% Send big amounts of data (much bigger than the buffer size in port test). @@ -221,22 +279,20 @@ stream_small(Config) when is_list(Config) -> %% non-blocking reads and writes. stream_big(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(180)), + ct:timetrap({seconds, 180}), stream_ping(Config, 43755, "", []), stream_ping(Config, 100000, "", []), stream_ping(Config, 77777, " -s40000", []), - test_server:timetrap_cancel(Dog), ok. %% Sends packet with header size of 1, 2, and 4, with packets of various %% sizes. basic_ping(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(120)), + ct:timetrap({minutes, 2}), ping(Config, sizes(1), 1, "", []), ping(Config, sizes(2), 2, "", []), ping(Config, sizes(4), 4, "", []), - test_server:timetrap_cancel(Dog), ok. %% Let the port program insert delays between characters sent back to @@ -244,17 +300,13 @@ basic_ping(Config) when is_list(Config) -> %% small chunks rather than all at once. slow_writes(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(20)), ping(Config, [8], 4, "-s1", []), ping(Config, [10], 2, "-s2", []), - test_server:timetrap_cancel(Dog), ok. -bad_packet(doc) -> - ["Test that we get {'EXIT', Port, einval} if we try to send a bigger " - "packet than the packet header allows."]; +%% Test that we get {'EXIT', Port, einval} if we try to send a bigger +%% packet than the packet header allows. bad_packet(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), PortTest = port_test(Config), process_flag(trap_exit, true), @@ -262,16 +314,14 @@ bad_packet(Config) when is_list(Config) -> bad_packet(PortTest, 1, 257), bad_packet(PortTest, 2, 65536), bad_packet(PortTest, 2, 65537), - - test_server:timetrap_cancel(Dog), ok. bad_packet(PortTest, HeaderSize, PacketSize) -> P = open_port({spawn, PortTest}, [{packet, HeaderSize}]), P ! {self(), {command, make_zero_packet(PacketSize)}}, receive - {'EXIT', P, einval} -> ok; - Other -> test_server:fail({unexpected_message, Other}) + {'EXIT', P, einval} -> ok; + Other -> ct:fail({unexpected_message, Other}) end. make_zero_packet(0) -> []; @@ -284,7 +334,6 @@ make_zero_packet(N) -> %% Test sending bad messages to a port. bad_port_messages(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), PortTest = port_test(Config), process_flag(trap_exit, true), @@ -292,16 +341,14 @@ bad_port_messages(Config) when is_list(Config) -> bad_message(PortTest, {a}), bad_message(PortTest, {self(),{command,bad_command}}), bad_message(PortTest, {self(),{connect,no_pid}}), - - test_server:timetrap_cancel(Dog), ok. -bad_message(PortTest, Message) -> +bad_message(PortTest, Message) -> P = open_port({spawn,PortTest}, []), P ! Message, receive - {'EXIT',P,badsig} -> ok; - Other -> test_server:fail({unexpected_message, Other}) + {'EXIT',P,badsig} -> ok; + Other -> ct:fail({unexpected_message, Other}) end. %% Tests various options (stream and {packet, Number} are implicitly @@ -311,7 +358,7 @@ bad_message(PortTest, Message) -> %% Tests the 'binary' option for a port. t_binary(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(300)), + ct:timetrap({seconds, 300}), %% Packet mode. ping(Config, sizes(1), 1, "", [binary]), @@ -322,12 +369,10 @@ t_binary(Config) when is_list(Config) -> stream_ping(Config, 435, "", [binary]), stream_ping(Config, 43755, "", [binary]), stream_ping(Config, 100000, "", [binary]), - - test_server:timetrap_cancel(Dog), ok. name1(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), + ct:timetrap({seconds, 100}), PortTest = port_test(Config), Command = lists:concat([PortTest, " "]), P = open_port({spawn, Command}, []), @@ -344,13 +389,12 @@ name1(Config) when is_list(Config) -> {P, closed} -> ok end, undefined = whereis(myport), - test_server:timetrap_cancel(Dog), ok. %% Test that the 'eof' option works. eof(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), + ct:timetrap({seconds, 100}), PortTest = port_test(Config), Command = lists:concat([PortTest, " -h0 -q"]), P = open_port({spawn, Command}, [eof]), @@ -362,47 +406,49 @@ eof(Config) when is_list(Config) -> receive {P, closed} -> ok end, - test_server:timetrap_cancel(Dog), ok. %% Tests that the 'in' option for a port works. input_only(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(300)), + ct:timetrap({seconds, 300}), expect_input(Config, [0, 1, 10, 13, 127, 128, 255], 1, "", [in]), expect_input(Config, [0, 1, 255, 2048], 2, "", [in]), expect_input(Config, [0, 1, 255, 2048], 4, "", [in]), expect_input(Config, [0, 1, 10, 13, 127, 128, 255], 1, "", [in, binary]), - test_server:timetrap_cancel(Dog), ok. %% Tests that the 'out' option for a port works. output_only(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), - Dir = ?config(priv_dir, Config), + ct:timetrap({seconds, 100}), + Dir = proplists:get_value(priv_dir, Config), + + %% First we test that the port program gets the data Filename = filename:join(Dir, "output_only_stream"), - output_and_verify(Config, Filename, "-h0", - random_packet(35777, "echo")), - test_server:timetrap_cancel(Dog), + Data = random_packet(35777, "echo"), + output_and_verify(Config, ["-h0 -o", Filename], Data), + Wait_time = 500, + test_server:sleep(Wait_time), + {ok, Written} = file:read_file(Filename), + Data = binary_to_list(Written), + + %% Then we test that any writes to stdout from + %% the port program is not sent to erlang + output_and_verify(Config, ["-h0"], Data), ok. -output_and_verify(Config, Filename, Options, Data) -> +output_and_verify(Config, Options, Data) -> PortTest = port_test(Config), - Command = lists:concat([PortTest, " ", - Options, " -o", Filename]), + Command = lists:concat([PortTest, " " | Options]), Port = open_port({spawn, Command}, [out]), Port ! {self(), {command, Data}}, Port ! {self(), close}, receive - {Port, closed} -> ok - end, - Wait_time = 500, - test_server:sleep(Wait_time), - {ok, Written} = file:read_file(Filename), - Data = binary_to_list(Written), - ok. + {Port, closed} -> ok; + Msg -> ct:fail({received_unexpected_message, Msg}) + end. %% Test that receiving several packages written in the same %% write operation works. @@ -411,11 +457,10 @@ output_and_verify(Config, Filename, Options, Data) -> %% Basic test of receiving multiple packages, written in %% one operation by the other end. mul_basic(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(600)), + ct:timetrap({minutes, 10}), expect_input(Config, [0, 1, 255, 10, 13], 1, "", []), expect_input(Config, [0, 10, 13, 1600, 32767, 65535], 2, "", []), expect_input(Config, [10, 70000], 4, "", []), - test_server:timetrap_cancel(Dog), ok. %% Test reading a buffer consisting of several packets, some @@ -424,9 +469,8 @@ mul_basic(Config) when is_list(Config) -> %% delays in between.) mul_slow_writes(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(250)), + ct:timetrap({minutes, 4}), expect_input(Config, [0, 20, 255, 10, 1], 1, "-s64", []), - test_server:timetrap_cancel(Dog), ok. %% Runs several port tests in parallell. Each individual test @@ -434,27 +478,26 @@ mul_slow_writes(Config) when is_list(Config) -> %% should also finish in about 5 seconds. parallell(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(300)), + ct:timetrap({minutes, 5}), Testers = [ - fun() -> stream_ping(Config, 1007, "-s100", []) end, - fun() -> stream_ping(Config, 10007, "-s1000", []) end, - fun() -> stream_ping(Config, 10007, "-s1000", []) end, + fun() -> stream_ping(Config, 1007, "-s100", []) end, + fun() -> stream_ping(Config, 10007, "-s1000", []) end, + fun() -> stream_ping(Config, 10007, "-s1000", []) end, - fun() -> expect_input(Config, [21, 22, 23, 24, 25], 1, - "-s10", [in]) end, + fun() -> expect_input(Config, [21, 22, 23, 24, 25], 1, + "-s10", [in]) end, - fun() -> ping(Config, [10], 1, "-d", []) end, - fun() -> ping(Config, [20000], 2, "-d", []) end, - fun() -> ping(Config, [101], 1, "-s10", []) end, - fun() -> ping(Config, [1001], 2, "-s100", []) end, - fun() -> ping(Config, [10001], 4, "-s1000", []) end, + fun() -> ping(Config, [10], 1, "-d", []) end, + fun() -> ping(Config, [20000], 2, "-d", []) end, + fun() -> ping(Config, [101], 1, "-s10", []) end, + fun() -> ping(Config, [1001], 2, "-s100", []) end, + fun() -> ping(Config, [10001], 4, "-s1000", []) end, - fun() -> ping(Config, [501, 501], 2, "-s100", []) end, - fun() -> ping(Config, [11, 12, 13, 14, 11], 1, "-s5", []) end], + fun() -> ping(Config, [501, 501], 2, "-s100", []) end, + fun() -> ping(Config, [11, 12, 13, 14, 11], 1, "-s5", []) end], process_flag(trap_exit, true), Pids = lists:map(fun fun_spawn/1, Testers), wait_for(Pids), - test_server:timetrap_cancel(Dog), ok. wait_for([]) -> @@ -462,18 +505,17 @@ wait_for([]) -> wait_for(Pids) -> io:format("Waiting for ~p", [Pids]), receive - {'EXIT', Pid, normal} -> - wait_for(lists:delete(Pid, Pids)); - Other -> - test_server:fail({bad_exit, Other}) + {'EXIT', Pid, normal} -> + wait_for(lists:delete(Pid, Pids)); + Other -> + ct:fail({bad_exit, Other}) end. %% Tests starting port programs that terminate by themselves. %% This used to cause problems on Windows. -dying_port(suite) -> []; dying_port(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(150)), + ct:timetrap({minutes, 2}), process_flag(trap_exit, true), P1 = make_dying_port(Config), @@ -494,14 +536,12 @@ dying_port(Config) when is_list(Config) -> wait_for_port_exit(P3), wait_for_port_exit(P4), wait_for_port_exit(P5), - - test_server:timetrap_cancel(Dog), ok. wait_for_port_exit(Port) -> receive - {'EXIT', Port, _} -> - ok + {'EXIT', Port, _} -> + ok end. make_dying_port(Config) when is_list(Config) -> @@ -509,6 +549,47 @@ make_dying_port(Config) when is_list(Config) -> Command = lists:concat([PortTest, " -h0 -d -q"]), open_port({spawn, Command}, [stream]). +%% Test that dropped port_commands work correctly. +%% This used to cause a segfault. +%% +%% This testcase creates a port and then lets many processes +%% do parallel commands to it. After a while it closes the +%% port and we are trying to catch the race when doing a +%% command while the port is closing. +dropped_commands(Config) -> + %% Test with output callback + dropped_commands(Config, false, {self(), {command, "1"}}), + %% Test with outputv callback + dropped_commands(Config, true, {self(), {command, "1"}}). + +dropped_commands(Config, Outputv, Cmd) -> + Path = proplists:get_value(data_dir, Config), + os:putenv("ECHO_DRV_USE_OUTPUTV", atom_to_list(Outputv)), + ok = load_driver(Path, "echo_drv"), + [dropped_commands_test(Cmd) || _ <- lists:seq(1, 100)], + timer:sleep(100), + erl_ddll:unload_driver("echo_drv"), + os:unsetenv("ECHO_DRV_USE_OUTPUTV"), + ok. + +dropped_commands_test(Cmd) -> + spawn_monitor( + fun() -> + Port = erlang:open_port({spawn_driver, "echo_drv"}, + [{parallelism, true}]), + [spawn_link(fun() -> spin(Port, Cmd) end) || _ <- lists:seq(1,8)], + timer:sleep(5), + port_close(Port), + timer:sleep(5), + exit(nok) + end), + receive _M -> timer:sleep(5) end. + +spin(P, Cmd) -> + P ! Cmd, + spin(P, Cmd). + + %% Tests that port program with complete path (but without any %% .exe extension) can be started, even if there is a file with %% the same name but without the extension in the same directory. @@ -520,22 +601,21 @@ make_dying_port(Config) when is_list(Config) -> %% %% This testcase works on Unix, but is not very useful. -port_program_with_path(suite) -> []; port_program_with_path(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), - + ct:timetrap({minutes, 2}), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + %% Create a copy of the port test program in a directory not %% included in PATH (i.e. in priv_dir), with the name 'my_port_test.exe'. %% Also, place a file named 'my_port_test' in the same directory. %% This used to confuse the CreateProcess() call in spawn driver. %% (On Unix, there will be a single file created, which will be %% a copy of the port program.) - + PortTest = os:find_executable("port_test", DataDir), io:format("os:find_executable(~p, ~p) returned ~p", - ["port_test", DataDir, PortTest]), + ["port_test", DataDir, PortTest]), {ok, PortTestPgm} = file:read_file(PortTest), NewName = filename:join(PrivDir, filename:basename(PortTest)), RedHerring = filename:rootname(NewName), @@ -543,12 +623,12 @@ port_program_with_path(Config) when is_list(Config) -> ok = file:write_file(NewName, PortTestPgm), ok = file:write_file_info(NewName, #file_info{mode=8#111}), PgmWithPathAndNoExt = filename:rootname(NewName), - + %% Open the port using the path to the copied port test program, %% but without the .exe extension, and verified that it was started. %% %% If the bug is present the open_port call will fail with badarg. - + Command = lists:concat([PgmWithPathAndNoExt, " -h2"]), P = open_port({spawn, Command}, [{packet, 2}]), Message = "echo back to me", @@ -557,17 +637,14 @@ port_program_with_path(Config) when is_list(Config) -> {P, {data, Message}} -> ok end, - test_server:timetrap_cancel(Dog), ok. %% Tests that files can be read using open_port(Filename, [in]). %% This used to fail on Windows. -open_input_file_port(suite) -> []; open_input_file_port(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - PrivDir = ?config(priv_dir, Config), - + PrivDir = proplists:get_value(priv_dir, Config), + %% Create a file with the file driver and read it back using %% open_port/2. @@ -575,20 +652,18 @@ open_input_file_port(Config) when is_list(Config) -> FileData1 = "An input file", ok = file:write_file(MyFile1, FileData1), case open_port(MyFile1, [in]) of - InputPort when is_port(InputPort) -> - receive - {InputPort, {data, FileData1}} -> - ok - end + InputPort when is_port(InputPort) -> + receive + {InputPort, {data, FileData1}} -> + ok + end end, - test_server:timetrap_cancel(Dog), ok. %% Tests that files can be written using open_port(Filename, [out]). -open_output_file_port(suite) -> []; open_output_file_port(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), - PrivDir = ?config(priv_dir, Config), + ct:timetrap({minutes, 2}), + PrivDir = proplists:get_value(priv_dir, Config), %% Create a file with open_port/2 and read it back with %% the file driver. @@ -603,16 +678,44 @@ open_output_file_port(Config) when is_list(Config) -> OutputPort ! {self(), close}, {ok, Bin} = file:read_file(MyFile2), FileData2 = binary_to_list(Bin), - - test_server:timetrap_cancel(Dog), ok. +%% Tests that all appropriate fd's have been closed in the port program +count_fds(Config) when is_list(Config) -> + case os:type() of + {unix, _} -> + PrivDir = proplists:get_value(priv_dir, Config), + Filename = filename:join(PrivDir, "my_fd_counter"), + + RunTest = fun(PortOpts) -> + PortTest = port_test(Config), + Command = lists:concat([PortTest, " -n -f -o", Filename]), + Port = open_port({spawn, Command}, PortOpts), + Port ! {self(), close}, + receive + {Port, closed} -> ok + end, + test_server:sleep(500), + {ok, Written} = file:read_file(Filename), + Written + end, + <<4:32/native>> = RunTest([out, nouse_stdio]), + <<4:32/native>> = RunTest([in, nouse_stdio]), + <<5:32/native>> = RunTest([in, out, nouse_stdio]), + <<3:32/native>> = RunTest([out, use_stdio]), + <<3:32/native>> = RunTest([in, use_stdio]), + <<3:32/native>> = RunTest([in, out, use_stdio]), + <<3:32/native>> = RunTest([in, out, use_stdio, stderr_to_stdout]), + <<3:32/native>> = RunTest([out, use_stdio, stderr_to_stdout]); + _ -> + {skip, "Skipped on windows"} + end. + %% %% Open as many ports as possible. Do this several times and check %% that we get the same number of ports every time. %% -iter_max_ports(suite) -> []; iter_max_ports(Config) when is_list(Config) -> %% The child_setup program might dump core if we get out of memory. %% This is hard to do anything about and is harmless. We run this test @@ -621,31 +724,30 @@ iter_max_ports(Config) when is_list(Config) -> %% Config2 = ignore_cores:setup(?MODULE, iter_max_ports, Config, true), try - iter_max_ports_test(Config2) + iter_max_ports_test(Config2) after - ignore_cores:restore(Config2) + ignore_cores:restore(Config2) end. - - + + iter_max_ports_test(Config) -> - Dog = test_server:timetrap(test_server:minutes(30)), + ct:timetrap({minutes, 30}), PortTest = port_test(Config), Command = lists:concat([PortTest, " -h0 -q"]), Iters = case os:type() of - {win32,_} -> 4; - _ -> 10 - end, + {win32,_} -> 4; + _ -> 10 + end, %% Run on a different node in order to limit the effect if this test fails. Dir = filename:dirname(code:which(?MODULE)), {ok,Node} = test_server:start_node(test_iter_max_socks,slave, - [{args,"+Q 2048 -pa " ++ Dir}]), + [{args,"+Q 2048 -pa " ++ Dir}]), L = rpc:call(Node,?MODULE,do_iter_max_ports,[Iters, Command]), test_server:stop_node(Node), io:format("Result: ~p",[L]), all_equal(L), all_equal(L), - test_server:timetrap_cancel(Dog), {comment, "Max ports: " ++ integer_to_list(hd(L))}. do_iter_max_ports(N, Command) when N > 0 -> @@ -669,46 +771,54 @@ max_ports(Command) -> close_ports([P|Ps]) -> P ! {self(), close}, receive - {P,closed} -> - ok + {P,closed} -> + ok end, close_ports(Ps); close_ports([]) -> ok. open_ports(Name, Settings) -> - test_server:sleep(5), + case os:type() of + {unix, freebsd} -> + %% FreeBsd has issues with sendmsg/recvmsg in fork + %% implementation and we therefor have to spawn + %% slower to make sure that we always hit the same + %% make roof. + test_server:sleep(10); + _ -> + test_server:sleep(5) + end, case catch open_port(Name, Settings) of - P when is_port(P) -> - [P| open_ports(Name, Settings)]; - {'EXIT', {Code, _}} -> - case Code of - enfile -> - []; - emfile -> - []; - system_limit -> - []; - enomem -> - []; - Other -> - test_server:fail({open_ports, Other}) - end; - Other -> - test_server:fail({open_ports, Other}) + P when is_port(P) -> + [P| open_ports(Name, Settings)]; + {'EXIT', {Code, _}} -> + case Code of + enfile -> + []; + emfile -> + []; + system_limit -> + []; + enomem -> + []; + Other -> + ct:fail({open_ports, Other}) + end; + Other -> + ct:fail({open_ports, Other}) end. %% Tests that exit(Port, Term) works (has been known to crash the emulator). -t_exit(suite) -> []; t_exit(Config) when is_list(Config) -> process_flag(trap_exit, true), Pid = fun_spawn(fun suicide_port/1, [Config]), receive - {'EXIT', Pid, die} -> - ok; - Other -> - test_server:fail({bad_message, Other}) + {'EXIT', Pid, die} -> + ok; + Other -> + ct:fail({bad_message, Other}) end. suicide_port(Config) when is_list(Config) -> @@ -717,118 +827,105 @@ suicide_port(Config) when is_list(Config) -> receive after infinity -> ok end. -tps_16_bytes(doc) -> ""; -tps_16_bytes(suite) -> []; tps_16_bytes(Config) when is_list(Config) -> tps(16, Config). -tps_1K(doc) -> ""; -tps_1K(suite) -> []; tps_1K(Config) when is_list(Config) -> tps(1024, Config). tps(Size, Config) -> - Dog = test_server:timetrap(test_server:seconds(300)), + ct:timetrap({minutes, 5}), PortTest = port_test(Config), Packet = list_to_binary(random_packet(Size, "e")), Port = open_port({spawn, PortTest}, [binary, {packet, 2}]), Transactions = 10000, {Elapsed, ok} = test_server:timecall(?MODULE, tps, - [Port, Packet, Transactions]), - test_server:timetrap_cancel(Dog), + [Port, Packet, Transactions]), {comment, integer_to_list(trunc(Transactions/Elapsed+0.5)) ++ " transactions/s"}. tps(_Port, _Packet, 0) -> ok; tps(Port, Packet, N) -> port_command(Port, Packet), receive - {Port, {data, Packet}} -> - tps(Port, Packet, N-1); - Other -> - test_server:fail({bad_message, Other}) + {Port, {data, Packet}} -> + tps(Port, Packet, N-1); + Other -> + ct:fail({bad_message, Other}) end. %% Line I/O test line(Config) when is_list(Config) -> + ct:timetrap({minutes, 5}), Siz = 110, - Dog = test_server:timetrap(test_server:seconds(300)), Packet1 = random_packet(Siz), Packet2 = random_packet(Siz div 2), %% Test that packets are split into lines port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet2, - io_lib:nl()]), - [{eol, Packet1}, {eol, Packet2}]}], - 0, "", [{line,Siz}]), + io_lib:nl()]), + [{eol, Packet1}, {eol, Packet2}]}], + 0, "", [{line,Siz}]), %% Test the same for binaries port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet2, - io_lib:nl()]), - [{eol, Packet1}, {eol, Packet2}]}], - 0, "", [{line,Siz},binary]), + io_lib:nl()]), + [{eol, Packet1}, {eol, Packet2}]}], + 0, "", [{line,Siz},binary]), %% Test that too long lines get split port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet1, - Packet2, io_lib:nl()]), - [{eol, Packet1}, {noeol, Packet1}, - {eol, Packet2}]}], 0, "", [{line,Siz}]), + Packet2, io_lib:nl()]), + [{eol, Packet1}, {noeol, Packet1}, + {eol, Packet2}]}], 0, "", [{line,Siz}]), %% Test that last output from closing port program gets received. L1 = lists:append([Packet1, io_lib:nl(), Packet2]), S1 = lists:flatten(io_lib:format("-l~w", [length(L1)])), io:format("S1 = ~w, L1 = ~w~n", [S1,L1]), port_expect(Config,[{L1, - [{eol, Packet1}, {noeol, Packet2}, eof]}], 0, - S1, [{line,Siz},eof]), + [{eol, Packet1}, {noeol, Packet2}, eof]}], 0, + S1, [{line,Siz},eof]), %% Test that lonely <CR> Don't get treated as newlines port_expect(Config,[{lists:append([Packet1, [13], Packet2, - io_lib:nl()]), - [{noeol, Packet1}, {eol, [13 |Packet2]}]}], - 0, "", [{line,Siz}]), + io_lib:nl()]), + [{noeol, Packet1}, {eol, [13 |Packet2]}]}], + 0, "", [{line,Siz}]), %% Test that packets get built up to lines (delayed output from %% port program) port_expect(Config,[{Packet2,[]}, - {lists:append([Packet2, io_lib:nl(), - Packet1, io_lib:nl()]), - [{eol, lists:append(Packet2, Packet2)}, - {eol, Packet1}]}], 0, "-d", [{line,Siz}]), + {lists:append([Packet2, io_lib:nl(), + Packet1, io_lib:nl()]), + [{eol, lists:append(Packet2, Packet2)}, + {eol, Packet1}]}], 0, "-d", [{line,Siz}]), %% Test that we get badarg if trying both packet and line bad_argument(Config, [{packet, 5}, {line, 5}]), - test_server:timetrap_cancel(Dog), ok. -%%% Redirection of stderr test -stderr_to_stdout(suite) -> - []; -stderr_to_stdout(doc) -> - "Test that redirection of standard error to standard output works."; +%% Test that redirection of standard error to standard output works. stderr_to_stdout(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(60)), + ct:timetrap({minutes, 1}), %% See that it works Packet = random_packet(10), port_expect(Config,[{Packet,[Packet]}], 0, "-e -l10", - [stderr_to_stdout]), + [stderr_to_stdout]), %% stream_ping(Config, 10, "-e", [stderr_to_stdout]), %% See that it doesn't always happen (will generate garbage on stderr) port_expect(Config,[{Packet,[eof]}], 0, "-e -l10", [line,eof]), - test_server:timetrap_cancel(Dog), ok. bad_argument(Config, ArgList) -> PortTest = port_test(Config), case catch open_port({spawn, PortTest}, ArgList) of - {'EXIT', {badarg, _}} -> - ok + {'EXIT', {badarg, _}} -> + ok end. - + %% 'env' option %% (Can perhaps be made smaller by calling the other utility functions %% in this module.) -env(suite) -> - []; -env(doc) -> - ["Test that the 'env' option works"]; +%% +%% Test that the 'env' option works env(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(60)), - Priv = ?config(priv_dir, Config), + ct:timetrap({minutes, 1}), + Priv = proplists:get_value(priv_dir, Config), Temp = filename:join(Priv, "env_fun.bin"), PluppVal = "dirty monkey", @@ -838,36 +935,34 @@ env(Config) when is_list(Config) -> os:putenv(Long, "nisse"), env_slave(Temp, [{"plupp",PluppVal}, - {"DIR_PLUPP","###glurfrik"}], - fun() -> - PluppVal = os:getenv("plupp"), - "###glurfrik" = os:getenv("DIR_PLUPP"), - "nisse" = os:getenv(Long) - end), + {"DIR_PLUPP","###glurfrik"}], + fun() -> + PluppVal = os:getenv("plupp"), + "###glurfrik" = os:getenv("DIR_PLUPP"), + "nisse" = os:getenv(Long) + end), env_slave(Temp, [{"must_define_something","some_value"}, - {"certainly_not_existing",false}, - {"ends_with_equal", "value="}, - {Long,false}, - {"glurf","a glorfy string"}]), + {"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)], + 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)], env_slave(Temp, lists:sort(ExistingList ++ NotExistingList)), - - test_server:timetrap_cancel(Dog), ok. env_slave(File, Env) -> F = fun() -> - lists:foreach(fun({Name,Val}) -> - Val = os:getenv(Name) - end, Env) - end, + lists:foreach(fun({Name,Val}) -> + Val = os:getenv(Name) + end, Env) + end, env_slave(File, Env, F). env_slave(File, Env, Body) -> @@ -875,27 +970,26 @@ env_slave(File, Env, Body) -> Program = atom_to_list(lib:progname()), Dir = filename:dirname(code:which(?MODULE)), Cmd = Program ++ " -pz " ++ Dir ++ - " -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++ - File ++ " -run erlang halt", + " -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++ + File ++ " -run erlang halt", Port = open_port({spawn, Cmd}, [{env,Env},{line,256}]), receive - {Port,{data,{eol,"ok"}}} -> - ok; - {Port,{data,{eol,Error}}} -> - io:format("~p\n", [Error]), - test_server:fail(); - Other -> - test_server:fail(Other) + {Port,{data,{eol,"ok"}}} -> + ok; + {Port,{data,{eol,Error}}} -> + ct:fail("eol error ~p\n", [Error]); + Other -> + ct:fail(Other) end. env_slave_main([File]) -> {ok,Body0} = file:read_file(File), Body = binary_to_term(Body0), case Body() of - {'EXIT',Reason} -> - io:format("Error: ~p\n", [Reason]); - _ -> - io:format("ok\n") + {'EXIT',Reason} -> + io:format("Error: ~p\n", [Reason]); + _ -> + io:format("ok\n") end, init:stop(). @@ -915,64 +1009,235 @@ bad_env(Config) when is_list(Config) -> ok. try_bad_env(Env) -> - try open_port({spawn,"ls"}, [{env,Env}]) - catch - error:badarg -> ok + badarg = try open_port({spawn,"ls"}, [{env,Env}]) + catch + error:badarg -> badarg + end. + + +%% Test that we can handle a very very large environment gracefully. +huge_env(Config) when is_list(Config) -> + ct:timetrap({minutes, 2}), + {Vars, Cmd} = case os:type() of + {win32,_} -> {500, "cmd /q /c ls"}; + _ -> + %% We create a huge environment, + %% 20000 variables is about 25MB + %% which seems to be the limit on Linux. + {20000, "ls"} + end, + Env = [{[$a + I div (25*25*25*25) rem 25, + $a + I div (25*25*25) rem 25, + $a + I div (25*25) rem 25, + $a+I div 25 rem 25, $a+I rem 25], + lists:duplicate(100,$a+I rem 25)} + || I <- lists:seq(1,Vars)], + try erlang:open_port({spawn,Cmd},[exit_status, {env, Env}]) of + P -> + receive + {P, {exit_status,N}} = M when N > 127-> + %% If exit status is > 127 something went very wrong + ct:fail("Open port failed got ~p",[M]); + {P, {exit_status,N}} = M -> + %% We test that the exit status is an integer, this means + %% that the child program has started. If we get an atom + %% something went wrong in the driver which is not ok. + ct:log("Got ~p",[M]), + true = is_integer(N) + end + catch E:R -> + %% Have to catch the error here, as printing the stackdump + %% in the ct log is way to heavy for some test machines. + ct:fail("Open port failed ~p:~p",[E,R]) end. +%% Test to spawn program with command payload buffer +%% just around pipe capacity (9f779819f6bda734c5953468f7798) +pipe_limit_env(Config) when is_list(Config) -> + Cmd = case os:type() of + {win32,_} -> "cmd /q /c true"; + _ -> "true" + end, + CmdSize = command_payload_size(Cmd), + Limits = [4096, 16384, 65536], % Try a couple of common pipe buffer sizes + + lists:foreach(fun(Lim) -> + lists:foreach(fun(L) -> pipe_limit_env_do(L, Cmd, CmdSize) + end, lists:seq(Lim-5, Lim+5)) + end, Limits), + ok. + +pipe_limit_env_do(Bytes, Cmd, CmdSize) -> + case env_of_bytes(Bytes-CmdSize) of + [] -> skip; + Env -> + try erlang:open_port({spawn,Cmd},[exit_status, {env, Env}]) of + P -> + receive + {P, {exit_status,N}} -> + %% Bug caused exit_status 150 (EINVAL+128) + 0 = N + end + catch E:R -> + %% Have to catch the error here, as printing the stackdump + %% in the ct log is way to heavy for some test machines. + ct:fail("Open port failed ~p:~p",[E,R]) + end + end. + +%% environ format: KEY=VALUE\0 +env_of_bytes(Bytes) when Bytes > 3 -> + [{"X",lists:duplicate(Bytes-3, $x)}]; +env_of_bytes(_) -> []. + +%% White box assumption about payload written to pipe +%% for Cmd and current environment (see spawn_start in sys_driver.c) +command_payload_size(Cmd) -> + EnvSize = lists:foldl(fun(E,Acc) -> length(E) + 1 + Acc end, + 0, os:getenv()), + {ok, PWD} = file:get_cwd(), + (4 % buffsz + + 4 % flags + + 5 + length(Cmd) + 1 % "exec $Cmd" + + length(PWD) + 1 % $PWD + + 1 % nullbuff + + 4 % env_len + + EnvSize). + +%% Test bad 'args' options. +bad_args(Config) when is_list(Config) -> + try_bad_args({args, [self()]}), + try_bad_args({args, ["head" | "tail"]}), + try_bad_args({args, ["head", "body" | "tail"]}), + try_bad_args({args, [<<"head">>, <<"body">> | <<"tail">>]}), + try_bad_args({args, not_a_list}), + try_bad_args({args, ["string",<<"binary">>, 1472, "string"]}), + try_bad_args({args, ["string",<<"binary">>], "element #3"}), + ok. + +try_bad_args(Args) -> + badarg = try open_port({spawn_executable,"ls"}, [Args]) + catch + error:badarg -> badarg + end. + + + %% 'cd' option %% (Can perhaps be made smaller by calling the other utility functions %% in this module.) -cd(suite) -> - []; -cd(doc) -> - ["Test that the 'cd' option works"]; +%% +%% Test that the 'cd' option works cd(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(60)), + ct:timetrap({minutes, 1}), Program = atom_to_list(lib:progname()), - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), TestDir = filename:join(DataDir, "dir"), Cmd = Program ++ " -pz " ++ DataDir ++ - " -noshell -s port_test pwd -s erlang halt", + " -noshell -s port_test pwd -s erlang halt", _ = open_port({spawn, Cmd}, - [{cd, TestDir}, - {line, 256}]), + [{cd, TestDir}, {line, 256}]), receive - {_, {data, {eol, String}}} -> - case filename_equal(String, TestDir) of - true -> - ok; - false -> - test_server:fail({cd, String}) - end; - Other2 -> - test_server:fail({env, Other2}) + {_, {data, {eol, String}}} -> + case filename_equal(String, TestDir) of + true -> + ok; + false -> + ct:fail({cd, String}) + end; + Other2 -> + ct:fail({env, Other2}) end, _ = open_port({spawn, Cmd}, - [{cd, unicode:characters_to_binary(TestDir)}, - {line, 256}]), + [{cd, unicode:characters_to_binary(TestDir)}, + {line, 256}]), receive - {_, {data, {eol, String2}}} -> - case filename_equal(String2, TestDir) of - true -> - ok; - false -> - test_server:fail({cd, String2}) - end; - Other3 -> - test_server:fail({env, Other3}) + {_, {data, {eol, String2}}} -> + case filename_equal(String2, TestDir) of + true -> + ok; + false -> + ct:fail({cd, String2}) + end; + Other3 -> + ct:fail({env, Other3}) end, - test_server:timetrap_cancel(Dog), - ok. + InvalidDir = filename:join(DataDir, "invaliddir"), + try open_port({spawn, Cmd}, + [{cd, InvalidDir}, exit_status, {line, 256}]) of + _ -> + receive + {_, {exit_status, _}} -> + ok; + Other4 -> + ct:fail({env, Other4}) + end + catch error:eacces -> + %% This happens on Windows + ok + end, + + %% Check that there are no lingering messages + receive + Other5 -> + ct:fail({env, Other5}) + after 10 -> + ok + end. + +%% Test that an emulator that has set it's cwd to +%% something other then when it started, can use +%% relative {cd,"./"} to open port and that cd will +%% be relative the new cwd and not the original +cd_relative(Config) -> + + Program = atom_to_list(lib:progname()), + DataDir = proplists:get_value(data_dir, Config), + TestDir = filename:join(DataDir, "dir"), + + Cmd = Program ++ " -pz " ++ filename:dirname(code:where_is_file("port_SUITE.beam")) ++ + " -noshell -s port_SUITE relative_cd -s erlang halt", + + _ = open_port({spawn, Cmd}, [{line, 256}, {cd, TestDir}]), + + receive + {_, {data, {eol, String}}} -> + case filename_equal(String, TestDir) of + true -> + ok; + false -> + ct:fail({cd_relative, String}) + end; + Other -> + ct:fail(Other) + end. + +relative_cd() -> + + Program = atom_to_list(lib:progname()), + ok = file:set_cwd(".."), + {ok, Cwd} = file:get_cwd(), + + Cmd = Program ++ " -pz " ++ Cwd ++ + " -noshell -s port_test pwd -s erlang halt", + + _ = open_port({spawn, Cmd}, [{line, 256}, {cd, "./dir"}, exit_status]), + + receive + {_, {data, {eol, String}}} -> + io:format("~s~n",[String]); + Other -> + io:format("ERROR: ~p~n",[Other]) + end. filename_equal(A, B) -> case os:type() of - {win32, _} -> - win_filename_equal(A, B); - _ -> - A == B + {win32, _} -> + win_filename_equal(A, B); + _ -> + A == B end. win_filename_equal([], []) -> @@ -983,10 +1248,10 @@ win_filename_equal(_, []) -> false; win_filename_equal([C1 | Rest1], [C2 | Rest2]) -> case tolower(C1) == tolower(C2) of - true -> - win_filename_equal(Rest1, Rest2); - false -> - false + true -> + win_filename_equal(Rest1, Rest2); + false -> + false end. tolower(C) when C >= $A, C =< $Z -> @@ -994,17 +1259,14 @@ tolower(C) when C >= $A, C =< $Z -> tolower(C) -> C. -otp_3906(suite) -> - []; -otp_3906(doc) -> - ["Tests that child process deaths are managed correctly when there are " - " a large amount of concurrently dying children. See ticket OTP-3906."]; +%% Tests that child process deaths are managed correctly when there are +%% a large amount of concurrently dying children. See ticket OTP-3906. otp_3906(Config) when is_list(Config) -> case os:type() of - {unix, OSName} -> - otp_3906(Config, OSName); - _ -> - {skipped, "Only run on Unix systems"} + {unix, OSName} -> + otp_3906(Config, OSName); + _ -> + {skipped, "Only run on Unix systems"} end. -define(OTP_3906_CHILDREN, 1000). @@ -1017,83 +1279,83 @@ otp_3906(Config) when is_list(Config) -> otp_3906(Config, OSName) -> DataDir = filename:dirname(proplists:get_value(data_dir,Config)), {ok, Variables} = file:consult( - filename:join([DataDir,"..","..", - "test_server","variables"])), + filename:join([DataDir,"..","..", + "test_server","variables"])), case lists:keysearch('CC', 1, Variables) of - {value,{'CC', CC}} -> - SuiteDir = filename:dirname(code:which(?MODULE)), - PrivDir = ?config(priv_dir, Config), - Prog = otp_3906_make_prog(CC, PrivDir), - {ok, Node} = test_server:start_node(otp_3906, - slave, - [{args, " -pa " ++ SuiteDir}, - {linked, false}]), - OP = process_flag(priority, max), - OTE = process_flag(trap_exit, true), - FS = spawn_link(Node, - ?MODULE, - otp_3906_start_forker_starter, - [?OTP_3906_CHILDREN, [], self(), Prog]), - Result = receive - {'EXIT', _ForkerStarter, Reason} -> - {failed, Reason}; - {emulator_pid, EmPid} -> - case otp_3906_wait_result(FS, 0, 0) of - {succeded, - ?OTP_3906_CHILDREN, - ?OTP_3906_CHILDREN} -> - succeded; - {succeded, Forked, Exited} -> - otp_3906_list_defunct(EmPid, OSName), - {failed, - {mismatch, - {forked, Forked}, - {exited, Exited}}}; - Res -> - otp_3906_list_defunct(EmPid, OSName), - Res - end - end, - process_flag(trap_exit, OTE), - process_flag(priority, OP), - test_server:stop_node(Node), - case Result of - succeded -> - ok; - _ -> - test_server:fail(Result) - end; - _ -> - {skipped, "No C compiler found"} + {value,{'CC', CC}} -> + SuiteDir = filename:dirname(code:which(?MODULE)), + PrivDir = proplists:get_value(priv_dir, Config), + Prog = otp_3906_make_prog(CC, PrivDir), + {ok, Node} = test_server:start_node(otp_3906, + slave, + [{args, " -pa " ++ SuiteDir}, + {linked, false}]), + OP = process_flag(priority, max), + OTE = process_flag(trap_exit, true), + FS = spawn_link(Node, + ?MODULE, + otp_3906_start_forker_starter, + [?OTP_3906_CHILDREN, [], self(), Prog]), + Result = receive + {'EXIT', _ForkerStarter, Reason} -> + {failed, Reason}; + {emulator_pid, EmPid} -> + case otp_3906_wait_result(FS, 0, 0) of + {succeded, + ?OTP_3906_CHILDREN, + ?OTP_3906_CHILDREN} -> + succeded; + {succeded, Forked, Exited} -> + otp_3906_list_defunct(EmPid, OSName), + {failed, + {mismatch, + {forked, Forked}, + {exited, Exited}}}; + Res -> + otp_3906_list_defunct(EmPid, OSName), + Res + end + end, + process_flag(trap_exit, OTE), + process_flag(priority, OP), + test_server:stop_node(Node), + case Result of + succeded -> + ok; + _ -> + ct:fail(Result) + end; + _ -> + {skipped, "No C compiler found"} end. otp_3906_list_defunct(EmPid, OSName) -> % Guess ps switches to use and what to grep for (could be improved) {Switches, Zombie} = case OSName of - BSD when BSD == darwin; - BSD == openbsd; - BSD == netbsd; - BSD == freebsd -> - {"-ajx", "Z"}; - _ -> - {"-ef", "[dD]efunct"} - end, - test_server:format("Emulator pid: ~s~n" - "Listing of zombie processes:~n" - "~s~n", - [EmPid, - otp_3906_htmlize(os:cmd("ps " - ++ Switches - ++ " | grep " - ++ Zombie))]). + BSD when BSD == darwin; + BSD == openbsd; + BSD == netbsd; + BSD == freebsd -> + {"-ajx", "Z"}; + _ -> + {"-ef", "[dD]efunct"} + end, + io:format("Emulator pid: ~s~n" + "Listing of zombie processes:~n" + "~s~n", + [EmPid, + otp_3906_htmlize(os:cmd("ps " + ++ Switches + ++ " | grep " + ++ Zombie))]). otp_3906_htmlize([]) -> []; otp_3906_htmlize([C | Cs]) -> case [C] of - "<" -> "<" ++ otp_3906_htmlize(Cs); - ">" -> ">" ++ otp_3906_htmlize(Cs); - _ -> [C | otp_3906_htmlize(Cs)] + "<" -> "<" ++ otp_3906_htmlize(Cs); + ">" -> ">" ++ otp_3906_htmlize(Cs); + _ -> [C | otp_3906_htmlize(Cs)] end. otp_3906_make_prog(CC, PrivDir) -> @@ -1101,12 +1363,12 @@ otp_3906_make_prog(CC, PrivDir) -> TrgtFileName = filename:join(PrivDir, ?OTP_3906_PROGNAME), {ok, SrcFile} = file:open(SrcFileName, write), io:format(SrcFile, - "int ~n" - "main(void) ~n" - "{ ~n" - " return ~p; ~n" - "} ~n", - [?OTP_3906_EXIT_STATUS]), + "int ~n" + "main(void) ~n" + "{ ~n" + " return ~p; ~n" + "} ~n", + [?OTP_3906_EXIT_STATUS]), file:close(SrcFile), os:cmd(CC ++ " " ++ SrcFileName ++ " -o " ++ TrgtFileName), TrgtFileName. @@ -1114,21 +1376,21 @@ otp_3906_make_prog(CC, PrivDir) -> otp_3906_wait_result(ForkerStarter, F, E) -> receive - {'EXIT', ForkerStarter, Reason} -> - {failed, {Reason, {forked, F}, {exited, E}}}; - forked -> - otp_3906_wait_result(ForkerStarter, F+1, E); - exited -> - otp_3906_wait_result(ForkerStarter, F, E+1); - tick -> - otp_3906_wait_result(ForkerStarter, F, E); - succeded -> - {succeded, F, E} + {'EXIT', ForkerStarter, Reason} -> + {failed, {Reason, {forked, F}, {exited, E}}}; + forked -> + otp_3906_wait_result(ForkerStarter, F+1, E); + exited -> + otp_3906_wait_result(ForkerStarter, F, E+1); + tick -> + otp_3906_wait_result(ForkerStarter, F, E); + succeded -> + {succeded, F, E} after - ?OTP_3906_TICK_TIMEOUT -> - unlink(ForkerStarter), - exit(ForkerStarter, timeout), - {failed, {timeout, {forked, F}, {exited, E}}} + ?OTP_3906_TICK_TIMEOUT -> + unlink(ForkerStarter), + exit(ForkerStarter, timeout), + {failed, {timeout, {forked, F}, {exited, E}}} end. otp_3906_collect([], _) -> @@ -1138,17 +1400,17 @@ otp_3906_collect(RefList, Sup) -> otp_3906_collect_one(RefList, Sup) -> receive - Ref when is_reference(Ref) -> - Sup ! tick, - lists:delete(Ref, RefList) + Ref when is_reference(Ref) -> + Sup ! tick, + lists:delete(Ref, RefList) end. - + otp_3906_start_forker(N, Sup, Prog) -> Ref = make_ref(), spawn_opt(?MODULE, - otp_3906_forker, - [N, self(), Ref, Sup, Prog], - [link, {priority, max}]), + otp_3906_forker, + [N, self(), Ref, Sup, Prog], + [link, {priority, max}]), Ref. otp_3906_start_forker_starter(N, RefList, Sup, Prog) -> @@ -1167,18 +1429,18 @@ otp_3906_forker_starter(N, RefList, Sup, Prog) otp_3906_forker_starter(N, RefList, Sup, Prog) when is_integer(N), N > ?OTP_3906_OSP_P_ERLP -> otp_3906_forker_starter(N-?OTP_3906_OSP_P_ERLP, - [otp_3906_start_forker(?OTP_3906_OSP_P_ERLP, - Sup, - Prog)|RefList], - Sup, - Prog); + [otp_3906_start_forker(?OTP_3906_OSP_P_ERLP, + Sup, + Prog)|RefList], + Sup, + Prog); otp_3906_forker_starter(N, RefList, Sup, Prog) when is_integer(N) -> otp_3906_forker_starter(0, - [otp_3906_start_forker(N, - Sup, - Prog)|RefList], - Sup, - Prog). + [otp_3906_start_forker(N, + Sup, + Prog)|RefList], + Sup, + Prog). otp_3906_forker(0, Parent, Ref, _, _) -> unlink(Parent), @@ -1187,183 +1449,165 @@ otp_3906_forker(N, Parent, Ref, Sup, Prog) -> Port = erlang:open_port({spawn, Prog}, [exit_status, in]), Sup ! forked, receive - {Port, {exit_status, ?OTP_3906_EXIT_STATUS}} -> - Sup ! exited, - otp_3906_forker(N-1, Parent, Ref, Sup, Prog); - {Port, Res} -> - exit(Res); - Other -> - exit(Other) + {Port, {exit_status, ?OTP_3906_EXIT_STATUS}} -> + Sup ! exited, + otp_3906_forker(N-1, Parent, Ref, Sup, Prog); + {Port, Res} -> + exit(Res); + Other -> + exit(Other) end. -otp_4389(suite) -> []; -otp_4389(doc) -> []; otp_4389(Config) when is_list(Config) -> case os:type() of - {unix, _} -> - Dog = test_server:timetrap(test_server:seconds(240)), - TCR = self(), - case get_true_cmd() of - True when is_list(True) -> - lists:foreach( - fun (P) -> - receive - {P, ok} -> ok; - {P, Err} -> ?t:fail(Err) - end - end, - lists:map( - fun(_) -> - spawn_link( - fun() -> - process_flag(trap_exit, true), - case catch open_port({spawn, True}, - [stream,exit_status]) of - P when is_port(P) -> - receive - {P,{exit_status,_}} -> - TCR ! {self(),ok}; - {'EXIT',_,{R2,_}} when R2 == emfile; - R2 == eagain -> - TCR ! {self(),ok}; - Err2 -> - TCR ! {self(),{msg,Err2}} - end; - {'EXIT',{R1,_}} when R1 == emfile; - R1 == eagain -> - TCR ! {self(),ok}; - Err1 -> - TCR ! {self(), {open_port,Err1}} - end - end) - end, - lists:duplicate(1000,[]))), - test_server:timetrap_cancel(Dog), - {comment, - "This test case doesn't always fail when the bug that " - "it tests for is present (it is most likely to fail on" - " a multi processor machine). If the test case fails it" - " will fail by deadlocking the emulator."}; - _ -> - {skipped, "\"true\" command not found"} - end; - _ -> - {skip,"Only run on Unix"} + {unix, _} -> + ct:timetrap({minutes, 4}), + TCR = self(), + case get_true_cmd() of + True when is_list(True) -> + lists:foreach( + fun (P) -> + receive + {P, ok} -> ok; + {P, Err} -> ct:fail(Err) + end + end, + lists:map( + fun(_) -> + spawn_link( + fun() -> + process_flag(trap_exit, true), + case catch open_port({spawn, True}, + [stream,exit_status]) of + P when is_port(P) -> + receive + {P,{exit_status,_}} -> + TCR ! {self(),ok}; + {'EXIT',_,{R2,_}} when R2 == emfile; + R2 == eagain; + R2 == enomem -> + TCR ! {self(),ok}; + Err2 -> + TCR ! {self(),{msg,Err2}} + end; + {'EXIT',{R1,_}} when R1 == emfile; + R1 == eagain; + R1 == enomem -> + TCR ! {self(),ok}; + Err1 -> + TCR ! {self(), {open_port,Err1}} + end + end) + end, + lists:duplicate(1000,[]))), + {comment, + "This test case doesn't always fail when the bug that " + "it tests for is present (it is most likely to fail on" + " a multi processor machine). If the test case fails it" + " will fail by deadlocking the emulator."}; + _ -> + {skipped, "\"true\" command not found"} + end; + _ -> + {skip,"Only run on Unix"} end. get_true_cmd() -> DoFileExist = fun (FileName) -> - case file:read_file_info(FileName) of - {ok, _} -> throw(FileName); - _ -> not_found - end - end, + case file:read_file_info(FileName) of + {ok, _} -> throw(FileName); + _ -> not_found + end + end, catch begin - %% First check in /usr/bin and /bin - DoFileExist("/usr/bin/true"), - DoFileExist("/bin/true"), - %% Try which - case filename:dirname(os:cmd("which true")) of - "." -> not_found; - TrueDir -> filename:join(TrueDir, "true") - end - end. + %% First check in /usr/bin and /bin + DoFileExist("/usr/bin/true"), + DoFileExist("/bin/true"), + %% Try which + case filename:dirname(os:cmd("which true")) of + "." -> not_found; + TrueDir -> filename:join(TrueDir, "true") + end + end. %% 'exit_status' option -exit_status(suite) -> - []; -exit_status(doc) -> - ["Test that the 'exit_status' option works"]; +%% +%% Test that the 'exit_status' option works exit_status(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(60)), - port_expect(Config,[{"x", - [{exit_status, 5}]}], - 1, "", [exit_status]), - test_server:timetrap_cancel(Dog), + ct:timetrap({minutes, 1}), + port_expect(Config, + [{"x", [{exit_status, 5}]}], + 1, "", [exit_status]), ok. -spawn_driver(suite) -> - []; -spawn_driver(doc) -> - ["Test spawning a driver specifically"]; +%% Test spawning a driver specifically spawn_driver(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "echo_drv"), Port = erlang:open_port({spawn_driver, "echo_drv"}, []), Port ! {self(), {command, "Hello port!"}}, - receive - {Port, {data, "Hello port!"}} = Msg1 -> - io:format("~p~n", [Msg1]), - ok; - Other -> - test_server:fail({unexpected, Other}) - end, + receive + {Port, {data, "Hello port!"}} = Msg1 -> + io:format("~p~n", [Msg1]), + ok; + Other -> + ct:fail({unexpected, Other}) + end, Port ! {self(), close}, receive {Port, closed} -> ok end, - Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"}, - []), - receive - {Port2, {data, "Hello port?"}} = Msg2 -> - io:format("~p~n", [Msg2]), - ok; - Other2 -> - test_server:fail({unexpected2, Other2}) - end, + Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"}, + []), + receive + {Port2, {data, "Hello port?"}} = Msg2 -> + io:format("~p~n", [Msg2]), + ok; + Other2 -> + ct:fail({unexpected2, Other2}) + end, Port2 ! {self(), close}, receive {Port2, closed} -> ok end, {'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, "ls"}, [])), {'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, "cmd"}, [])), {'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, os:find_executable("erl")}, [])), - test_server:timetrap_cancel(Dog), ok. -parallelism_option(suite) -> - []; -parallelism_option(doc) -> - ["Test parallelism option of open_port"]; +%% Test parallelism option of open_port parallelism_option(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line ok = load_driver(Path, "echo_drv"), - ?line Port = erlang:open_port({spawn_driver, "echo_drv"}, - [{parallelism, true}]), - ?line {parallelism, true} = erlang:port_info(Port, parallelism), - ?line Port ! {self(), {command, "Hello port!"}}, - ?line receive - {Port, {data, "Hello port!"}} = Msg1 -> - io:format("~p~n", [Msg1]), - ok; - Other -> - test_server:fail({unexpected, Other}) - end, - ?line Port ! {self(), close}, - ?line receive {Port, closed} -> ok end, - - ?line Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"}, - [{parallelism, false}]), - ?line {parallelism, false} = erlang:port_info(Port2, parallelism), - ?line receive - {Port2, {data, "Hello port?"}} = Msg2 -> - io:format("~p~n", [Msg2]), - ok; - Other2 -> - test_server:fail({unexpected2, Other2}) - end, - ?line Port2 ! {self(), close}, - ?line receive {Port2, closed} -> ok end, - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + ok = load_driver(Path, "echo_drv"), + Port = erlang:open_port({spawn_driver, "echo_drv"}, + [{parallelism, true}]), + {parallelism, true} = erlang:port_info(Port, parallelism), + Port ! {self(), {command, "Hello port!"}}, + receive + {Port, {data, "Hello port!"}} = Msg1 -> + io:format("~p~n", [Msg1]), + ok; + Other -> + ct:fail({unexpected, Other}) + end, + Port ! {self(), close}, + receive {Port, closed} -> ok end, + + Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"}, + [{parallelism, false}]), + {parallelism, false} = erlang:port_info(Port2, parallelism), + receive + {Port2, {data, "Hello port?"}} = Msg2 -> + io:format("~p~n", [Msg2]), + ok; + Other2 -> + ct:fail({unexpected2, Other2}) + end, + Port2 ! {self(), close}, + receive {Port2, closed} -> ok end, ok. -spawn_executable(suite) -> - []; -spawn_executable(doc) -> - ["Test spawning an executable specifically"]; +%% Test spawning an executable specifically spawn_executable(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), EchoArgs1 = filename:join([DataDir,"echo_args"]), ExactFile1 = filename:nativename(os:find_executable(EchoArgs1)), [ExactFile1] = run_echo_args(DataDir,[]), @@ -1372,26 +1616,26 @@ spawn_executable(Config) when is_list(Config) -> ["echo_args"] = run_echo_args(DataDir,[binary, "echo_args"]), ["echo_arguments"] = run_echo_args(DataDir,["echo_arguments"]), ["echo_arguments"] = run_echo_args(DataDir,[binary, "echo_arguments"]), - [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args(DataDir,[ExactFile1,"hello world","dlrow olleh"]), + [ExactFile1,"hello world","dlrow olleh"] = + run_echo_args(DataDir,[ExactFile1,"hello world","dlrow olleh"]), [ExactFile1] = run_echo_args(DataDir,[default]), [ExactFile1] = run_echo_args(DataDir,[binary, default]), - [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args(DataDir,[switch_order,ExactFile1,"hello world", - "dlrow olleh"]), - [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args(DataDir,[binary,switch_order,ExactFile1,"hello world", - "dlrow olleh"]), [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args(DataDir,[default,"hello world","dlrow olleh"]), + run_echo_args(DataDir,[switch_order,ExactFile1,"hello world", + "dlrow olleh"]), + [ExactFile1,"hello world","dlrow olleh"] = + run_echo_args(DataDir,[binary,switch_order,ExactFile1,"hello world", + "dlrow olleh"]), + [ExactFile1,"hello world","dlrow olleh"] = + run_echo_args(DataDir,[default,"hello world","dlrow olleh"]), - [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args_2("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\""), [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args_2(unicode:characters_to_binary("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\"")), + run_echo_args_2("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\""), + [ExactFile1,"hello world","dlrow olleh"] = + run_echo_args_2(unicode:characters_to_binary("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\"")), - PrivDir = ?config(priv_dir, Config), - SpaceDir =filename:join([PrivDir,"With Spaces"]), + PrivDir = proplists:get_value(priv_dir, Config), + SpaceDir = filename:join([PrivDir,"With Spaces"]), file:make_dir(SpaceDir), Executable = filename:basename(ExactFile1), file:copy(ExactFile1,filename:join([SpaceDir,Executable])), @@ -1401,28 +1645,27 @@ spawn_executable(Config) when is_list(Config) -> [ExactFile2] = run_echo_args(SpaceDir,[]), ["echo_args"] = run_echo_args(SpaceDir,["echo_args"]), ["echo_arguments"] = run_echo_args(SpaceDir,["echo_arguments"]), - [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]), [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,[binary, ExactFile2,"hello world","dlrow olleh"]), + run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]), + [ExactFile2,"hello world","dlrow olleh"] = + run_echo_args(SpaceDir,[binary, ExactFile2,"hello world","dlrow olleh"]), + + [ExactFile2,"hello \"world\"","\"dlrow\" olleh"] = + run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]), + [ExactFile2,"hello \"world\"","\"dlrow\" olleh"] = + run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]), + [ExactFile2] = run_echo_args(SpaceDir,[default]), - [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,[switch_order,ExactFile2,"hello world", - "dlrow olleh"]), - [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,[default,"hello world","dlrow olleh"]), - [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args_2("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\""), [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args_2(unicode:characters_to_binary("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\"")), - - ExeExt = - case string:to_lower(lists:last(string:tokens(ExactFile2,"."))) of - "exe" -> - ".exe"; - _ -> - "" - end, + run_echo_args(SpaceDir,[switch_order,ExactFile2,"hello world", "dlrow olleh"]), + [ExactFile2,"hello world","dlrow olleh"] = + run_echo_args(SpaceDir,[default,"hello world","dlrow olleh"]), + [ExactFile2,"hello world","dlrow olleh"] = + run_echo_args_2("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\""), + [ExactFile2,"hello world","dlrow olleh"] = + run_echo_args_2(unicode:characters_to_binary("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\"")), + + ExeExt = filename:extension(ExactFile2), Executable2 = "spoky name"++ExeExt, file:copy(ExactFile1,filename:join([SpaceDir,Executable2])), ExactFile3 = filename:nativename(filename:join([SpaceDir,Executable2])), @@ -1430,39 +1673,38 @@ spawn_executable(Config) when is_list(Config) -> [ExactFile3] = run_echo_args(SpaceDir,Executable2,[]), ["echo_args"] = run_echo_args(SpaceDir,Executable2,["echo_args"]), ["echo_arguments"] = run_echo_args(SpaceDir,Executable2,["echo_arguments"]), - [ExactFile3,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,Executable2,[ExactFile3,"hello world","dlrow olleh"]), + [ExactFile3,"hello world","dlrow olleh"] = + run_echo_args(SpaceDir,Executable2,[ExactFile3,"hello world","dlrow olleh"]), [ExactFile3] = run_echo_args(SpaceDir,Executable2,[default]), - [ExactFile3,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,Executable2, - [switch_order,ExactFile3,"hello world", - "dlrow olleh"]), - [ExactFile3,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,Executable2, - [default,"hello world","dlrow olleh"]), - [ExactFile3,"hello world","dlrow olleh"] = - run_echo_args_2("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\""), [ExactFile3,"hello world","dlrow olleh"] = - run_echo_args_2(unicode:characters_to_binary("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\"")), + run_echo_args(SpaceDir,Executable2, + [switch_order,ExactFile3,"hello world", + "dlrow olleh"]), + [ExactFile3,"hello world","dlrow olleh"] = + run_echo_args(SpaceDir,Executable2, + [default,"hello world","dlrow olleh"]), + [ExactFile3,"hello world","dlrow olleh"] = + run_echo_args_2("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\""), + [ExactFile3,"hello world","dlrow olleh"] = + run_echo_args_2(unicode:characters_to_binary("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\"")), {'EXIT',{enoent,_}} = (catch run_echo_args(SpaceDir,"fnurflmonfi", - [default,"hello world", - "dlrow olleh"])), + [default,"hello world", + "dlrow olleh"])), NonExec = "kronxfrt"++ExeExt, file:write_file(filename:join([SpaceDir,NonExec]), - <<"Not an executable">>), + <<"Not an executable">>), {'EXIT',{eacces,_}} = (catch run_echo_args(SpaceDir,NonExec, - [default,"hello world", - "dlrow olleh"])), + [default,"hello world", + "dlrow olleh"])), {'EXIT',{enoent,_}} = (catch open_port({spawn_executable,"cmd"},[])), {'EXIT',{enoent,_}} = (catch open_port({spawn_executable,"sh"},[])), case os:type() of - {win32,_} -> - test_bat_file(SpaceDir); - {unix,_} -> - test_sh_file(SpaceDir) + {win32,_} -> + test_bat_file(SpaceDir); + {unix,_} -> + test_sh_file(SpaceDir) end, - test_server:timetrap_cancel(Dog), ok. unregister_name(Config) when is_list(Config) -> @@ -1473,29 +1715,29 @@ test_bat_file(Dir) -> FN = "tf.bat", Full = filename:join([Dir,FN]), D = [<<"@echo off\r\n">>, - <<"echo argv[0]:^|%0^|\r\n">>, - <<"if \"%1\" == \"\" goto done\r\n">>, - <<"echo argv[1]:^|%1^|\r\n">>, - <<"if \"%2\" == \"\" goto done\r\n">>, - <<"echo argv[2]:^|%2^|\r\n">>, - <<"if \"%3\" == \"\" goto done\r\n">>, - <<"echo argv[3]:^|%3^|\r\n">>, - <<"if \"%4\" == \"\" goto done\r\n">>, - <<"echo argv[4]:^|%4^|\r\n">>, - <<"if \"%5\" == \"\" goto done\r\n">>, - <<"echo argv[5]:^|%5^|\r\n">>, - <<"\r\n">>, - <<":done\r\n">>, - <<"\r\n">>], + <<"echo argv[0]:^|%0^|\r\n">>, + <<"if \"%1\" == \"\" goto done\r\n">>, + <<"echo argv[1]:^|%1^|\r\n">>, + <<"if \"%2\" == \"\" goto done\r\n">>, + <<"echo argv[2]:^|%2^|\r\n">>, + <<"if \"%3\" == \"\" goto done\r\n">>, + <<"echo argv[3]:^|%3^|\r\n">>, + <<"if \"%4\" == \"\" goto done\r\n">>, + <<"echo argv[4]:^|%4^|\r\n">>, + <<"if \"%5\" == \"\" goto done\r\n">>, + <<"echo argv[5]:^|%5^|\r\n">>, + <<"\r\n">>, + <<":done\r\n">>, + <<"\r\n">>], file:write_file(Full,list_to_binary(D)), EF = filename:basename(FN), - [DN,"hello","world"] = - run_echo_args(Dir,FN, - [default,"hello","world"]), + [DN,"hello","world"] = + run_echo_args(Dir,FN, + [default,"hello","world"]), %% The arg0 argumant should be ignored when running batch files - [DN,"hello","world"] = - run_echo_args(Dir,FN, - ["knaskurt","hello","world"]), + [DN,"hello","world"] = + run_echo_args(Dir,FN, + ["knaskurt","hello","world"]), EF = filename:basename(DN), ok. @@ -1503,40 +1745,40 @@ test_sh_file(Dir) -> FN = "tf.sh", Full = filename:join([Dir,FN]), D = [<<"#! /bin/sh\n">>, - <<"echo 'argv[0]:|'$0'|'\n">>, - <<"i=1\n">>, - <<"while [ '!' -z \"$1\" ]; do\n">>, - <<" echo 'argv['$i']:|'\"$1\"'|'\n">>, - <<" shift\n">>, - <<" i=`expr $i + 1`\n">>, - <<"done\n">>], + <<"echo 'argv[0]:|'$0'|'\n">>, + <<"i=1\n">>, + <<"while [ '!' -z \"$1\" ]; do\n">>, + <<" echo 'argv['$i']:|'\"$1\"'|'\n">>, + <<" shift\n">>, + <<" i=`expr $i + 1`\n">>, + <<"done\n">>], file:write_file(Full,list_to_binary(D)), chmodplusx(Full), - [Full,"hello","world"] = - run_echo_args(Dir,FN, - [default,"hello","world"]), - [Full,"hello","world of spaces"] = - run_echo_args(Dir,FN, - [default,"hello","world of spaces"]), + [Full,"hello","world"] = + run_echo_args(Dir,FN, + [default,"hello","world"]), + [Full,"hello","world of spaces"] = + run_echo_args(Dir,FN, + [default,"hello","world of spaces"]), file:write_file(filename:join([Dir,"testfile1"]),<<"testdata1">>), file:write_file(filename:join([Dir,"testfile2"]),<<"testdata2">>), Pattern = filename:join([Dir,"testfile*"]), L = filelib:wildcard(Pattern), 2 = length(L), - [Full,"hello",Pattern] = - run_echo_args(Dir,FN, - [default,"hello",Pattern]), - ok. + [Full,"hello",Pattern] = + run_echo_args(Dir,FN, + [default,"hello",Pattern]), + ok. + - chmodplusx(Filename) -> case file:read_file_info(Filename) of - {ok,FI} -> - FI2 = FI#file_info{mode = ((FI#file_info.mode) bor 8#00100)}, - file:write_file_info(Filename,FI2); - _ -> - ok + {ok,FI} -> + FI2 = FI#file_info{mode = ((FI#file_info.mode) bor 8#00100)}, + file:write_file_info(Filename,FI2); + _ -> + ok end. run_echo_args_2(FullnameAndArgs) -> @@ -1545,7 +1787,7 @@ run_echo_args_2(FullnameAndArgs) -> Port ! {self(), close}, receive {Port, closed} -> ok end, parse_echo_args_output(Data). - + run_echo_args(Where,Args) -> run_echo_args(Where,"echo_args",Args). @@ -1553,9 +1795,9 @@ run_echo_args(Where,Prog,Args) -> {Binary, ArgvArg} = pack_argv(Args), Command0 = filename:join([Where,Prog]), Command = case Binary of - true -> unicode:characters_to_binary(Command0); - false -> Command0 - end, + true -> unicode:characters_to_binary(Command0); + false -> Command0 + end, Port = open_port({spawn_executable,Command},ArgvArg++[eof]), Data = collect_data(Port), Port ! {self(), close}, @@ -1569,14 +1811,14 @@ pack_argv(Args) -> pack_argv(Args, Binary) -> case Args of - [] -> - []; - [default|T] -> - [{args,[make_bin(Arg,Binary) || Arg <- T]}]; - [switch_order,H|T] -> - [{args,[make_bin(Arg,Binary) || Arg <- T]},{arg0,make_bin(H,Binary)}]; - [H|T] -> - [{arg0,make_bin(H,Binary)},{args,[make_bin(Arg,Binary) || Arg <- T]}] + [] -> + []; + [default|T] -> + [{args,[make_bin(Arg,Binary) || Arg <- T]}]; + [switch_order,H|T] -> + [{args,[make_bin(Arg,Binary) || Arg <- T]},{arg0,make_bin(H,Binary)}]; + [H|T] -> + [{arg0,make_bin(H,Binary)},{args,[make_bin(Arg,Binary) || Arg <- T]}] end. make_bin(Str, false) -> Str; @@ -1584,54 +1826,49 @@ make_bin(Str, true) -> unicode:characters_to_binary(Str). collect_data(Port) -> receive - {Port, {data, Data}} -> - Data ++ collect_data(Port); - {Port, eof} -> - [] + {Port, {data, Data}} -> + Data ++ collect_data(Port); + {Port, eof} -> + [] end. parse_echo_args_output(Data) -> - [lists:last(string:tokens(S,"|")) || S <- string:tokens(Data,"\r\n")]. + [lists:last(string:lexemes(S,"|")) || S <- string:lexemes(Data,["\r\n",$\n])]. -mix_up_ports(suite) -> - []; -mix_up_ports(doc) -> - ["Test that the emulator does not mix up ports when the port table wraps"]; +%% Test that the emulator does not mix up ports when the port table wraps mix_up_ports(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "echo_drv"), Port = erlang:open_port({spawn, "echo_drv"}, []), Port ! {self(), {command, "Hello port!"}}, - receive - {Port, {data, "Hello port!"}} = Msg1 -> - io:format("~p~n", [Msg1]), - ok; - Other -> - test_server:fail({unexpected, Other}) - end, + receive + {Port, {data, "Hello port!"}} = Msg1 -> + io:format("~p~n", [Msg1]), + ok; + Other -> + ct:fail({unexpected, Other}) + end, Port ! {self(), close}, receive {Port, closed} -> ok end, loop(start, done, - fun(P) -> - Q = - (catch erlang:open_port({spawn, "echo_drv"}, [])), -%% io:format("~p ", [Q]), - if is_port(Q) -> - Q; - true -> - io:format("~p~n", [P]), - done - end - end), + fun(P) -> + Q = + (catch erlang:open_port({spawn, "echo_drv"}, [])), + %% io:format("~p ", [Q]), + if is_port(Q) -> + Q; + true -> + io:format("~p~n", [P]), + done + end + end), Port ! {self(), {command, "Hello again port!"}}, - receive - Msg2 -> - test_server:fail({unexpected, Msg2}) - after 1000 -> - ok - end, - test_server:timetrap_cancel(Dog), + receive + Msg2 -> + ct:fail({unexpected, Msg2}) + after 1000 -> + ok + end, ok. loop(Stop, Stop, Fun) when is_function(Fun) -> @@ -1640,131 +1877,118 @@ loop(Start, Stop, Fun) when is_function(Fun) -> loop(Fun(Start), Stop, Fun). -otp_5112(suite) -> - []; -otp_5112(doc) -> - ["Test that link to connected process is taken away when port calls", - "driver_exit() also when the port index has wrapped"]; +%% Test that link to connected process is taken away when port calls +%% driver_exit() also when the port index has wrapped otp_5112(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "exit_drv"), Port = otp_5112_get_wrapped_port(), - ?t:format("Max ports: ~p~n",[max_ports()]), - ?t:format("Port: ~p~n",[Port]), + io:format("Max ports: ~p~n",[max_ports()]), + io:format("Port: ~p~n",[Port]), {links, Links1} = process_info(self(),links), - ?t:format("Links1: ~p~n",[Links1]), + io:format("Links1: ~p~n",[Links1]), true = lists:member(Port, Links1), Port ! {self(), {command, ""}}, - ?line wait_until(fun () -> lists:member(Port, erlang:ports()) == false end), + wait_until(fun () -> lists:member(Port, erlang:ports()) == false end), {links, Links2} = process_info(self(),links), - ?t:format("Links2: ~p~n",[Links2]), + io:format("Links2: ~p~n",[Links2]), false = lists:member(Port, Links2), %% This used to fail - test_server:timetrap_cancel(Dog), ok. otp_5112_get_wrapped_port() -> P1 = erlang:open_port({spawn, "exit_drv"}, []), case port_ix(P1) < max_ports() of - true -> - ?t:format("Need to wrap port index (~p)~n", [P1]), - otp_5112_wrap_port_ix([P1]), - P2 = erlang:open_port({spawn, "exit_drv"}, []), - false = port_ix(P2) < max_ports(), - P2; - false -> - ?t:format("Port index already wrapped (~p)~n", [P1]), - P1 - end. + true -> + io:format("Need to wrap port index (~p)~n", [P1]), + otp_5112_wrap_port_ix([P1]), + P2 = erlang:open_port({spawn, "exit_drv"}, []), + false = port_ix(P2) < max_ports(), + P2; + false -> + io:format("Port index already wrapped (~p)~n", [P1]), + P1 + end. otp_5112_wrap_port_ix(Ports) -> case (catch erlang:open_port({spawn, "exit_drv"}, [])) of - Port when is_port(Port) -> - otp_5112_wrap_port_ix([Port|Ports]); - _ -> - %% Port table now full; empty port table - lists:foreach(fun (P) -> P ! {self(), close} end, - Ports), - ok - end. + Port when is_port(Port) -> + otp_5112_wrap_port_ix([Port|Ports]); + _ -> + %% Port table now full; empty port table + lists:foreach(fun (P) -> P ! {self(), close} end, + Ports), + ok + end. -otp_5119(suite) -> - []; -otp_5119(doc) -> - ["Test that port index is not unnecessarily wrapped"]; +%% Test that port index is not unnecessarily wrapped otp_5119(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "exit_drv"), PI1 = port_ix(otp_5119_fill_empty_port_tab([])), Port2 = erlang:open_port({spawn, "exit_drv"}, []), PI2 = port_ix(Port2), {PortIx1, PortIx2} = case PI2 > PI1 of - true -> - {PI1, PI2}; - false -> - {port_ix(otp_5119_fill_empty_port_tab([Port2])), - port_ix(erlang:open_port({spawn, "exit_drv"}, []))} - end, + true -> + {PI1, PI2}; + false -> + {port_ix(otp_5119_fill_empty_port_tab([Port2])), + port_ix(erlang:open_port({spawn, "exit_drv"}, []))} + end, MaxPorts = max_ports(), - ?t:format("PortIx1 = ~p ~p~n", [PI1, PortIx1]), - ?t:format("PortIx2 = ~p ~p~n", [PI2, PortIx2]), - ?t:format("MaxPorts = ~p~n", [MaxPorts]), + io:format("PortIx1 = ~p ~p~n", [PI1, PortIx1]), + io:format("PortIx2 = ~p ~p~n", [PI2, PortIx2]), + io:format("MaxPorts = ~p~n", [MaxPorts]), true = PortIx2 > PortIx1, true = PortIx2 =< PortIx1 + MaxPorts, - test_server:timetrap_cancel(Dog), ok. otp_5119_fill_empty_port_tab(Ports) -> case (catch erlang:open_port({spawn, "exit_drv"}, [])) of - Port when is_port(Port) -> - otp_5119_fill_empty_port_tab([Port|Ports]); - _ -> - %% Port table now full; empty port table - lists:foreach(fun (P) -> P ! {self(), close} end, - Ports), - [LastPort|_] = Ports, - LastPort - end. + Port when is_port(Port) -> + otp_5119_fill_empty_port_tab([Port|Ports]); + _ -> + %% Port table now full; empty port table + lists:foreach(fun (P) -> P ! {self(), close} end, + Ports), + [LastPort|_] = Ports, + LastPort + end. max_ports() -> erlang:system_info(port_limit). port_ix(Port) when is_port(Port) -> - ["#Port",_,PortIxStr] = string:tokens(erlang:port_to_list(Port), - "<.>"), + ["#Port",_,PortIxStr] = string:lexemes(erlang:port_to_list(Port), + "<.>"), list_to_integer(PortIxStr). -otp_6224(doc) -> ["Check that port command failure doesn't crash the emulator"]; -otp_6224(suite) -> []; +%% Check that port command failure doesn't crash the emulator otp_6224(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "failure_drv"), Go = make_ref(), Failer = spawn(fun () -> - receive Go -> ok end, - Port = open_port({spawn, "failure_drv"}, - []), - Port ! {self(), {command, "Fail, please!"}}, - otp_6224_loop() - end), + receive Go -> ok end, + Port = open_port({spawn, "failure_drv"}, + []), + Port ! {self(), {command, "Fail, please!"}}, + otp_6224_loop() + end), Mon = erlang:monitor(process, Failer), Failer ! Go, receive - {'DOWN', Mon, process, Failer, Reason} -> - case Reason of - {driver_failed, _} -> ok; - driver_failed -> ok; - _ -> ?t:fail({unexpected_exit_reason, - Reason}) - end - end, - test_server:timetrap_cancel(Dog), + {'DOWN', Mon, process, Failer, Reason} -> + case Reason of + {driver_failed, _} -> ok; + driver_failed -> ok; + _ -> ct:fail({unexpected_exit_reason, + Reason}) + end + end, ok. - + otp_6224_loop() -> receive _ -> ok after 0 -> ok end, otp_6224_loop(). @@ -1773,163 +1997,160 @@ otp_6224_loop() -> -define(EXIT_STATUS_MSB_MAX_PROCS, 64). -define(EXIT_STATUS_MSB_MAX_PORTS, 300). -exit_status_multi_scheduling_block(doc) -> []; -exit_status_multi_scheduling_block(suite) -> []; exit_status_multi_scheduling_block(Config) when is_list(Config) -> Repeat = 3, - case ?t:os_type() of - {unix, _} -> - Dog = ?t:timetrap(test_server:minutes(2*Repeat)), - SleepSecs = 6, - try - lists:foreach(fun (_) -> - exit_status_msb_test(Config, - SleepSecs) - end, - lists:seq(1, Repeat)) - after - %% Wait for the system to recover (regardless - %% of success or not) otherwise later testcases - %% may unnecessarily fail. - ?t:timetrap_cancel(Dog), - receive after SleepSecs+500 -> ok end - end; - _ -> {skip, "Not implemented for this OS"} - end. + case os:type() of + {unix, _} -> + ct:timetrap({minutes, 2*Repeat}), + SleepSecs = 6, + try + lists:foreach(fun (_) -> + exit_status_msb_test(Config, + SleepSecs) + end, + lists:seq(1, Repeat)) + after + %% Wait for the system to recover (regardless + %% of success or not) otherwise later testcases + %% may unnecessarily fail. + receive after SleepSecs+500 -> ok end + end; + _ -> {skip, "Not implemented for this OS"} + end. exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> %% %% We want to start port programs from as many schedulers as possible %% and we want these port programs to terminate while multi-scheduling %% is blocked. - %% + %% NoSchedsOnln = erlang:system_info(schedulers_online), Parent = self(), - ?t:format("SleepSecs = ~p~n", [SleepSecs]), + io:format("SleepSecs = ~p~n", [SleepSecs]), PortProg = "sleep " ++ integer_to_list(SleepSecs), - Start = now(), + Start = erlang:monotonic_time(microsecond), NoProcs = case NoSchedsOnln of - NProcs when NProcs < ?EXIT_STATUS_MSB_MAX_PROCS -> - NProcs; - _ -> - ?EXIT_STATUS_MSB_MAX_PROCS - end, + NProcs when NProcs < ?EXIT_STATUS_MSB_MAX_PROCS -> + NProcs; + _ -> + ?EXIT_STATUS_MSB_MAX_PROCS + end, NoPortsPerProc = case 20*NoProcs of - TNPorts when TNPorts < ?EXIT_STATUS_MSB_MAX_PORTS -> 20; - _ -> ?EXIT_STATUS_MSB_MAX_PORTS div NoProcs - end, - ?t:format("NoProcs = ~p~nNoPortsPerProc = ~p~n", - [NoProcs, NoPortsPerProc]), + TNPorts when TNPorts < ?EXIT_STATUS_MSB_MAX_PORTS -> 20; + _ -> ?EXIT_STATUS_MSB_MAX_PORTS div NoProcs + end, + io:format("NoProcs = ~p~nNoPortsPerProc = ~p~n", + [NoProcs, NoPortsPerProc]), ProcFun - = fun () -> - PrtSIds = lists:map( - fun (_) -> - erlang:yield(), - case catch open_port({spawn, PortProg}, - [exit_status]) of - Prt when is_port(Prt) -> - {Prt, - erlang:system_info(scheduler_id)}; - {'EXIT', {Err, _}} when Err == eagain; - Err == emfile -> - noop; - {'EXIT', Err} when Err == eagain; - Err == emfile -> - noop; - Error -> - ?t:fail(Error) - end - end, - lists:seq(1, NoPortsPerProc)), - SIds = lists:filter(fun (noop) -> false; - (_) -> true - end, - lists:map(fun (noop) -> noop; - ({_, SId}) -> SId - end, - PrtSIds)), - process_flag(scheduler, 0), - Parent ! {self(), started, SIds}, - lists:foreach( - fun (noop) -> - noop; - ({Port, _}) -> - receive - {Port, {exit_status, 0}} -> - ok; - {Port, {exit_status, Status}} when Status > 128 -> - %% Sometimes happens when we have created - %% too many ports. - ok; - {Port, {exit_status, _}} = ESMsg -> - {Port, {exit_status, 0}} = ESMsg - end - end, - PrtSIds), - Parent ! {self(), done} - end, + = fun () -> + PrtSIds = lists:map( + fun (_) -> + erlang:yield(), + case catch open_port({spawn, PortProg}, + [exit_status]) of + Prt when is_port(Prt) -> + {Prt, + erlang:system_info(scheduler_id)}; + {'EXIT', {Err, _}} when Err == eagain; + Err == emfile; + Err == enomem -> + noop; + {'EXIT', Err} when Err == eagain; + Err == emfile; + Err == enomem -> + noop; + Error -> + ct:fail(Error) + end + end, + lists:seq(1, NoPortsPerProc)), + SIds = lists:filter(fun (noop) -> false; + (_) -> true + end, + lists:map(fun (noop) -> noop; + ({_, SId}) -> SId + end, + PrtSIds)), + process_flag(scheduler, 0), + Parent ! {self(), started, SIds}, + lists:foreach( + fun (noop) -> + noop; + ({Port, _}) -> + receive + {Port, {exit_status, 0}} -> + ok; + {Port, {exit_status, Status}} when Status > 128 -> + %% Sometimes happens when we have created + %% too many ports. + ok; + {Port, {exit_status, _}} = ESMsg -> + {Port, {exit_status, 0}} = ESMsg + end + end, + PrtSIds), + Parent ! {self(), done} + end, Procs = lists:map(fun (N) -> - spawn_opt(ProcFun, - [link, - {scheduler, - (N rem NoSchedsOnln)+1}]) - end, - lists:seq(1, NoProcs)), + spawn_opt(ProcFun, + [link, + {scheduler, + (N rem NoSchedsOnln)+1}]) + end, + lists:seq(1, NoProcs)), SIds = lists:map(fun (P) -> - receive {P, started, SIds} -> SIds end - end, - Procs), - StartedTime = timer:now_diff(now(), Start)/1000000, - ?t:format("StartedTime = ~p~n", [StartedTime]), + receive {P, started, SIds} -> SIds end + end, + Procs), + StartedTime = (erlang:monotonic_time(microsecond) - Start)/1000000, + io:format("StartedTime = ~p~n", [StartedTime]), true = StartedTime < SleepSecs, - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), lists:foreach(fun (P) -> receive {P, done} -> ok end end, Procs), - DoneTime = timer:now_diff(now(), Start)/1000000, - ?t:format("DoneTime = ~p~n", [DoneTime]), + DoneTime = (erlang:monotonic_time(microsecond) - Start)/1000000, + io:format("DoneTime = ~p~n", [DoneTime]), true = DoneTime > SleepSecs, ok = verify_multi_scheduling_blocked(), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), case {length(lists:usort(lists:flatten(SIds))), NoSchedsOnln} of - {N, N} -> - ok; - {N, M} -> - ?t:fail("Failed to create ports on all" - ++ integer_to_list(M) ++ " available" - "schedulers. Only created ports on " - ++ integer_to_list(N) ++ " schedulers.") - end. + {N, N} -> + ok; + {N, M} -> + ct:fail("Failed to create ports on all ~w available" + "schedulers. Only created ports on ~w schedulers.", [M, N]) + end. save_sid(SIds) -> SId = erlang:system_info(scheduler_id), case lists:member(SId, SIds) of - true -> SIds; - false -> [SId|SIds] + true -> SIds; + false -> [SId|SIds] end. sid_proc(SIds) -> NewSIds = save_sid(SIds), receive - {From, want_sids} -> - From ! {self(), sids, NewSIds} + {From, want_sids} -> + From ! {self(), sids, NewSIds} after 0 -> - sid_proc(NewSIds) + sid_proc(NewSIds) end. verify_multi_scheduling_blocked() -> Procs = lists:map(fun (_) -> - spawn_link(fun () -> sid_proc([]) end) - end, - lists:seq(1, 3*erlang:system_info(schedulers_online))), + spawn_link(fun () -> sid_proc([]) end) + end, + lists:seq(1, 3*erlang:system_info(schedulers_online))), receive after 1000 -> ok end, SIds = lists:map(fun (P) -> - P ! {self(), want_sids}, - receive {P, sids, PSIds} -> PSIds end - end, - Procs), + P ! {self(), want_sids}, + receive {P, sids, PSIds} -> PSIds end + end, + Procs), 1 = length(lists:usort(lists:flatten(SIds))), ok. - - + + %%% Pinging functions. stream_ping(Config, Size, CmdLine, Options) -> @@ -1938,10 +2159,10 @@ stream_ping(Config, Size, CmdLine, Options) -> ping(Config, Sizes, HSize, CmdLine, Options) -> Actions = lists:map(fun(Size) -> - [$p|Packet] = random_packet(Size, "ping"), - {[$p|Packet], [[$P|Packet]]} - end, - Sizes), + [$p|Packet] = random_packet(Size, "ping"), + {[$p|Packet], [[$P|Packet]]} + end, + Sizes), port_expect(Config, Actions, HSize, CmdLine, Options). %% expect_input(Sizes, HSize, CmdLine, Options) @@ -1949,7 +2170,7 @@ ping(Config, Sizes, HSize, CmdLine, Options) -> %% Sizes = Size of packets to generated. %% HSize = Header size: 1, 2, or 4 %% CmdLine = Additional command line options. -%% Options = Addtional port options. +%% Options = Additional port options. expect_input(Config, Sizes, HSize, CmdLine, Options) -> expect_input1(Config, Sizes, {HSize, CmdLine, Options}, [], []). @@ -1963,7 +2184,7 @@ expect_input1(Config, [Size|Rest], Params, Expect, ReplyCommand) -> expect_input1(Config, [], {HSize, CmdLine0, Options}, Expect, ReplyCommand) -> CmdLine = build_cmd_line(CmdLine0, ReplyCommand, []), port_expect(Config, [{false, lists:reverse(Expect)}], - HSize, CmdLine, Options). + HSize, CmdLine, Options). build_cmd_line(FixedCmdLine, [Cmd|Rest], []) -> build_cmd_line(FixedCmdLine, Rest, [Cmd]); @@ -1986,15 +2207,15 @@ build_cmd_line(FixedCmdLine, [], Result) -> %% Returns the port. port_expect(Config, Actions, HSize, CmdLine, Options0) -> -% io:format("port_expect(~p, ~p, ~p, ~p)", -% [Actions, HSize, CmdLine, Options0]), + % io:format("port_expect(~p, ~p, ~p, ~p)", + % [Actions, HSize, CmdLine, Options0]), PortTest = port_test(Config), Cmd = lists:concat([PortTest, " -h", HSize, " ", CmdLine]), PortType = - case HSize of - 0 -> stream; - _ -> {packet, HSize} - end, + case HSize of + 0 -> stream; + _ -> {packet, HSize} + end, Options = [PortType|Options0], io:format("open_port({spawn, ~p}, ~p)", [Cmd, Options]), Port = open_port({spawn, Cmd}, Options), @@ -2005,11 +2226,11 @@ port_expect(Port, [{Send, Expects}|Rest], Options) when is_list(Expects) -> port_send(Port, Send), IsBinaryPort = lists:member(binary, Options), Receiver = - case {lists:member(stream, Options), line_option(Options)} of - {false, _} -> fun receive_all/2; - {true,false} -> fun stream_receive_all/2; - {_, true} -> fun receive_all/2 - end, + case {lists:member(stream, Options), line_option(Options)} of + {false, _} -> fun receive_all/2; + {true,false} -> fun stream_receive_all/2; + {_, true} -> fun receive_all/2 + end, Receiver(Port, maybe_to_binary(Expects, IsBinaryPort)), port_expect(Port, Rest, Options); port_expect(_, [], _) -> @@ -2037,34 +2258,34 @@ maybe_to_binary(Expects, false) -> port_send(_Port, false) -> ok; port_send(Port, Send) when is_list(Send) -> -% io:format("port_send(~p, ~p)", [Port, Send]), + % io:format("port_send(~p, ~p)", [Port, Send]), Port ! {self(), {command, Send}}. receive_all(Port, [Expect|Rest]) -> -% io:format("receive_all(~p, [~p|Rest])", [Port, Expect]), + % io:format("receive_all(~p, [~p|Rest])", [Port, Expect]), receive - {Port, {data, Expect}} -> - io:format("Received ~s", [format(Expect)]), - ok; - {Port, {data, Other}} -> - io:format("Received ~s; expected ~s", - [format(Other), format(Expect)]), - test_server:fail(bad_message); - Other -> - %% (We're not yet prepared for receiving both 'eol' and - %% 'exit_status'; remember that they may appear in any order.) - case {Expect, Rest, Other} of - {eof, [], {Port, eof}} -> - io:format("Received soft EOF.",[]), - ok; - {{exit_status, S}, [], {Port, {exit_status, S}}} -> - io:format("Received exit status ~p.",[S]), - ok; - _ -> -%%% io:format("Unexpected message: ~s", [format(Other)]), - io:format("Unexpected message: ~w", [Other]), - test_server:fail(unexpected_message) - end + {Port, {data, Expect}} -> + io:format("Received ~s", [format(Expect)]), + ok; + {Port, {data, Other}} -> + io:format("Received ~s; expected ~s", + [format(Other), format(Expect)]), + ct:fail(bad_message); + Other -> + %% (We're not yet prepared for receiving both 'eol' and + %% 'exit_status'; remember that they may appear in any order.) + case {Expect, Rest, Other} of + {eof, [], {Port, eof}} -> + io:format("Received soft EOF.",[]), + ok; + {{exit_status, S}, [], {Port, {exit_status, S}}} -> + io:format("Received exit status ~p.",[S]), + ok; + _ -> + %%% io:format("Unexpected message: ~s", [format(Other)]), + io:format("Unexpected message: ~w", [Other]), + ct:fail(unexpected_message) + end end, receive_all(Port, Rest); receive_all(_Port, []) -> @@ -2079,30 +2300,30 @@ stream_receive_all1(_Port, []) -> ok; stream_receive_all1(Port, Expect) -> receive - {Port, {data, Data}} -> - Remaining = compare(Data, Expect), - stream_receive_all1(Port, Remaining); - Other -> - test_server:fail({bad_message, Other}) + {Port, {data, Data}} -> + Remaining = compare(Data, Expect), + stream_receive_all1(Port, Remaining); + Other -> + ct:fail({bad_message, Other}) end. compare(B1, B2) when is_binary(B1), is_binary(B2), byte_size(B1) =< byte_size(B2) -> case split_binary(B2, size(B1)) of - {B1,Remaining} -> - Remaining; - _Other -> - test_server:fail(nomatch) + {B1,Remaining} -> + Remaining; + _Other -> + ct:fail(nomatch) end; compare(B1, B2) when is_binary(B1), is_binary(B2) -> - test_server:fail(too_much_data); + ct:fail(too_much_data); compare([X|Rest1], [X|Rest2]) -> compare(Rest1, Rest2); compare([_|_], [_|_]) -> - test_server:fail(nomatch); + ct:fail(nomatch); compare([], Remaining) -> Remaining; compare(_Data, []) -> - test_server:fail(too_much_data). + ct:fail(too_much_data). maybe_to_list(Bin) when is_binary(Bin) -> binary_to_list(Bin); @@ -2110,13 +2331,13 @@ maybe_to_list(List) -> List. format({Eol,List}) -> - io_lib:format("tuple<~w,~s>",[Eol, maybe_to_list(List)]); + io_lib:format("tuple<~w,~w>",[Eol, maybe_to_list(List)]); format(List) when is_list(List) -> case list_at_least(50, List) of - true -> - io_lib:format("\"~-50s...\"", [List]); - false -> - io_lib:format("~p", [List]) + true -> + io_lib:format("\"~-50s...\"", [List]); + false -> + io_lib:format("~p", [List]) end; format(Bin) when is_binary(Bin), size(Bin) >= 50 -> io_lib:format("binary<~-50s...>", [binary_to_list(Bin, 1, 50)]); @@ -2143,17 +2364,17 @@ build_packet(0, Result, _NextChar) -> lists:reverse(Result); build_packet(Left, Result, NextChar0) -> NextChar = - if - NextChar0 >= 126 -> - 33; - true -> - NextChar0+1 - end, + if + NextChar0 >= 126 -> + 33; + true -> + NextChar0+1 + end, build_packet(Left-1, [NextChar0|Result], NextChar). sizes() -> [10, 13, 64, 127, 128, 255, 256, 1023, 1024, - 32767, 32768, 65535, 65536]. + 32767, 32768, 65535, 65536]. sizes(Header_Size) -> sizes(Header_Size, sizes(), []). @@ -2174,15 +2395,14 @@ random_char(Chars) -> lists:nth(uniform(length(Chars)), Chars). uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = Seed = time(), - io:format("Random seed = ~p\n",[Seed]), - random:seed(X, Y, Z); - _ -> - ok + case rand:export_seed() of + undefined -> + rand:seed(exsplus), + io:format("Random seed = ~p\n", [rand:export_seed()]); + _ -> + ok end, - random:uniform(N). + rand:uniform(N). fun_spawn(Fun) -> fun_spawn(Fun, []). @@ -2191,13 +2411,11 @@ fun_spawn(Fun, Args) -> spawn_link(erlang, apply, [Fun, Args]). port_test(Config) when is_list(Config) -> - filename:join(?config(data_dir, Config), "port_test"). - + filename:join(proplists:get_value(data_dir, Config), "port_test"). -ports(doc) -> "Test that erlang:ports/0 returns a consistent snapshot of ports"; -ports(suite) -> []; +%% Test that erlang:ports/0 returns a consistent snapshot of ports ports(Config) when is_list(Config) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "exit_drv"), receive after 1000 -> ok end, % Wait for other ports to stabilize @@ -2217,14 +2435,14 @@ ports_snapshots(0, _, _) -> ok; ports_snapshots(Iter, TrafficPid, OtherPorts) -> - TrafficPid ! start, + TrafficPid ! start, receive after 1 -> ok end, Snapshot = erlang:ports(), TrafficPid ! {self(), stop}, receive {TrafficPid, EventList, TrafficPorts} -> ok end, - + %%io:format("Snapshot=~p\n", [Snapshot]), ports_verify(Snapshot, OtherPorts ++ TrafficPorts, EventList), @@ -2236,78 +2454,77 @@ ports_traffic(MaxPorts) -> ports_traffic_stopped(MaxPorts, {PortList, PortCnt}) -> receive - start -> - %%io:format("Traffic started in ~p\n",[self()]), - ports_traffic_started(MaxPorts, {PortList, PortCnt}, []); - {Pid,die} -> - lists:foreach(fun(Port)-> erlang:port_close(Port) end, - PortList), - Pid ! {self(),dead} + start -> + %%io:format("Traffic started in ~p\n",[self()]), + ports_traffic_started(MaxPorts, {PortList, PortCnt}, []); + {Pid,die} -> + lists:foreach(fun(Port)-> erlang:port_close(Port) end, + PortList), + Pid ! {self(),dead} end. ports_traffic_started(MaxPorts, {PortList, PortCnt}, EventList) -> - receive - {Pid, stop} -> - %%io:format("Traffic stopped in ~p\n",[self()]), - Pid ! {self(), EventList, PortList}, - ports_traffic_stopped(MaxPorts, {PortList, PortCnt}) + receive + {Pid, stop} -> + %%io:format("Traffic stopped in ~p\n",[self()]), + Pid ! {self(), EventList, PortList}, + ports_traffic_stopped(MaxPorts, {PortList, PortCnt}) after 0 -> - ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList) + ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList) end. ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList) -> N = uniform(MaxPorts), case N > PortCnt of - true -> % Open port - P = open_port({spawn, "exit_drv"}, []), - %%io:format("Created port ~p\n",[P]), - ports_traffic_started(MaxPorts, {[P|PortList], PortCnt+1}, - [{open,P}|EventList]); - - false -> % Close port - P = lists:nth(N, PortList), - %%io:format("Close port ~p\n",[P]), - true = erlang:port_close(P), - ports_traffic_started(MaxPorts, {lists:delete(P,PortList), PortCnt-1}, - [{close,P}|EventList]) + true -> % Open port + P = open_port({spawn, "exit_drv"}, []), + %%io:format("Created port ~p\n",[P]), + ports_traffic_started(MaxPorts, {[P|PortList], PortCnt+1}, + [{open,P}|EventList]); + + false -> % Close port + P = lists:nth(N, PortList), + %%io:format("Close port ~p\n",[P]), + true = erlang:port_close(P), + ports_traffic_started(MaxPorts, {lists:delete(P,PortList), PortCnt-1}, + [{close,P}|EventList]) end. -ports_verify(Ports, PortsAfter, EventList) -> +ports_verify(Ports, PortsAfter, EventList) -> %%io:format("Candidate=~p\nEvents=~p\n", [PortsAfter, EventList]), case lists:sort(Ports) =:= lists:sort(PortsAfter) of - true -> - io:format("Snapshot of ~p ports verified ok.\n",[length(Ports)]), - ok; - false -> - %% Note that we track the event list "backwards", undoing open/close: - case EventList of - [{open,P} | Tail] -> - ports_verify(Ports, lists:delete(P,PortsAfter), Tail); - - [{close,P} | Tail] -> - ports_verify(Ports, [P | PortsAfter], Tail); - - [] -> - test_server:fail("Inconsistent snapshot from erlang:ports()") - end + true -> + io:format("Snapshot of ~p ports verified ok.\n",[length(Ports)]), + ok; + false -> + %% Note that we track the event list "backwards", undoing open/close: + case EventList of + [{open,P} | Tail] -> + ports_verify(Ports, lists:delete(P,PortsAfter), Tail); + + [{close,P} | Tail] -> + ports_verify(Ports, [P | PortsAfter], Tail); + + [] -> + ct:fail("Inconsistent snapshot from erlang:ports()") + end end. load_driver(Dir, Driver) -> case erl_ddll:load_driver(Dir, Driver) of - ok -> ok; - {error, Error} = Res -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - Res + ok -> ok; + {error, Error} = Res -> + 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." - "Primary targeting Windows to test threaded_handle_closer in sys.c"]; -close_deaf_port(suite) -> []; +%% Send data to port program that does not read it, then close port. +%% Primary targeting Windows to test threaded_handle_closer in sys.c close_deaf_port(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), - DataDir = ?config(data_dir, Config), + ct:timetrap({minutes, 2}), + DataDir = proplists:get_value(data_dir, Config), DeadPort = os:find_executable("dead_port", DataDir), Port = open_port({spawn,DeadPort++" 60"},[]), erlang:port_command(Port,"Hello, can you hear me!?!?"), @@ -2316,28 +2533,329 @@ close_deaf_port(Config) when is_list(Config) -> Res = close_deaf_port_1(0, DeadPort), io:format("Waiting for OS procs to terminate...\n"), receive after 5*1000 -> ok end, - test_server:timetrap_cancel(Dog), Res. close_deaf_port_1(200, _) -> ok; close_deaf_port_1(N, Cmd) -> - Timeout = integer_to_list(random:uniform(5*1000)), + Timeout = integer_to_list(rand:uniform(5*1000)), try open_port({spawn_executable,Cmd},[{args,[Timeout]}]) of - Port -> - erlang:port_command(Port,"Hello, can you hear me!?!?"), - port_close(Port), - close_deaf_port_1(N+1, Cmd) + Port -> + erlang:port_command(Port,"Hello, can you hear me!?!?"), + port_close(Port), + close_deaf_port_1(N+1, Cmd) catch - _:eagain -> - {comment, "Could not spawn more than " ++ integer_to_list(N) ++ " OS processes."} + _:eagain -> + {comment, "Could not spawn more than " ++ integer_to_list(N) ++ " OS processes."} end. +%% Test undocumented port_set_data/2 and port_get_data/1 +%% Hammer from multiple processes a while +%% and then abrubtly close the port (OTP-12208). +port_setget_data(Config) when is_list(Config) -> + ok = load_driver(proplists:get_value(data_dir, Config), "echo_drv"), + Port = erlang:open_port({spawn_driver, "echo_drv"}, []), + + NSched = erlang:system_info(schedulers_online), + HeapData = {1,2,3,<<"A heap binary">>,fun()->"This is fun"end, + list_to_binary(lists:seq(1,100))}, + PRs = lists:map(fun(I) -> + spawn_opt(fun() -> port_setget_data_hammer(Port,HeapData,false,1) end, + [monitor, {scheduler, I rem NSched}]) + end, + lists:seq(1,10)), + receive after 100 -> ok end, + Papa = self(), + lists:foreach(fun({Pid,_}) -> Pid ! {Papa,prepare_for_close} end, PRs), + lists:foreach(fun({Pid,_}) -> + receive {Pid,prepare_for_close} -> ok end + end, + PRs), + port_close(Port), + lists:foreach(fun({Pid,Ref}) -> + receive {'DOWN', Ref, process, Pid, normal} -> ok end + end, + PRs), + ok. + +port_setget_data_hammer(Port, HeapData, IsSet0, N) -> + Rand = rand:uniform(3), + IsSet1 = try case Rand of + 1 -> true = erlang:port_set_data(Port, atom), true; + 2 -> true = erlang:port_set_data(Port, HeapData), true; + 3 -> case erlang:port_get_data(Port) of + atom -> true; + HeapData -> true; + undefined -> false=IsSet0 + end + end + catch + error:badarg -> + true = get(prepare_for_close), + io:format("~p did ~p rounds before port closed\n", [self(), N]), + exit(normal) + end, + receive {Papa, prepare_for_close} -> + put(prepare_for_close, true), + Papa ! {self(),prepare_for_close} + after 0 -> + ok + end, + port_setget_data_hammer(Port, HeapData, IsSet1, N+1). + + wait_until(Fun) -> case catch Fun() of - true -> - ok; - _ -> - receive after 100 -> ok end, - wait_until(Fun) + true -> + ok; + _ -> + receive after 100 -> ok end, + wait_until(Fun) end. + +%% Attempt to monitor pid as port, and port as pid +mon_port_invalid_type(_Config) -> + Port = hd(erlang:ports()), + ?assertError(badarg, erlang:monitor(port, self())), + ?assertError(badarg, erlang:monitor(process, Port)), + ok. + +%% With local port +mon_port_local(Config) -> + Port1 = create_port(Config, ["-h1", "-q"]), % will close after we send 1 byte + Ref1 = erlang:monitor(port, Port1), + ?assertMatch({proc_monitors, true, port_monitored_by, true}, + port_is_monitored(self(), Port1)), + Port1 ! {self(), {command, <<"1">>}}, % port test will close self immediately + receive ExitP1 -> ?assertMatch({'DOWN', Ref1, port, Port1, _}, ExitP1) + after 1000 -> ?assert(false) end, + ?assertMatch({proc_monitors, false, port_monitored_by, false}, + port_is_monitored(self(), Port1)), + + %% Trying to re-monitor a port which exists but is not healthy will + %% succeed but then will immediately send DOWN + Ref2 = erlang:monitor(port, Port1), + receive ExitP2 -> ?assertMatch({'DOWN', Ref2, port, Port1, _}, ExitP2) + after 1000 -> ?assert(false) end, + ok. + +%% With remote port on remote node (should fail) +mon_port_remote_on_remote(_Config) -> + Port3 = binary_to_term(<<131, 102, % Ext term format: PORT_EXT + 100, 0, 13, "fgsfds@fgsfds", % Node :: ATOM_EXT + 1:32/big, % Id + 0>>), % Creation + ?assertError(badarg, erlang:monitor(port, Port3)), + ok. + +%% Remote port belongs to this node and does not exist +%% Port4 produces #Port<0.167772160> which should not exist in a test run +mon_port_bad_remote_on_local(_Config) -> + Port4 = binary_to_term(<<131, 102, % Ext term format: PORT_EXT + 100, 0, 13, "nonode@nohost", % Node + 167772160:32/big, % Id + 0>>), % Creation + ?assertError(badarg, erlang:monitor(port, Port4)), + ok. + +%% Monitor owner (origin) dies before port is closed +mon_port_origin_dies(Config) -> + Port5 = create_port(Config, ["-h1", "-q"]), % will close after we send 1 byte + Self5 = self(), + Proc5 = spawn(fun() -> + Self5 ! test5_started, + erlang:monitor(port, Port5), + receive stop -> ok end + end), + erlang:monitor(process, Proc5), % we want to sync with its death + receive test5_started -> ok + after 1000 -> ?assert(false) end, + ?assertMatch({proc_monitors, true, port_monitored_by, true}, + port_is_monitored(Proc5, Port5)), + Proc5 ! stop, + % receive from monitor (removing race condition) + receive ExitP5 -> ?assertMatch({'DOWN', _, process, Proc5, _}, ExitP5) + after 1000 -> ?assert(false) end, + ?assertMatch({proc_monitors, false, port_monitored_by, false}, + port_is_monitored(Proc5, Port5)), + Port5 ! {self(), {command, <<"1">>}}, % make port quit + ok. + +%% Port and Monitor owner dies before port is closed +%% This testcase checks for a regression memory leak in erts +%% when the controlling and monitoring process is the same process +%% and the process dies +mon_port_owner_dies(Config) -> + Self = self(), + Proc = spawn(fun() -> + Port = create_port(Config, ["-h1", "-q"]), + Self ! {test_started, Port}, + erlang:monitor(port, Port), + receive stop -> ok end + end), + erlang:monitor(process, Proc), % we want to sync with its death + Port = receive {test_started,P} -> P + after 1000 -> ?assert(false) end, + ?assertMatch({proc_monitors, true, port_monitored_by, true}, + port_is_monitored(Proc, Port)), + Proc ! stop, + %% receive from monitor + receive ExitP5 -> ?assertMatch({'DOWN', _, process, Proc, _}, ExitP5) + after 1000 -> ?assert(false) end, + ok. + +%% Monitor a named port +mon_port_named(Config) -> + Name6 = test_port6, + Port6 = create_port(Config, ["-h1", "-q"]), % will close after we send 1 byte + erlang:register(Name6, Port6), + erlang:monitor(port, Name6), + ?assertMatch({proc_monitors, true, port_monitored_by, true}, + port_is_monitored(self(), Name6)), + Port6 ! {self(), {command, <<"1">>}}, % port test will close self immediately + receive ExitP6 -> ?assertMatch({'DOWN', _, port, {Name6, _}, _}, ExitP6) + after 1000 -> ?assert(false) end, + ?assertMatch({proc_monitors, false, port_monitored_by, false}, + port_is_monitored(self(), Name6)), + ok. + +%% Named does not exist: Should succeed but immediately send 'DOWN' +mon_port_bad_named(_Config) -> + Name7 = test_port7, + erlang:monitor(port, Name7), + receive {'DOWN', _, port, {Name7, _}, noproc} -> ok + after 1000 -> ?assert(false) end, + ok. + +%% Monitor a pid and demonitor by ref +mon_port_pid_demonitor(Config) -> + Port8 = create_port(Config, ["-h1", "-q"]), % will close after we send 1 byte + Ref8 = erlang:monitor(port, Port8), + ?assertMatch({proc_monitors, true, port_monitored_by, true}, + port_is_monitored(self(), Port8)), + erlang:demonitor(Ref8), + ?assertMatch({proc_monitors, false, port_monitored_by, false}, + port_is_monitored(self(), Port8)), + Port8 ! {self(), {command, <<"1">>}}, % port test will close self immediately + ok. + +%% Monitor by name and demonitor by ref +mon_port_name_demonitor(Config) -> + Name9 = test_port9, + Port9 = create_port(Config, ["-h1", "-q"]), % will close after we send 1 byte + erlang:register(Name9, Port9), + Ref9 = erlang:monitor(port, Name9), + ?assertMatch({proc_monitors, true, port_monitored_by, true}, + port_is_monitored(self(), Name9)), + erlang:demonitor(Ref9), + ?assertMatch({proc_monitors, false, port_monitored_by, false}, + port_is_monitored(self(), Name9)), + Port9 ! {self(), {command, <<"1">>}}, % port test will close self immediately + ok. + +%% 1. Spawn a port which will sleep 3 seconds +%% 2. Port driver and dies horribly (via C driver_failure call). This should +%% mark port as exiting or something. +%% 3. While the command happens, a monitor is requested on the port +mon_port_driver_die(Config) -> + erlang:process_flag(scheduler, 1), + + Path = proplists:get_value(data_dir, Config), + ok = load_driver(Path, "sleep_failure_drv"), + Port = open_port({spawn, "sleep_failure_drv"}, []), + + Self = self(), + erlang:spawn_opt(fun() -> + timer:sleep(250), + Ref = erlang:monitor(port, Port), + %% Now check that msg actually arrives + receive + {'DOWN', Ref, _Port2, _, _} = M -> Self ! M + after 3000 -> Self ! no_down_message + end + end,[{scheduler, 2}]), + Port ! {self(), {command, "Fail, please!"}}, + receive + A when is_atom(A) -> ?assertEqual(A, 'A_should_be_printed'); + {'DOWN', _R, port, Port, noproc} -> ok; + {'DOWN', _R, _P, _, _} = M -> ct:fail({got_wrong_down,M}) + after 5000 -> ?assert(false) + end, + ok. + + +%% 1. Spawn a port which will sleep 3 seconds +%% 2. Monitor port +%% 3. Port driver and dies horribly (via C driver_failure call). This should +%% mark port as exiting or something. +%% 4. While the command happens, a demonitor is requested on the port +mon_port_driver_die_demonitor(Config) -> + erlang:process_flag(scheduler, 1), + + Path = proplists:get_value(data_dir, Config), + ok = load_driver(Path, "sleep_failure_drv"), + Port = open_port({spawn, "sleep_failure_drv"}, []), + + Self = self(), + erlang:spawn_opt( + fun() -> + Ref = erlang:monitor(port, Port), + Self ! Ref, + timer:sleep(250), + erlang:demonitor(Ref), + %% Now check that msg still arrives, + %% the demon should have arrived after + %% the port exited + receive + {'DOWN', Ref, _Port2, _, _} = M -> Self ! M + after 3000 -> Self ! no_down_message + end + end,[{scheduler, 2}]), + Ref = receive R -> R end, + Port ! {self(), {command, "Fail, please!"}}, + receive + {'DOWN', Ref, port, Port, normal} -> ok; + {'DOWN', _R, _P, _, _} = M -> ct:fail({got_wrong_down,M}) + after 5000 -> ?assert(false) + end, + ok. + +%% @doc Makes a controllable port for testing. Underlying mechanism of this +%% port is not important, only important is our ability to close/kill it or +%% have it monitored. +create_port(Config, Args) -> + DataDir = ?config(data_dir, Config), + %% Borrow port test utility from port SUITE + Program = filename:join([DataDir, "port_test"]), + erlang:open_port({spawn_executable, Program}, [{args, Args}]). + +%% @doc Checks if process Pid exists, and if so, if its monitoring (or not) +%% the Port (or if port doesn't exist, we assume answer is no). +port_is_monitored(Pid, Port) when is_pid(Pid), is_port(Port) -> + %% Variant for when port is a port id (port()) + A = case erlang:process_info(Pid, monitors) of + undefined -> false; + {monitors, ProcMTargets} -> lists:member({port, Port}, ProcMTargets) + end, + B = case erlang:port_info(Port, monitored_by) of + undefined -> false; + {monitored_by, PortMonitors} -> lists:member(Pid, PortMonitors) + end, + {proc_monitors, A, port_monitored_by, B}; +port_is_monitored(Pid, PortName) when is_pid(Pid), is_atom(PortName) -> + %% Variant for when port is an atom + A = case erlang:process_info(Pid, monitors) of + undefined -> false; + {monitors, ProcMTargets} -> + lists:member({port, {PortName, node()}}, ProcMTargets) + end, + B = case erlang:whereis(PortName) of + undefined -> false; % name is not registered or is dead + PortId -> + case erlang:port_info(PortId, monitored_by) of + undefined -> false; % is dead + {monitored_by, PortMonitors} -> + lists:member(Pid, PortMonitors) + end + end, + {proc_monitors, A, port_monitored_by, B}. diff --git a/erts/emulator/test/port_SUITE_data/Makefile.src b/erts/emulator/test/port_SUITE_data/Makefile.src index ff822ae720..3a343e6d17 100644 --- a/erts/emulator/test/port_SUITE_data/Makefile.src +++ b/erts/emulator/test/port_SUITE_data/Makefile.src @@ -4,7 +4,7 @@ CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ CROSSLDFLAGS = @CROSSLDFLAGS@ PROGS = port_test@exe@ echo_args@exe@ dead_port@exe@ -DRIVERS = echo_drv@dll@ exit_drv@dll@ failure_drv@dll@ +DRIVERS = echo_drv@dll@ exit_drv@dll@ failure_drv@dll@ sleep_failure_drv@dll@ all: $(PROGS) $(DRIVERS) port_test.@EMULATOR@ @@ -20,6 +20,12 @@ echo_args@exe@: echo_args@obj@ echo_args@obj@: echo_args.c $(CC) -c -o echo_args@obj@ $(CFLAGS) echo_args.c +dead_port@exe@: dead_port@obj@ + $(LD) $(CROSSLDFLAGS) -o dead_port dead_port@obj@ @LIBS@ + +dead_port@obj@: dead_port.c + $(CC) -c -o dead_port@obj@ $(CFLAGS) dead_port.c + port_test.@EMULATOR@: port_test.erl @erl_name@ -compile port_test diff --git a/erts/emulator/test/port_SUITE_data/dead_port.c b/erts/emulator/test/port_SUITE_data/dead_port.c index ea91546b0c..26f09f33c7 100644 --- a/erts/emulator/test/port_SUITE_data/dead_port.c +++ b/erts/emulator/test/port_SUITE_data/dead_port.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. 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/. + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at * - * 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. + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * %CopyrightEnd% */ diff --git a/erts/emulator/test/port_SUITE_data/echo_drv.c b/erts/emulator/test/port_SUITE_data/echo_drv.c index 1d39c6a00c..b4370f6455 100644 --- a/erts/emulator/test/port_SUITE_data/echo_drv.c +++ b/erts/emulator/test/port_SUITE_data/echo_drv.c @@ -18,8 +18,11 @@ typedef struct _erl_drv_data EchoDrvData; static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command); static void echo_drv_stop(EchoDrvData *data_p); -static void echo_drv_output(ErlDrvData drv_data, char *buf, - ErlDrvSizeT len); +static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len); +static ErlDrvSSizeT echo_control(ErlDrvData drv_data, + unsigned int command, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen); +static void echo_outputv(ErlDrvData drv_data, ErlIOVec *ev); static void echo_drv_finish(void); static ErlDrvEntry echo_drv_entry = { @@ -32,9 +35,9 @@ static ErlDrvEntry echo_drv_entry = { "echo_drv", echo_drv_finish, NULL, /* handle */ - NULL, /* control */ + echo_control, /* control */ NULL, /* timeout */ - NULL, /* outputv */ + echo_outputv, /* outputv */ NULL, /* ready_async */ NULL, NULL, @@ -56,6 +59,14 @@ static ErlDrvEntry echo_drv_entry = { DRIVER_INIT(echo_drv) { + char buf[10]; + size_t bufsz = sizeof(buf); + char *use_outputv; + use_outputv = (erl_drv_getenv("ECHO_DRV_USE_OUTPUTV", buf, &bufsz) == 0 + ? buf + : "false"); + if (strcmp(use_outputv, "true") != 0) + echo_drv_entry.outputv = NULL; return &echo_drv_entry; } @@ -87,3 +98,15 @@ static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { static void echo_drv_finish() { } + +static ErlDrvSSizeT echo_control(ErlDrvData drv_data, + unsigned int command, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) +{ + return 0; +} + +static void echo_outputv(ErlDrvData drv_data, ErlIOVec *ev) +{ + return; +} diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c index 7abefab2e3..fa97b4c9d0 100644 --- a/erts/emulator/test/port_SUITE_data/port_test.c +++ b/erts/emulator/test/port_SUITE_data/port_test.c @@ -10,9 +10,11 @@ #include <sys/types.h> #include <sys/stat.h> #include <fcntl.h> +#include <ctype.h> #ifndef __WIN32__ #include <unistd.h> +#include <limits.h> #include <sys/time.h> @@ -32,14 +34,14 @@ exit(1); \ } -#define MAIN(argc, argv) main(argc, argv) +#define ASSERT(e) ((void) ((e) ? 1 : abort())) extern int errno; typedef struct { char* progname; /* Name of this program (from argv[0]). */ int header_size; /* Number of bytes in each packet header: - * 1, 2, or 4, or 0 for a continous byte stream. */ + * 1, 2, or 4, or 0 for a continuous byte stream. */ int fd_from_erl; /* File descriptor from Erlang. */ int fd_to_erl; /* File descriptor to Erlang. */ unsigned char* io_buf; /* Buffer for file i/o. */ @@ -48,6 +50,7 @@ typedef struct { * after reading the header for a packet * before reading the rest. */ + int fd_count; /* Count the number of open fds */ int break_mode; /* If set, this program will close standard * input, which should case broken pipe * error in the writer. @@ -103,11 +106,9 @@ int err; #endif -MAIN(argc, argv) -int argc; -char *argv[]; +int main(int argc, char *argv[]) { - int ret; + int ret, fd_count; if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) { fprintf(stderr, "Couldn't malloc for port_data"); exit(1); @@ -115,6 +116,7 @@ char *argv[]; port_data->header_size = 0; port_data->io_buf_size = 0; port_data->delay_mode = 0; + port_data->fd_count = 0; port_data->break_mode = 0; port_data->quit_mode = 0; port_data->slow_writes = 0; @@ -144,6 +146,9 @@ char *argv[]; case 'e': port_data->fd_to_erl = 2; break; + case 'f': + port_data->fd_count = 1; + break; case 'h': /* Header size for packets. */ switch (argv[1][2]) { case '0': port_data->header_size = 0; break; @@ -189,18 +194,31 @@ char *argv[]; /* XXX Add error printout here */ } + if (port_data->fd_count) { +#ifdef __WIN32__ + DWORD handles; + GetProcessHandleCount(GetCurrentProcess(), &handles); + fd_count = handles; +#else + int i; + for (i = 0, fd_count = 0; i < 1024; i++) + if (fcntl(i, F_GETFD) >= 0) { + fd_count++; + } +#endif + } + + if (port_data->output_file) + replace_stdout(port_data->output_file); + + if (port_data->fd_count) + reply(&fd_count, sizeof(fd_count)); + if (port_data->no_packet_loop){ free(port_data); exit(0); } - /* - * If an output file was given, let it replace standard output. - */ - - if (port_data->output_file) - replace_stdout(port_data->output_file); - ret = packet_loop(); if(port_data->io_buf_size > 0) free(port_data->io_buf); @@ -358,9 +376,11 @@ write_reply(buf, size) int size; /* Size of buffer to send. */ { int n; /* Temporary to hold size. */ + int rv; if (port_data->slow_writes <= 0) { /* Normal, "fast", write. */ - write(port_data->fd_to_erl, buf, size); + rv = write(port_data->fd_to_erl, buf, size); + ASSERT(rv == size); } else { /* * Write chunks with delays in between. @@ -368,7 +388,8 @@ write_reply(buf, size) while (size > 0) { n = size > port_data->slow_writes ? port_data->slow_writes : size; - write(port_data->fd_to_erl, buf, n); + rv = write(port_data->fd_to_erl, buf, n); + ASSERT(rv == n); size -= n; buf += n; if (size) @@ -539,7 +560,7 @@ char* spec; /* Specification for reply. */ buf = (char *) malloc(total_size); if (buf == NULL) { fprintf(stderr, "%s: insufficent memory for reply buffer of size %d\n", - port_data->progname, total_size); + port_data->progname, (int)total_size); exit(1); } diff --git a/erts/emulator/test/port_SUITE_data/port_test.erl b/erts/emulator/test/port_SUITE_data/port_test.erl index 56abfd5ded..406d376b26 100644 --- a/erts/emulator/test/port_SUITE_data/port_test.erl +++ b/erts/emulator/test/port_SUITE_data/port_test.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/port_SUITE_data/sleep_failure_drv.c b/erts/emulator/test/port_SUITE_data/sleep_failure_drv.c new file mode 100644 index 0000000000..1f52646572 --- /dev/null +++ b/erts/emulator/test/port_SUITE_data/sleep_failure_drv.c @@ -0,0 +1,76 @@ +#include <stdio.h> +#include "erl_driver.h" +#ifdef __WIN32__ +# include <windows.h> +#else +# include <unistd.h> +#endif + +typedef struct _erl_drv_data FailureDrvData; + +static FailureDrvData *failure_drv_start(ErlDrvPort, char *); +static void failure_drv_stop(FailureDrvData *); +static void failure_drv_output(ErlDrvData, char *, ErlDrvSizeT); +static void failure_drv_finish(void); + +static ErlDrvEntry failure_drv_entry = { + NULL, /* init */ + failure_drv_start, + failure_drv_stop, + failure_drv_output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "sleep_failure_drv", + NULL, /* finish */ + NULL, /* handle */ + NULL, /* control */ + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, + NULL, + NULL, +}; + + + +/* ------------------------------------------------------------------------- +** Entry functions +**/ + +DRIVER_INIT(failure_drv) +{ + return &failure_drv_entry; +} + +static FailureDrvData *failure_drv_start(ErlDrvPort port, char *command) { + void *void_ptr; + + return void_ptr = port; +} + +static void failure_drv_stop(FailureDrvData *data_p) { +} + +static void failure_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { + FailureDrvData *data_p = (FailureDrvData *) drv_data; + void *void_ptr; + ErlDrvPort port = void_ptr = data_p; + +#ifdef __WIN32__ + Sleep(3000); +#else + sleep(3); +#endif + driver_failure(port, 0); +} + +static void failure_drv_finish() { +} diff --git a/erts/emulator/test/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl index f439867e9c..e1e1ec9fb9 100644 --- a/erts/emulator/test/port_bif_SUITE.erl +++ b/erts/emulator/test/port_bif_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -20,20 +21,20 @@ -module(port_bif_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, command/1, +-export([all/0, suite/0, groups/0, + command/1, command_e_1/1, command_e_2/1, command_e_3/1, command_e_4/1, port_info1/1, port_info2/1, - port_info_os_pid/1, + port_info_os_pid/1, port_info_race/1, connect/1, control/1, echo_to_busy/1]). -export([do_command_e_1/1, do_command_e_2/1, do_command_e_4/1]). --export([init_per_testcase/2, end_per_testcase/2]). +-include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server.hrl"). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. all() -> [command, {group, port_info}, connect, control, @@ -42,28 +43,8 @@ all() -> groups() -> [{command_e, [], [command_e_1, command_e_2, command_e_3, command_e_4]}, - {port_info, [], [port_info1, port_info2, port_info_os_pid]}]. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - - -init_per_testcase(_Func, Config) when is_list(Config) -> - Dog=test_server:timetrap(test_server:minutes(10)), - [{watchdog, Dog}|Config]. -end_per_testcase(_Func, Config) when is_list(Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog). + {port_info, [], + [port_info1, port_info2, port_info_os_pid, port_info_race]}]. command(Config) when is_list(Config) -> load_control_drv(Config), @@ -85,17 +66,17 @@ do_command(P, Data) -> {P,{data,Data0}} -> case {list_to_binary(Data0),list_to_binary([Data])} of {B,B} -> ok; - _ -> test_server:fail({unexpected_data,Data0}) + _ -> ct:fail({unexpected_data,Data0}) end; Other -> - test_server:fail({unexpected_message,Other}) + ct:fail({unexpected_message,Other}) end. %% port_command/2: badarg 1st arg command_e_1(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Program = filename:join(DataDir, "port_test"), process_flag(trap_exit, true), @@ -104,9 +85,9 @@ command_e_1(Config) when is_list(Config) -> {'EXIT', Pid, {badarg, _}} when is_pid(Pid) -> ok; Other -> - test_server:fail(Other) + ct:fail(Other) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, ok. @@ -117,7 +98,7 @@ do_command_e_1(Program) -> %% port_command/2: badarg 2nd arg command_e_2(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Program = filename:join(DataDir, "port_test"), process_flag(trap_exit, true), @@ -126,9 +107,9 @@ command_e_2(Config) when is_list(Config) -> {'EXIT', Pid, {badarg, _}} when is_pid(Pid) -> ok; Other -> - test_server:fail(Other) + ct:fail(Other) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, ok. @@ -139,7 +120,7 @@ do_command_e_2(Program) -> %% port_command/2: Posix signals trapped command_e_3(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Program = filename:join(DataDir, "port_test"), process_flag(trap_exit, true), @@ -150,15 +131,15 @@ command_e_3(Config) when is_list(Config) -> {'EXIT', Port, einval} when is_port(Port) -> ok; Other -> - test_server:fail(Other) + ct:fail(Other) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, ok. %% port_command/2: Posix exit signals not trapped command_e_4(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Program = filename:join(DataDir, "port_test"), process_flag(trap_exit, true), @@ -167,9 +148,9 @@ command_e_4(Config) when is_list(Config) -> {'EXIT', Pid, {einval, _}} when is_pid(Pid) -> ok; Other -> - test_server:fail(Other) + ct:fail(Other) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, ok. @@ -246,7 +227,7 @@ do_port_info_os_pid() -> {os_pid, InfoOSPid} = erlang:port_info(P, os_pid), EchoPidStr = receive {P, {data, EchoPidStr0}} -> EchoPidStr0 - after 10000 -> test_server:fail(timeout) + after 10000 -> ct:fail(timeout) end, {ok, [EchoPid], []} = io_lib:fread("~u\n", EchoPidStr), {value,{os_pid, InfoOSPid}}=lists:keysearch(os_pid, 1, A), @@ -254,15 +235,36 @@ do_port_info_os_pid() -> true = erlang:port_close(P), ok. +port_info_race(Config) when is_list(Config) -> + DataDir = proplists:get_value(data_dir, Config), + Program = filename:join(DataDir, "port_test"), + Top = self(), + P1 = open_port({spawn,Program}, [{packet,1}]), + P2 = open_port({spawn,Program}, [{packet,1}]), + Info1 = erlang:port_info(P1), + Info2 = erlang:port_info(P2), + F = fun Loop(Port, _, 0) -> + Top ! {ok,Port}; + Loop(Port, Info, N) -> + Info = erlang:port_info(Port), + Loop(Port, Info, N - 1) + end, + spawn_link(fun () -> F(P1, Info1, 1000) end), + spawn_link(fun () -> F(P2, Info2, 1000) end), + receive {ok,P1} -> ok end, + receive {ok,P2} -> ok end, + true = erlang:port_close(P1), + true = erlang:port_close(P2), + ok. + output_test(_, _, Input, Output) when Output > 16#1fffffff -> io:format("~p bytes received\n", [Input]); output_test(P, Bin, Input0, Output0) -> erlang:port_command(P, Bin), receive - {P,{data,Bin}} -> ok; - Other -> - io:format("~p", [Other]), - ?t:fail() + {P,{data,Bin}} -> ok; + Other -> + ct:fail("~p", [Other]) end, Input = Input0 + size(Bin), Output = Output0 + size(Bin), @@ -272,8 +274,8 @@ output_test(P, Bin, Input0, Output0) -> %% We can't test much here, but hopefully a debug-built emulator will crasch %% if there is something wrong with the heap allocation. case erlang:statistics(io) of - {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> - ok + {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> + ok end, output_test(P, Bin, Input, Output). @@ -321,7 +323,7 @@ connect(Config) when is_list(Config) -> exit(P, you_should_die), receive {'EXIT',RecPid,you_should_die} -> ok; - Other -> ?line ?t:fail({bad_message,Other}) + Other -> ct:fail({bad_message,Other}) end, %% Done. @@ -386,7 +388,7 @@ test_op(P, Op) -> <<Op:32>> = list_to_binary(R). echo_to_busy(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), + ct:timetrap({seconds, 10}), load_control_drv(Config), P = open_port({spawn, control_drv}, []), erlang:port_control(P, $b, [1]), % Set to busy. @@ -398,11 +400,10 @@ echo_to_busy(Config) when is_list(Config) -> {Echoer, done} -> ok; {Echoer, Other} -> - test_server:fail(Other); + ct:fail(Other); Other -> - test_server:fail({unexpected_message, Other}) + ct:fail({unexpected_message, Other}) end, - test_server:timetrap_cancel(Dog), ok. echoer(P, ReplyTo) -> @@ -427,7 +428,7 @@ echo(P, Size) -> Packet = erlang:port_control(P, $e, [unaligned_sub_bin(Bin)]). load_control_drv(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), erl_ddll:start(), ok = load_driver(DataDir, "control_drv"). @@ -461,14 +462,7 @@ random_char(Chars) -> lists:nth(uniform(length(Chars)), Chars). uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = time(), - random:seed(X, Y, Z); - _ -> - ok - end, - random:uniform(N). + rand:uniform(N). unaligned_sub_bin(Bin0) -> Bin1 = <<0:3,Bin0/binary,31:5>>, diff --git a/erts/emulator/test/port_bif_SUITE_data/port_test.c b/erts/emulator/test/port_bif_SUITE_data/port_test.c index 28324a56a6..923ab99ccc 100644 --- a/erts/emulator/test/port_bif_SUITE_data/port_test.c +++ b/erts/emulator/test/port_bif_SUITE_data/port_test.c @@ -39,7 +39,7 @@ extern int errno; typedef struct { char* progname; /* Name of this program (from argv[0]). */ int header_size; /* Number of bytes in each packet header: - * 1, 2, or 4, or 0 for a continous byte stream. */ + * 1, 2, or 4, or 0 for a continuous byte stream. */ int fd_from_erl; /* File descriptor from Erlang. */ int fd_to_erl; /* File descriptor to Erlang. */ unsigned char* io_buf; /* Buffer for file i/o. */ diff --git a/erts/emulator/test/port_trace_SUITE.erl b/erts/emulator/test/port_trace_SUITE.erl new file mode 100644 index 0000000000..a1986397a8 --- /dev/null +++ b/erts/emulator/test/port_trace_SUITE.erl @@ -0,0 +1,645 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +-module(port_trace_SUITE). + +-export([all/0, suite/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2]). +-export([port_specs/1, ports/1, open_close/1, + command/1, control/1, connect/1, call/1, + output/1, output2/1, output_binary/1, + outputv/1, set_timer/1, failure_eof/1, + failure_atom/1, failure_posix/1, + failure/1, output_term/1, + driver_output_term/1, + send_term/1, driver_send_term/1, + driver_remote_send_term/1]). + +-define(ECHO_DRV_NOOP, 0). +-define(ECHO_DRV_OUTPUT, 1). +-define(ECHO_DRV_OUTPUT2, 2). +-define(ECHO_DRV_OUTPUT_BINARY, 3). +-define(ECHO_DRV_OUTPUTV, 4). +-define(ECHO_DRV_SET_TIMER, 5). +-define(ECHO_DRV_FAILURE_EOF, 6). +-define(ECHO_DRV_FAILURE_ATOM, 7). +-define(ECHO_DRV_FAILURE_POSIX, 8). +-define(ECHO_DRV_FAILURE, 9). +-define(ECHO_DRV_OUTPUT_TERM, 10). +-define(ECHO_DRV_DRIVER_OUTPUT_TERM, 11). +-define(ECHO_DRV_SEND_TERM, 12). +-define(ECHO_DRV_DRIVER_SEND_TERM, 13). +-define(ECHO_DRV_SAVE_CALLER, 14). +-define(ECHO_DRV_REMOTE_SEND_TERM, 15). + +suite() -> [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. + +all() -> + [port_specs, ports, open_close, + command, control, connect, call, + output, output2, output_binary, + outputv, set_timer, failure_eof, + failure_atom, failure_posix, + failure, output_term, + driver_output_term, + send_term, driver_send_term, + driver_remote_send_term]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + erlang:trace(all, false, [all]), + os:unsetenv("OUTPUTV"), + reload_drv(Config), + Config. + +end_per_testcase(_Func, _Config) -> + erlang:trace(all, false, [all]), + ok. + +%% Test the first argument of trace/3 +port_specs(_Config) -> + + S = self(), + + Tracer = fun F() -> + receive + stop -> + ok; + M -> + S ! M, + F() + end + end, + + Test = fun(TraceSpec, Info1, Info2) -> + {TracerPid,Ref} = spawn_monitor(Tracer), + Prt1 = erlang:open_port({spawn, echo_drv}, [binary]), + erlang:trace(TraceSpec, true, ['receive', {tracer, TracerPid}]), + %% We disable trace messages from the testcase process + erlang:trace(self(), false, ['receive']), + Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), + + InfoCheck = + fun(Info, Prt) -> + if + Info -> + {tracer, TracerPid} = erlang:trace_info(Prt, tracer), + {flags,['receive']} = erlang:trace_info(Prt, flags); + not Info -> + {tracer,[]} = erlang:trace_info(Prt, tracer), + {flags,[]} = erlang:trace_info(Prt, flags) + end + end, + InfoCheck(Info1, Prt1), + InfoCheck(Info2, Prt2), + + %% These may create trace messages + erlang:port_command(Prt1, <<?ECHO_DRV_NOOP>>), + erlang:port_command(Prt2, <<?ECHO_DRV_NOOP>>), + + %% Test what happens when the tracer dies + trace_delivered(), + TracerPid ! stop, + receive {'DOWN', Ref, process, TracerPid, normal} -> ok end, + + %% These should not generate any trace messages + erlang:port_command(Prt1, <<?ECHO_DRV_NOOP>>), + erlang:port_command(Prt2, <<?ECHO_DRV_NOOP>>), + + InfoCheck(false, Prt1), + InfoCheck(false, Prt2), + + erlang:port_close(Prt1), + erlang:port_close(Prt2), + erlang:trace(all, false, [all]), + {Prt1, Prt2} + end, + + {_Prt11, Prt12} = Test(new, false, true), + [{trace, Prt12, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt12), + + {_Prt21, Prt22} = Test(new_ports, false, true), + [{trace, Prt22, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt22), + + {Prt31, _Prt32} = Test(existing, true, false), + [{trace, Prt31, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt31), + + {Prt41, _Prt42} = Test(existing_ports, true, false), + [{trace, Prt41, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt41), + + {Prt51, Prt52} = Test(all, true, true), + [{trace, Prt51, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt51), + [{trace, Prt52, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt52), + + {Prt61, Prt62} = Test(ports, true, true), + [{trace, Prt61, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt61), + [{trace, Prt62, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt62), + + ok. + +%% Test that the 'ports' trace flag works +ports(_Config) -> + + {Prt, S} = trace_and_open([ports],[binary]), + + [{trace, Prt, open, S, echo_drv}, + {trace, Prt, getting_linked, S}] = flush(), + + register(?MODULE, Prt), + unregister(?MODULE), + register(?MODULE, Prt), + + [{trace,Prt,register,port_trace_SUITE}, + {trace,Prt,unregister,port_trace_SUITE}, + {trace,Prt,register,port_trace_SUITE}] = flush(), + + unlink(Prt), + link(Prt), + + [{trace,Prt,getting_unlinked,S}, + {trace,Prt,getting_linked,S}] = flush(), + + erlang:port_close(Prt), + + [{trace,Prt,closed,normal}, + {trace,Prt,unregister,port_trace_SUITE}, + {trace,Prt,unlink,S}] = flush(), + + ok. + +%% Test that port_close and ! close generate correct trace messages +open_close(_Config) -> + + S = trace_ports([send,'receive']), + + Prt = erlang:open_port({spawn, echo_drv}, [binary]), + erlang:port_close(Prt), + [{trace, Prt, 'receive', {S, close}}] = flush(), + + Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), + Prt2 ! {S, close}, + recv({Prt2, closed}), + [{trace, Prt2, 'receive', {S, close}}, + {trace, Prt2, send, closed, S}] = flush(), + + catch erlang:port_close(Prt2), + [] = flush(), + + ok. + +%% Test that port_command and ! command generate correct trace messages +command(Config) -> + + Flags = [send,'receive'], + S = trace_ports(Flags), + Prt = erlang:open_port({spawn, echo_drv}, [binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_NOOP:8>>), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8>>}}}] = flush(), + + erlang:port_command(Prt, [?ECHO_DRV_NOOP, <<0:8>>]), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8,0:8>>}}}] = flush(), + + Prt ! {S, {command, <<?ECHO_DRV_NOOP:8>>}}, + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8>>}}}] = flush(), + + OutputMsg = <<?ECHO_DRV_NOOP:8,0:(8*512)>>, + Prt ! {S, {command, OutputMsg}}, + [{trace, Prt, 'receive', {S, {command, OutputMsg}}}] = flush(), + + close(Prt, Flags), + + os:putenv("OUTPUTV","true"), + reload_drv(Config), + + Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), + OutputvMsg = [<<0:8>>,<<0:(8*512)>>,<<0:(8*256)>>,<<0:8>>], + + erlang:port_command(Prt2, OutputvMsg), + [{trace, Prt2, 'receive', {S, {command, OutputvMsg}}}] = flush(), + + Prt2 ! {S, {command, OutputvMsg}}, + [{trace, Prt2, 'receive', {S, {command, OutputvMsg}}}] = flush(), + + close(Prt2, Flags), + + os:unsetenv("OUTPUTV"), + + ok. + +%% Test that port_control generate correct trace messages +control(_Config) -> + + Flags = [send,'receive'], + {Prt, S} = trace_and_open(Flags,[binary]), + + [0] = erlang:port_control(Prt, 1, <<?ECHO_DRV_NOOP:8, 0:8>>), + [{trace, Prt, 'receive', {S, {control, {1, <<?ECHO_DRV_NOOP:8, 0:8>>}}}}, + {trace, Prt, send, {Prt, {control, <<0:8>>}}, S}] = flush(), + + [0] = erlang:port_control(Prt, (1 bsl 32) - 1, <<?ECHO_DRV_NOOP:8, 0:8>>), + [{trace, Prt, 'receive', {S, {control, {(1 bsl 32) - 1, <<?ECHO_DRV_NOOP:8, 0:8>>}}}}, + {trace, Prt, send, {Prt, {control, <<0:8>>}}, S}] = flush(), + + Msg = <<?ECHO_DRV_NOOP:8, 0:(8*512)>>, + Pat = lists:duplicate(512, 0), + Pat = erlang:port_control(Prt, 1, Msg), + [{trace, Prt, 'receive', {S, {control, {1, Msg}}}}, + {trace, Prt, send, {Prt, {control, <<0:(8*512)>>}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that port_connect and ! connect generate correct trace messages +%% This includes that the proper getting_linked messages are sent +connect(_Config) -> + + + {Prt, S} = trace_and_open([send, 'receive', ports],[binary]), + + flush(), + + {Pid,Ref} = spawn_monitor( + fun() -> + receive + go -> + Prt ! {self(), {connect, S}}, + receive {Prt, connected} -> unlink(Prt) end + end + end), + erlang:trace(Pid, true, [send, 'receive', procs]), + + erlang:port_connect(Prt, Pid), + unlink(Prt), + + [{trace,Prt,getting_linked,Pid}, + {trace,Prt,'receive',{S,{connect,Pid}}}, + {trace,Prt,send,{Prt,connected},S}, + {trace,Prt,getting_unlinked, S}] = flush(Prt), + + [{trace,Pid,getting_linked,Prt}] = flush(), + + Pid ! go, + recv({'DOWN',Ref,process,Pid,normal}), + + [{trace,Prt,'receive',{Pid,{connect,S}}}, + {trace,Prt,send,{Prt,connected},Pid}, + {trace,Prt,getting_unlinked,Pid}] = flush(Prt), + + [{trace,Pid,'receive',go}, + {trace,Pid,send,{Pid,{connect,S}}, Prt}, + {trace,Pid,'receive',{Prt,connected}}, + {trace,Pid,unlink,Prt}, + {trace,Pid,exit,normal}] = flush(), + + erlang:port_close(Prt), + [{trace, Prt, 'receive', {S, close}}, + {trace, Prt, closed, normal}] = flush(), + ok. + +%% Test that port_call generate correct trace messages +call(_Config) -> + + Flags = [send,'receive'], + {Prt, S} = trace_and_open(Flags,[binary]), + + Test = fun(Msg) -> + BinMsg = term_to_binary(Msg), + + Msg = erlang:port_call(Prt, 0, Msg), + [{trace, Prt, 'receive', {S, {call, {0, BinMsg}}}}, + {trace, Prt, send, {Prt, {call, BinMsg}}, S}] = flush() + end, + + Test({hello, world, make_ref()}), + Test({hello, world, lists:seq(1,1000)}), + + close(Prt, Flags), + + ok. + +%% Test that driver_output generate correct trace messages +output(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT, 123456:32>>), + recv({Prt,{data,<<123456:32>>}}), + + [{trace, Prt, send, {Prt, {data, <<123456:32>>}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_output2 generate correct trace messages +output2(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT2, 123456:32>>), + recv({Prt,{data,[$a|<<123456:32>>]}}), + [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_output_binary generate correct trace messages +output_binary(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT_BINARY, 0, 123456:32>>), + recv({Prt,{data,[$a|<<123456:32>>]}}), + [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_outputv generate correct trace messages +outputv(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUTV, 123456:32>>), + recv({Prt,{data,[$a|<<123456:32>>]}}), + + [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(), + + erlang:port_close(Prt), + [] = flush(), + + ok. + +%% Test that driver_set_timer generate correct trace messages +set_timer(_Config) -> + + Flags = [send,'receive'], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_SET_TIMER>>), + timer:sleep(100), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_SET_TIMER>>}}}, + {trace, Prt, 'receive', timeout}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_failure* generate correct trace messages +failure_eof(_Config) -> + + Flags = [send,'receive', ports], + S = trace_ports(Flags), + + Prt = erlang:open_port({spawn, echo_drv}, [eof, binary]), + [{trace, Prt, open, S, echo_drv}, + {trace, Prt, getting_linked, S}] = flush(), + + erlang:port_command(Prt, <<?ECHO_DRV_FAILURE_EOF>>), + recv({Prt,eof}), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_FAILURE_EOF>>}}}, + {trace, Prt, send, {Prt, eof}, S}] = flush(), + + close(Prt, Flags), + + %% Run same test without eof option + failure_test(<<?ECHO_DRV_FAILURE_EOF>>, normal). + +failure_atom(_Config) -> + failure_test(<<?ECHO_DRV_FAILURE_ATOM, "failure\0">>, failure). +failure_posix(_Config) -> + failure_test(<<?ECHO_DRV_FAILURE_POSIX>>, eagain). +failure(_Config) -> + failure_test(<<?ECHO_DRV_FAILURE, 1>>, 1). + +failure_test(Failure, Reason) -> + + {Prt, S} = trace_and_open([send, 'receive', ports],[binary]), + + [{trace, Prt, open, S, echo_drv}, + {trace, Prt, getting_linked, S}] = flush(), + + process_flag(trap_exit, true), + erlang:port_command(Prt, Failure), + try + recv({'EXIT',Prt,Reason}) + after + process_flag(trap_exit, false) + end, + [{trace, Prt, 'receive', {S, {command, Failure}}}, + {trace, Prt, closed, Reason}, + {trace, Prt, unlink, S}] = flush(), + + ok. + +%% Test that erl_drv_output_term generate correct trace messages +output_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_output_term generate correct trace messages +driver_output_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_DRIVER_OUTPUT_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that erl_drv_send_term generate correct trace messages +send_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + {Pid, Ref} = spawn_monitor(fun() -> erlang:port_command(Prt, <<?ECHO_DRV_SAVE_CALLER>>) end), + recv({'DOWN',Ref,process,Pid,normal}), + erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>), + [{trace, Prt, send_to_non_existing_process, {echo, Prt, <<123456:32>>}, Pid}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_send_term generate correct trace messages +driver_send_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_DRIVER_SEND_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + {Pid, Ref} = spawn_monitor(fun() -> erlang:port_command(Prt, <<?ECHO_DRV_SAVE_CALLER>>) end), + recv({'DOWN',Ref,process,Pid,normal}), + erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>), + [{trace, Prt, send_to_non_existing_process, {echo, Prt, <<123456:32>>}, Pid}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_send_term from non-scheduler thread does not +%% generate trace messages. +driver_remote_send_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_REMOTE_SEND_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [] = flush(), + + Pid = spawn_link( + fun() -> + erlang:port_command(Prt, <<?ECHO_DRV_SAVE_CALLER>>), + S ! ok, + receive M -> S ! M end + end), + recv(ok), + erlang:trace(Pid, true, ['receive']), + + erlang:port_command(Prt, <<?ECHO_DRV_REMOTE_SEND_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Pid, 'receive', {echo, Prt, <<123456:32>>}}] = flush(), + + close(Prt, Flags), + + ok. + +%%%%%%%%%%%%%%%%%%% +%% Helper functions +%%%%%%%%%%%%%%%%%%% + +trace_ports(TraceFlags) -> + erlang:trace(new_ports, true, TraceFlags), + self(). + +trace_and_open(TraceFlags, OpenFlags) -> + S = self(), + Ports = proplists:get_value(ports, TraceFlags), + [trace_ports(TraceFlags) || Ports], + Prt = erlang:open_port({spawn, echo_drv}, OpenFlags), + [erlang:trace(Prt, true, TraceFlags) || Ports == undefined], + {Prt, S}. + +close(Prt, Flags) -> + Recv = proplists:get_value('receive', Flags), + Ports = proplists:get_value(ports, Flags), + S = self(), + + erlang:port_close(Prt), + + if Recv, Ports -> + [{trace, Prt, 'receive', {S, close}}, + {trace, Prt, closed, normal}, + {trace, Prt, unlink, S}] = flush(); + Recv -> + [{trace, Prt, 'receive', {S, close}}] = flush(); + Ports -> + [{trace, Prt, closed, normal}, + {trace, Prt, unlink, S}] = flush(); + true -> + [] = flush() + end. + +trace_delivered() -> + Ref = erlang:trace_delivered(all), + receive {trace_delivered, all, Ref} -> ok end. + +flush() -> + flush(all). +flush(From) -> + trace_delivered(), + f(From). + +f(From) -> + receive + M when From =:= all; element(2, M) == From -> + [M | f(From)] + after 0 -> + [] + end. + +recv(Msg) -> + receive Msg -> ok after 1000 -> ct:fail({did_not_get_data,Msg,flush()}) end. + +load_drv(Config) -> + Path = proplists:get_value(data_dir, Config), + case erl_ddll:load_driver(Path, echo_drv) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + ct:fail(Res) + end. + +reload_drv(Config) -> + erl_ddll:unload_driver(echo_drv), + load_drv(Config). diff --git a/erts/emulator/test/port_trace_SUITE_data/Makefile.src b/erts/emulator/test/port_trace_SUITE_data/Makefile.src new file mode 100644 index 0000000000..c1bf142ccf --- /dev/null +++ b/erts/emulator/test/port_trace_SUITE_data/Makefile.src @@ -0,0 +1,3 @@ +all: echo_drv@dll@ + +@SHLIB_RULES@ diff --git a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..20ec33a594 --- /dev/null +++ b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c @@ -0,0 +1,296 @@ +#include <stdio.h> +#include "erl_driver.h" +#include <errno.h> +#include <string.h> +#include <assert.h> + + +/* ------------------------------------------------------------------------- +** Data types +**/ + +struct my_thread { + struct my_thread* next; + ErlDrvTid tid; +}; + +typedef struct _erl_drv_data { + ErlDrvPort erlang_port; + ErlDrvTermData caller; + struct my_thread* threads; +} EchoDrvData; + +struct remote_send_term { + struct my_thread thread; + ErlDrvTermData port; + ErlDrvTermData caller; + int len; + char buf[1]; /* buf[len] */ +}; + +#define ECHO_DRV_NOOP 0 +#define ECHO_DRV_OUTPUT 1 +#define ECHO_DRV_OUTPUT2 2 +#define ECHO_DRV_OUTPUT_BINARY 3 +#define ECHO_DRV_OUTPUTV 4 +#define ECHO_DRV_SET_TIMER 5 +#define ECHO_DRV_FAILURE_EOF 6 +#define ECHO_DRV_FAILURE_ATOM 7 +#define ECHO_DRV_FAILURE_POSIX 8 +#define ECHO_DRV_FAILURE 9 +#define ECHO_DRV_OUTPUT_TERM 10 +#define ECHO_DRV_DRIVER_OUTPUT_TERM 11 +#define ECHO_DRV_SEND_TERM 12 +#define ECHO_DRV_DRIVER_SEND_TERM 13 +#define ECHO_DRV_SAVE_CALLER 14 +#define ECHO_DRV_REMOTE_SEND_TERM 15 + + +/* ------------------------------------------------------------------------- +** Entry struct +**/ + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command); +static void echo_drv_stop(ErlDrvData drv_data); +static void echo_drv_output(ErlDrvData drv_data, char *buf, + ErlDrvSizeT len); +static void echo_drv_outputv(ErlDrvData drv_data, ErlIOVec *iov); +static void echo_drv_finish(void); +static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen); +static void echo_drv_timeout(ErlDrvData drv_data); +static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags); + +static ErlDrvEntry echo_drv_entry = { + NULL, /* init */ + echo_drv_start, + echo_drv_stop, + echo_drv_output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "echo_drv", + echo_drv_finish, + NULL, /* handle */ + echo_drv_control, + echo_drv_timeout, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + echo_drv_call, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, + NULL, + NULL +}; + +static void* send_term_thread(void *); + +/* ------------------------------------------------------------------------- +** Entry functions +**/ + +DRIVER_INIT(echo_drv) +{ + char buff[5]; + size_t size = sizeof(buff); + + if (erl_drv_getenv("OUTPUTV", buff, &size) == -1) { + echo_drv_entry.outputv = NULL; + } else { + echo_drv_entry.outputv = echo_drv_outputv; + } + + return &echo_drv_entry; +} + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command) +{ + EchoDrvData *echo_drv_data_p = driver_alloc(sizeof(EchoDrvData)); + echo_drv_data_p->erlang_port = port; + echo_drv_data_p->caller = driver_caller(port); + echo_drv_data_p->threads = NULL; + return echo_drv_data_p; +} + +static void echo_drv_stop(EchoDrvData *data_p) +{ + struct my_thread* thr = data_p->threads; + + while (thr) { + struct my_thread* next = thr->next; + void* exit_value; + int ret = erl_drv_thread_join(thr->tid, &exit_value); + assert(ret == 0 && exit_value == NULL); + driver_free(thr); + thr = next; + } + driver_free(data_p); +} + +static void echo_drv_outputv(ErlDrvData drv_data, ErlIOVec *iov) +{ + return; +} + +static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { + EchoDrvData* data_p = (EchoDrvData *) drv_data; + ErlDrvPort port = data_p->erlang_port; + + switch (buf[0]) { + case ECHO_DRV_OUTPUT: + { + driver_output(port, buf+1, len-1); + break; + } + case ECHO_DRV_OUTPUT2: + { + driver_output2(port, "a", 1, buf+1, len-1); + break; + } + case ECHO_DRV_OUTPUT_BINARY: + { + ErlDrvBinary *bin = driver_alloc_binary(len-1); + memcpy(&bin->orig_bytes, buf+1, len-1); + driver_output_binary(port, "a", 1, bin, 1, len - 2); + driver_free_binary(bin); + break; + } + case ECHO_DRV_OUTPUTV: + { + ErlIOVec iov; + ErlDrvSizeT sz; + driver_enq(port, buf + 1, len - 1); + sz = driver_peekqv(port, &iov); + driver_outputv(port, "a", 1, &iov, 0); + driver_deq(port, sz); + break; + } + case ECHO_DRV_SET_TIMER: + { + driver_set_timer(port, 10); + break; + } + case ECHO_DRV_FAILURE_EOF: + { + driver_failure_eof(port); + break; + } + case ECHO_DRV_FAILURE_ATOM: + { + driver_failure_atom(port, buf+1); + break; + } + case ECHO_DRV_FAILURE_POSIX: + { + driver_failure_posix(port, EAGAIN); + break; + } + case ECHO_DRV_FAILURE: + { + driver_failure(port, buf[1]); + break; + } + case ECHO_DRV_OUTPUT_TERM: + case ECHO_DRV_DRIVER_OUTPUT_TERM: + case ECHO_DRV_SEND_TERM: + case ECHO_DRV_DRIVER_SEND_TERM: + { + ErlDrvTermData term[] = { + ERL_DRV_ATOM, driver_mk_atom("echo"), + ERL_DRV_PORT, driver_mk_port(port), + ERL_DRV_BUF2BINARY, (ErlDrvTermData)(buf+1), + (ErlDrvTermData)(len - 1), + ERL_DRV_TUPLE, 3}; + switch (buf[0]) { + case ECHO_DRV_OUTPUT_TERM: + erl_drv_output_term(driver_mk_port(port), term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + case ECHO_DRV_DRIVER_OUTPUT_TERM: + driver_output_term(port, term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + case ECHO_DRV_SEND_TERM: + driver_send_term(port, data_p->caller, + term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + case ECHO_DRV_DRIVER_SEND_TERM: + erl_drv_send_term(driver_mk_port(port), data_p->caller, + term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + } + break; + } + case ECHO_DRV_REMOTE_SEND_TERM: + { + struct remote_send_term *t = driver_alloc(sizeof(struct remote_send_term) + len); + t->len = len-1; + t->port = driver_mk_port(port); + t->caller = data_p->caller; + memcpy(t->buf, buf+1, t->len); + erl_drv_thread_create("tmp_thread", &t->thread.tid, send_term_thread, t, NULL); + t->thread.next = data_p->threads; + data_p->threads = &t->thread; + break; + } + case ECHO_DRV_SAVE_CALLER: + data_p->caller = driver_caller(port); + break; + default: + break; + } +} + +static void echo_drv_finish() { + +} + +static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) +{ + if ((len - 1) > rlen) + *rbuf = driver_alloc(len - 1); + memcpy(*rbuf, buf+1, len-1); + return len-1; +} + +static void echo_drv_timeout(ErlDrvData drv_data) +{ + +} + +static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags) +{ + if ((len - command) > rlen) + *rbuf = driver_alloc(len - command); + memcpy(*rbuf, buf+command, len-command); + return len-command; +} + +static void* send_term_thread(void *a) +{ + struct remote_send_term *t = (struct remote_send_term*)a; + ErlDrvTermData term[] = { + ERL_DRV_ATOM, driver_mk_atom("echo"), + ERL_DRV_PORT, t->port, + ERL_DRV_BUF2BINARY, (ErlDrvTermData)(t->buf), + (ErlDrvTermData)(t->len), + ERL_DRV_TUPLE, 3}; + erl_drv_send_term(t->port, t->caller, + term, sizeof(term) / sizeof(ErlDrvTermData)); + return NULL; +} diff --git a/erts/emulator/test/prim_eval_SUITE.erl b/erts/emulator/test/prim_eval_SUITE.erl new file mode 100644 index 0000000000..3f4965f96d --- /dev/null +++ b/erts/emulator/test/prim_eval_SUITE.erl @@ -0,0 +1,78 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(prim_eval_SUITE). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2, + init_per_group/2, end_per_group/2]). + +-export(['ERL-365'/1]). + +init_per_testcase(_Case, Config) -> + Config. + +end_per_testcase(_Case, _Config) -> + ok. + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +all() -> + ['ERL-365']. + +'ERL-365'(Config) when is_list(Config) -> + %% def_arg_reg[0] is used for storage of timeout instruction + %% when a 'receive after' is executed. When a process was + %% scheduled out inside prim_eval:'receive'/0 due to a function + %% call, def_arg_reg[0] was overwritten due to storage of live + %% registers. + P = spawn_link(fun () -> + prim_eval:'receive'(fun (_M) -> + erlang:bump_reductions((1 bsl 27)-1), + id(true), + nomatch + end, + 200) + end), + receive after 100 -> ok end, + P ! {wont, match}, + receive after 200 -> ok end, + ok. + + + +id(X) -> + X. diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 932d0f87f1..a8bcfac84d 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -25,7 +26,7 @@ %% process_info/1,2 %% register/2 (partially) --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(heap_binary_size, 64). @@ -40,11 +41,12 @@ process_info_2_list/1, process_info_lock_reschedule/1, process_info_lock_reschedule2/1, process_info_lock_reschedule3/1, + process_info_garbage_collection/1, bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1, process_status_exiting/1, otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1, process_info_messages/1, process_flag_badarg/1, process_flag_heap_size/1, - spawn_opt_heap_size/1, + spawn_opt_heap_size/1, spawn_opt_max_heap_size/1, processes_large_tab/1, processes_default_tab/1, processes_small_tab/1, processes_this_tab/1, processes_apply_trap/1, processes_last_call_trap/1, processes_gc_trap/1, @@ -58,14 +60,16 @@ system_task_on_suspended/1, gc_request_when_gc_disabled/1, gc_request_blast_when_gc_disabled/1]). --export([prio_server/2, prio_client/2]). +-export([prio_server/2, prio_client/2, init/1, handle_event/2]). -export([init_per_testcase/2, end_per_testcase/2]). -export([hangaround/2, processes_bif_test/0, do_processes/1, processes_term_proc_list_test/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 9}}]. all() -> [spawn_with_binaries, t_exit_1, {group, t_exit_2}, @@ -74,11 +78,14 @@ all() -> process_info_other_dist_msg, process_info_2_list, process_info_lock_reschedule, process_info_lock_reschedule2, - process_info_lock_reschedule3, process_status_exiting, + process_info_lock_reschedule3, + process_info_garbage_collection, + process_status_exiting, bump_reductions, low_prio, yield, yield2, otp_4725, bad_register, garbage_collect, process_info_messages, process_flag_badarg, process_flag_heap_size, - spawn_opt_heap_size, otp_6237, {group, processes_bif}, + spawn_opt_heap_size, spawn_opt_max_heap_size, otp_6237, + {group, processes_bif}, {group, otp_7738}, garb_other_running, {group, system_task}]. @@ -112,7 +119,7 @@ init_per_suite(Config) -> [{started_apps, A}|Config]. end_per_suite(Config) -> - As = ?config(started_apps, Config), + As = proplists:get_value(started_apps, Config), lists:foreach(fun (A) -> application:stop(A) end, As), catch erts_debug:set_internal_state(available_internal_state, false), Config. @@ -124,12 +131,15 @@ end_per_group(_GroupName, Config) -> Config. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(10)), - [{watchdog, Dog},{testcase, Func}|Config]. + [{testcase, Func}|Config]. end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). + %% Restore max_heap_size to default value. + erlang:system_flag(max_heap_size, + #{size => 0, + kill => true, + error_logger => true}), + ok. fun_spawn(Fun) -> spawn_link(erlang, apply, [Fun, []]). @@ -142,7 +152,7 @@ spawn_with_binaries(Config) when is_list(Config) -> TwoMeg = lists:duplicate(1024, L), Fun = fun() -> spawn(?MODULE, binary_owner, [list_to_binary(TwoMeg)]), receive after 1 -> ok end end, - Iter = case test_server:purify_is_running() of + Iter = case test_server:is_valgrind() of true -> 10; false -> 150 end, @@ -154,11 +164,10 @@ binary_owner(Bin) when is_binary(Bin) -> %% Tests exit/1 with a big message. t_exit_1(Config) when is_list(Config) -> + ct:timetrap({seconds, 20}), start_spawner(), - Dog = test_server:timetrap(test_server:seconds(20)), process_flag(trap_exit, true), test_server:do_times(10, fun t_exit_1/0), - test_server:timetrap_cancel(Dog), stop_spawner(), ok. @@ -172,11 +181,10 @@ t_exit_1() -> %% Tests exit/2 with a lot of data in the exit message. t_exit_2_other(Config) when is_list(Config) -> + ct:timetrap({seconds, 20}), start_spawner(), - Dog = test_server:timetrap(test_server:seconds(20)), process_flag(trap_exit, true), test_server:do_times(10, fun t_exit_2_other/0), - test_server:timetrap_cancel(Dog), stop_spawner(), ok. @@ -190,34 +198,32 @@ t_exit_2_other() -> %% Tests that exit(Pid, normal) does not kill another process.; t_exit_2_other_normal(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(20)), + ct:timetrap({seconds, 20}), process_flag(trap_exit, true), Pid = fun_spawn(fun() -> receive x -> ok end end), exit(Pid, normal), receive {'EXIT', Pid, Reason} -> - test_server:fail({process_died, Reason}) + ct:fail({process_died, Reason}) after 1000 -> ok end, case process_info(Pid) of undefined -> - test_server:fail(process_died_on_normal); + ct:fail(process_died_on_normal); List when is_list(List) -> ok end, exit(Pid, kill), - test_server:timetrap_cancel(Dog), ok. %% Tests that we can trap an exit message sent with exit/2 from %% the same process. self_exit(Config) when is_list(Config) -> + ct:timetrap({seconds, 10}), start_spawner(), - Dog = test_server:timetrap(test_server:seconds(10)), process_flag(trap_exit, true), test_server:do_times(200, fun self_exit/0), - test_server:timetrap_cancel(Dog), stop_spawner(), ok. @@ -236,7 +242,7 @@ normal_suicide_exit(Config) when is_list(Config) -> Pid = fun_spawn(fun() -> exit(self(), normal) end), receive {'EXIT', Pid, normal} -> ok; - Other -> test_server:fail({bad_message, Other}) + Other -> ct:fail({bad_message, Other}) end. %% Tests exit(self(), Term) is equivalent to exit(Term) for a process @@ -247,7 +253,7 @@ abnormal_suicide_exit(Config) when is_list(Config) -> Pid = fun_spawn(fun() -> exit(self(), Garbage) end), receive {'EXIT', Pid, Garbage} -> ok; - Other -> test_server:fail({bad_message, Other}) + Other -> ct:fail({bad_message, Other}) end. %% Tests that exit(self(), die) cannot be catched. @@ -256,21 +262,20 @@ t_exit_2_catch(Config) when is_list(Config) -> Pid = fun_spawn(fun() -> catch exit(self(), die) end), receive {'EXIT', Pid, normal} -> - test_server:fail(catch_worked); + ct:fail(catch_worked); {'EXIT', Pid, die} -> ok; Other -> - test_server:fail({bad_message, Other}) + ct:fail({bad_message, Other}) end. %% Tests trapping of an 'EXIT' message generated by a bad argument to %% the abs/1 bif. The 'EXIT' message will intentionally be very big. trap_exit_badarg(Config) when is_list(Config) -> + ct:timetrap({seconds, 10}), start_spawner(), - Dog = test_server:timetrap(test_server:seconds(10)), process_flag(trap_exit, true), test_server:do_times(10, fun trap_exit_badarg/0), - test_server:timetrap_cancel(Dog), stop_spawner(), ok. @@ -284,7 +289,7 @@ trap_exit_badarg() -> ok; Other -> ok = io:format("Bad EXIT message: ~P", [Other, 30]), - test_server:fail(bad_exit_message) + ct:fail(bad_exit_message) end. bad_guy(Arg) -> @@ -316,10 +321,9 @@ big_binary(N, Acc) -> %% Test receiving an EXIT message when spawning a BIF with bad arguments. trap_exit_badarg_in_bif(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), + ct:timetrap({seconds, 10}), process_flag(trap_exit, true), test_server:do_times(10, fun trap_exit_badarg_bif/0), - test_server:timetrap_cancel(Dog), ok. trap_exit_badarg_bif() -> @@ -328,7 +332,7 @@ trap_exit_badarg_bif() -> {'EXIT', Pid, {badarg, _}} -> ok; Other -> - test_server:fail({unexpected, Other}) + ct:fail({unexpected, Other}) end. %% The following sequences of events have crasched Beam. @@ -341,15 +345,13 @@ trap_exit_badarg_bif() -> %% 3) The process will crash the next time it executes 'receive'. exit_and_timeout(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(20)), + ct:timetrap({seconds, 20}), process_flag(trap_exit, true), Parent = self(), Low = fun_spawn(fun() -> eat_low(Parent) end), High = fun_spawn(fun() -> eat_high(Low) end), eat_wait_for(Low, High), - - test_server:timetrap_cancel(Dog), ok. @@ -360,7 +362,7 @@ eat_wait_for(Low, High) -> {'EXIT', High, normal} -> eat_wait_for(Low, High); Other -> - test_server:fail({bad_message, Other}) + ct:fail({bad_message, Other}) end. eat_low(_Parent) -> @@ -379,29 +381,26 @@ eat_high(Low) -> process_flag(priority, high), receive after 1000 -> ok end, exit(Low, {you, are, dead}), - {_, Sec, _} = now(), - loop(Sec, Sec). + loop(erlang:monotonic_time() + erlang:convert_time_unit(5,second,native)). %% Busy loop for 5 seconds. -loop(OrigSec, CurrentSec) when CurrentSec < OrigSec+5 -> - {_, NewSec, _} = now(), - loop(OrigSec, NewSec); -loop(_, _) -> - ok. +loop(StopTime) -> + case StopTime >= erlang:monotonic_time() of + true -> ok; + false -> loop(StopTime) + end. %% Tries to send two different exit messages to a process. %% (The second one should be ignored.) exit_twice(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(20)), + ct:timetrap({seconds, 20}), process_flag(trap_exit, true), Low = fun_spawn(fun etwice_low/0), High = fun_spawn(fun() -> etwice_high(Low) end), etwice_wait_for(Low, High), - - test_server:timetrap_cancel(Dog), ok. etwice_wait_for(Low, High) -> @@ -409,11 +408,11 @@ etwice_wait_for(Low, High) -> {'EXIT', Low, first} -> ok; {'EXIT', Low, Other} -> - test_server:fail({wrong_exit_reason, Other}); + ct:fail({wrong_exit_reason, Other}); {'EXIT', High, normal} -> etwice_wait_for(Low, High); Other -> - test_server:fail({bad_message, Other}) + ct:fail({bad_message, Other}) end. etwice_low() -> @@ -432,6 +431,8 @@ t_process_info(Config) when is_list(Config) -> {status, running} = process_info(self(), status), {min_heap_size, 233} = process_info(self(), min_heap_size), {min_bin_vheap_size,46422} = process_info(self(), min_bin_vheap_size), + {max_heap_size, #{ size := 0, kill := true, error_logger := true}} = + process_info(self(), max_heap_size), {current_function,{?MODULE,t_process_info,1}} = process_info(self(), current_function), {current_function,{?MODULE,t_process_info,1}} = @@ -445,11 +446,22 @@ t_process_info(Config) when is_list(Config) -> verify_loc(Line2, Res2), pi_stacktrace([{?MODULE,t_process_info,1,?LINE}]), + verify_stacktrace_depth(), + Gleader = group_leader(), {group_leader, Gleader} = process_info(self(), group_leader), {'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')), ok. +verify_stacktrace_depth() -> + CS = current_stacktrace, + OldDepth = erlang:system_flag(backtrace_depth, 0), + {CS,[]} = erlang:process_info(self(), CS), + _ = erlang:system_flag(backtrace_depth, 8), + {CS,[{?MODULE,verify_stacktrace_depth,0,_},_|_]} = + erlang:process_info(self(), CS), + _ = erlang:system_flag(backtrace_depth, OldDepth). + pi_stacktrace(Expected0) -> {Line,Res} = {?LINE,erlang:process_info(self(), current_stacktrace)}, {current_stacktrace,Stack} = Res, @@ -571,6 +583,8 @@ process_info_other_msg(Config) when is_list(Config) -> {min_heap_size, 233} = process_info(Pid, min_heap_size), {min_bin_vheap_size, 46422} = process_info(Pid, min_bin_vheap_size), + {max_heap_size, #{ size := 0, kill := true, error_logger := true}} = + process_info(self(), max_heap_size), Pid ! stop, ok. @@ -666,12 +680,8 @@ chk_pi_order([],[]) -> chk_pi_order([{Arg, _}| Values], [Arg|Args]) -> chk_pi_order(Values, Args). -process_info_2_list(doc) -> - []; -process_info_2_list(suite) -> - []; process_info_2_list(Config) when is_list(Config) -> - Proc = spawn(fun () -> receive after infinity -> ok end end), + Proc = spawn_link(fun () -> receive after infinity -> ok end end), register(process_SUITE_process_info_2_list1, self()), register(process_SUITE_process_info_2_list2, Proc), erts_debug:set_internal_state(available_internal_state,true), @@ -702,10 +712,6 @@ process_info_2_list(Config) when is_list(Config) -> lists:foreach(fun ({backtrace, _}) -> ok end, V3), ok. -process_info_lock_reschedule(doc) -> - []; -process_info_lock_reschedule(suite) -> - []; process_info_lock_reschedule(Config) when is_list(Config) -> %% We need a process that is running and an item that requires %% process_info to take the main process lock. @@ -738,7 +744,7 @@ process_info_lock_reschedule(Config) when is_list(Config) -> exit(Target2, bang), OkStatus; {status, BadStatus} -> - ?t:fail(BadStatus) + ct:fail(BadStatus) end. pi_loop(_Name, _Pid, 0) -> @@ -747,10 +753,6 @@ pi_loop(Name, Pid, N) -> {registered_name, Name} = process_info(Pid, registered_name), pi_loop(Name, Pid, N-1). -process_info_lock_reschedule2(doc) -> - []; -process_info_lock_reschedule2(suite) -> - []; process_info_lock_reschedule2(Config) when is_list(Config) -> Parent = self(), Fun = fun () -> @@ -806,10 +808,6 @@ do_pi_msg_len(PT, AT) -> lists:map(fun (_) -> ok end, [a,b,c,d]), {message_queue_len, _} = process_info(element(2,PT), element(2,AT)). -process_info_lock_reschedule3(doc) -> - []; -process_info_lock_reschedule3(suite) -> - []; process_info_lock_reschedule3(Config) when is_list(Config) -> %% We need a process that is running and an item that requires %% process_info to take the main process lock. @@ -840,7 +838,7 @@ process_info_lock_reschedule3(Config) when is_list(Config) -> exit(Target2, bang), OkStatus; {status, BadStatus} -> - ?t:fail(BadStatus) + ct:fail(BadStatus) end. process_status_exiting(Config) when is_list(Config) -> @@ -932,6 +930,73 @@ start_spawner() -> stop_spawner() -> ok. +%% Tests erlang:process_info(Pid, garbage_collection_info) +process_info_garbage_collection(_Config) -> + Parent = self(), + Pid = spawn_link( + fun() -> + %% We set mqd to off_heap and send an tuple + %% to process in order to force mbuf_size + %% to be used + process_flag(message_queue_data, off_heap), + receive go -> ok end, + (fun F(0) -> + Parent ! deep, + receive {ok,_} -> ok end, + []; + F(N) -> + timer:sleep(1), + [lists:seq(1,100) | F(N-1)] + end)(1000), + Parent ! shallow, + receive done -> ok end + end), + [{garbage_collection_info, Before},{total_heap_size, THSBefore}] = + erlang:process_info(Pid, [garbage_collection_info, total_heap_size]), + Pid ! go, receive deep -> ok end, + [{_, Deep},{_,THSDeep}] = + erlang:process_info(Pid, [garbage_collection_info, total_heap_size]), + Pid ! {ok, make_ref()}, receive shallow -> ok end, + [{_, After},{_, THSAfter}] = + erlang:process_info(Pid, [garbage_collection_info, total_heap_size]), + Pid ! done, + + %% Do some general checks to see if everything seems to be roughly correct + ct:log("Before: ~p",[Before]), + ct:log("Deep: ~p",[Deep]), + ct:log("After: ~p",[After]), + ct:log("Before THS: ~p",[THSBefore]), + ct:log("Deep THS: ~p",[THSDeep]), + ct:log("After THS: ~p",[THSAfter]), + + %% Check stack_size + true = gv(stack_size, Before) < gv(stack_size, Deep), + true = gv(stack_size, After) < gv(stack_size, Deep), + + %% Check used heap size + true = gv(heap_size, Before) + gv(old_heap_size, Before) + < gv(heap_size, Deep) + gv(old_heap_size, Deep), + true = gv(heap_size, Before) + gv(old_heap_size, Before) + < gv(heap_size, After) + gv(old_heap_size, After), + + %% Check that total_heap_size == heap_block_size + old_heap_block_size + mbuf_size + THSBefore = gv(heap_block_size, Before) + + gv(old_heap_block_size, Before) + + gv(mbuf_size, Before), + + THSDeep = gv(heap_block_size, Deep) + + gv(old_heap_block_size, Deep) + + gv(mbuf_size, Deep), + + THSAfter = gv(heap_block_size, After) + + gv(old_heap_block_size, After) + + gv(mbuf_size, After), + + ok. + +gv(Key,List) -> + proplists:get_value(Key,List). + %% Tests erlang:bump_reductions/1. bump_reductions(Config) when is_list(Config) -> erlang:garbage_collect(), @@ -942,10 +1007,10 @@ bump_reductions(Config) when is_list(Config) -> case R2-R1 of Diff when Diff < 100 -> ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), - test_server:fail({small_diff, Diff}); + ct:fail({small_diff, Diff}); Diff when Diff > 110 -> ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), - test_server:fail({big_diff, Diff}); + ct:fail({big_diff, Diff}); Diff -> io:format("~p\n", [Diff]), ok @@ -968,36 +1033,48 @@ bump_big(Prev, Limit) -> %% Priority 'low' should be mixed with 'normal' using a factor of %% about 8. (OTP-2644) low_prio(Config) when is_list(Config) -> - case erlang:system_info(schedulers_online) of - 1 -> - ok = low_prio_test(Config); - _ -> - erlang:system_flag(multi_scheduling, block), - ok = low_prio_test(Config), - erlang:system_flag(multi_scheduling, unblock), - {comment, - "Test not written for SMP runtime system. " - "Multi scheduling blocked during test."} - end. + erlang:system_flag(multi_scheduling, block_normal), + Prop = low_prio_test(Config), + erlang:system_flag(multi_scheduling, unblock_normal), + Str = lists:flatten(io_lib:format("Low/high proportion is ~.3f", + [Prop])), + {comment,Str}. low_prio_test(Config) when is_list(Config) -> process_flag(trap_exit, true), - S = spawn_link(?MODULE, prio_server, [0, 0]), + + %% Spawn the server running with high priority. The server must + %% not run at normal priority as that would skew the results for + %% two reasons: + %% + %% 1. There would be one more normal-priority processes than + %% low-priority processes. + %% + %% 2. The receive queue would grow faster than the server process + %% could process it. That would in turn trigger the reduction + %% punishment for the clients. + S = spawn_opt(?MODULE, prio_server, [0, 0], [link,{priority,high}]), + + %% Spawn the clients and let them run for a while. PCs = spawn_prio_clients(S, erlang:system_info(schedulers_online)), - timer:sleep(2000), + ct:sleep({seconds,2}), lists:foreach(fun (P) -> exit(P, kill) end, PCs), + + %% Stop the server and retrieve the result. S ! exit, - receive {'EXIT', S, {A, B}} -> check_prio(A, B) end, - ok. + receive + {'EXIT', S, {A, B}} -> + check_prio(A, B) + end. check_prio(A, B) -> Prop = A/B, ok = io:format("Low=~p, High=~p, Prop=~p\n", [A, B, Prop]), - %% It isn't 1/8, it's more like 0.3, but let's check that - %% the low-prio processes get some little chance to run at all. - true = (Prop < 1.0), - true = (Prop > 1/32). + %% Prop is expected to be appr. 1/8. Allow a reasonable margin. + true = Prop < 1/4, + true = Prop > 1/16, + Prop. prio_server(A, B) -> receive @@ -1032,8 +1109,7 @@ make_unaligned_sub_binary(Bin0) -> <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), Bin. -yield(doc) -> - "Tests erlang:yield/1."; +%% Tests erlang:yield/1 yield(Config) when is_list(Config) -> case catch erlang:system_info(modified_timing_level) of Level when is_integer(Level) -> @@ -1042,9 +1118,9 @@ yield(Config) when is_list(Config) -> ++ ") is enabled. Testcase gets messed up by modfied " "timing."}; _ -> - MS = erlang:system_flag(multi_scheduling, block), + MS = erlang:system_flag(multi_scheduling, block_normal), yield_test(), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), case MS of blocked -> {comment, @@ -1074,7 +1150,7 @@ yield_test() -> {Diff, _} -> ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w", [R1, R2, Schedcnt]), - test_server:fail({measurement_error, Diff, Schedcnt}) + ct:fail({measurement_error, Diff, Schedcnt}) end. call_yield() -> @@ -1111,8 +1187,6 @@ schedcnt(stop, {Ref, Pid}) when is_reference(Ref), is_pid(Pid) -> Cnt end. -yield2(doc) -> []; -yield2(suite) -> []; yield2(Config) when is_list(Config) -> Me = self(), Go = make_ref(), @@ -1163,7 +1237,7 @@ yield2(Config) when is_list(Config) -> io:format("Reductions = ~p~n", [Reductions]), ok; {RedDiff, Reductions} -> - ?t:fail({unexpected_reduction_count, Reductions}) + ct:fail({unexpected_reduction_count, Reductions}) end, none = next_tmsg(P), @@ -1204,8 +1278,6 @@ fail_register(Name, Process) -> {'EXIT',{badarg,_}} = (catch Name ! anything_goes), ok. -garbage_collect(doc) -> []; -garbage_collect(suite) -> []; garbage_collect(Config) when is_list(Config) -> Prio = process_flag(priority, high), true = erlang:garbage_collect(), @@ -1244,10 +1316,7 @@ garbage_collect(Config) when is_list(Config) -> process_flag(priority, Prio), ok. -process_info_messages(doc) -> - ["This used to cause the nofrag emulator to dump core"]; -process_info_messages(suite) -> - []; +%% This used to cause the nofrag emulator to dump core process_info_messages(Config) when is_list(Config) -> process_info_messages_test(), ok. @@ -1305,10 +1374,6 @@ process_info_messages_test() -> chk_badarg(Fun) -> try Fun(), exit(no_badarg) catch error:badarg -> ok end. -process_flag_badarg(doc) -> - []; -process_flag_badarg(suite) -> - []; process_flag_badarg(Config) when is_list(Config) -> chk_badarg(fun () -> process_flag(gurka, banan) end), chk_badarg(fun () -> process_flag(trap_exit, gurka) end), @@ -1316,6 +1381,28 @@ process_flag_badarg(Config) when is_list(Config) -> chk_badarg(fun () -> process_flag(min_heap_size, gurka) end), chk_badarg(fun () -> process_flag(min_bin_vheap_size, gurka) end), chk_badarg(fun () -> process_flag(min_bin_vheap_size, -1) end), + + chk_badarg(fun () -> process_flag(max_heap_size, gurka) end), + chk_badarg(fun () -> process_flag(max_heap_size, -1) end), + chk_badarg(fun () -> + {_,Min} = process_info(self(), min_heap_size), + process_flag(max_heap_size, Min - 1) + end), + chk_badarg(fun () -> + {_,Min} = process_info(self(), min_heap_size), + process_flag(max_heap_size, #{size => Min - 1}) + end), + chk_badarg(fun () -> process_flag(max_heap_size, #{}) end), + chk_badarg(fun () -> process_flag(max_heap_size, #{ kill => true }) end), + chk_badarg(fun () -> process_flag(max_heap_size, #{ size => 233, + kill => gurka }) end), + chk_badarg(fun () -> process_flag(max_heap_size, #{ size => 233, + error_logger => gurka }) end), + chk_badarg(fun () -> process_flag(max_heap_size, #{ size => 233, + kill => true, + error_logger => gurka }) end), + chk_badarg(fun () -> process_flag(max_heap_size, #{ size => 1 bsl 64 }) end), + chk_badarg(fun () -> process_flag(priority, 4711) end), chk_badarg(fun () -> process_flag(save_calls, hmmm) end), P= spawn_link(fun () -> receive die -> ok end end), @@ -1326,8 +1413,6 @@ process_flag_badarg(Config) when is_list(Config) -> -include_lib("stdlib/include/ms_transform.hrl"). -otp_6237(doc) -> []; -otp_6237(suite) -> []; otp_6237(Config) when is_list(Config) -> Slctrs = lists:map(fun (_) -> spawn_link(fun () -> @@ -1394,10 +1479,6 @@ otp_6237_select_loop() -> conses_per_red, debug_level}). -processes_large_tab(doc) -> - []; -processes_large_tab(suite) -> - []; processes_large_tab(Config) when is_list(Config) -> sys_mem_cond_run(2048, fun () -> processes_large_tab_test(Config) end). @@ -1425,7 +1506,7 @@ processes_large_tab_test(Config) -> #ptab_list_bif_info{debug_level = Lvl} when Lvl > MaxDbgLvl -> 20; #ptab_list_bif_info{debug_level = Lvl} when Lvl < 0 -> - ?t:fail({debug_level, Lvl}); + ct:fail({debug_level, Lvl}); #ptab_list_bif_info{debug_level = Lvl} -> Lvl end, @@ -1443,15 +1524,11 @@ processes_large_tab_test(Config) -> [processes_bif_info]) of #ptab_list_bif_info{tab_chunks = Chunks} when is_integer(Chunks), Chunks > 1 -> ok; - PBInfo -> ?t:fail(PBInfo) + PBInfo -> ct:fail(PBInfo) end, stop_node(LargeNode), chk_processes_bif_test_res(Res). -processes_default_tab(doc) -> - []; -processes_default_tab(suite) -> - []; processes_default_tab(Config) when is_list(Config) -> sys_mem_cond_run(1024, fun () -> processes_default_tab_test(Config) end). @@ -1461,10 +1538,6 @@ processes_default_tab_test(Config) -> stop_node(DefaultNode), chk_processes_bif_test_res(Res). -processes_small_tab(doc) -> - []; -processes_small_tab(suite) -> - []; processes_small_tab(Config) when is_list(Config) -> {ok, SmallNode} = start_node(Config, "+P 1024"), Res = rpc:call(SmallNode, ?MODULE, processes_bif_test, []), @@ -1473,16 +1546,20 @@ processes_small_tab(Config) when is_list(Config) -> true = PBInfo#ptab_list_bif_info.tab_chunks < 10, chk_processes_bif_test_res(Res). -processes_this_tab(doc) -> - []; -processes_this_tab(suite) -> - []; processes_this_tab(Config) when is_list(Config) -> - sys_mem_cond_run(1024, fun () -> chk_processes_bif_test_res(processes_bif_test()) end). + Mem = case {erlang:system_info(build_type), + erlang:system_info(allocator)} of + {lcnt, {_, _Vsn, [sys_alloc], _Opts}} -> + %% When running +Mea min + lcnt we may need more memory + 1024 * 4; + _ -> + 1024 + end, + sys_mem_cond_run(Mem, fun () -> chk_processes_bif_test_res(processes_bif_test()) end). chk_processes_bif_test_res(ok) -> ok; chk_processes_bif_test_res({comment, _} = Comment) -> Comment; -chk_processes_bif_test_res(Failure) -> ?t:fail(Failure). +chk_processes_bif_test_res(Failure) -> ct:fail(Failure). print_processes_bif_info(#ptab_list_bif_info{min_start_reds = MinStartReds, tab_chunks = TabChunks, @@ -1493,7 +1570,7 @@ print_processes_bif_info(#ptab_list_bif_info{min_start_reds = MinStartReds, term_procs_max_reds = TPMaxReds, conses_per_red = ConsesPerRed, debug_level = DbgLvl}) -> - ?t:format("processes/0 bif info on node ~p:~n" + io:format("processes/0 bif info on node ~p:~n" "Min start reductions = ~p~n" "Process table chunks = ~p~n" "Process table chunks size = ~p~n" @@ -1534,7 +1611,7 @@ processes_unexpected_result(CorrectProcs, Procs) -> status, priority], MissingProcs = CorrectProcs -- Procs, - ?t:format("Missing processes: ~p", + io:format("Missing processes: ~p", [lists:map(fun (Pid) -> [{pid, Pid} | case process_info(Pid, ProcInfo) of @@ -1544,7 +1621,7 @@ processes_unexpected_result(CorrectProcs, Procs) -> end, MissingProcs)]), SuperfluousProcs = Procs -- CorrectProcs, - ?t:format("Superfluous processes: ~p", + io:format("Superfluous processes: ~p", [lists:map(fun (Pid) -> [{pid, Pid} | case process_info(Pid, ProcInfo) of @@ -1553,7 +1630,7 @@ processes_unexpected_result(CorrectProcs, Procs) -> end] end, SuperfluousProcs)]), - ?t:fail(unexpected_result). + ct:fail(unexpected_result). hangaround(Cleaner, Type) -> %% Type is only used to distinguish different processes from @@ -1566,6 +1643,7 @@ spawn_initial_hangarounds(_Cleaner, NP, Max, Len, HAs) when NP > Max -> {Len, HAs}; spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) -> Skip = 30, + wait_for_proc_slots(Skip+3), HA1 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], [{priority, low}]), HA2 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], @@ -1575,6 +1653,15 @@ spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) -> spawn_drop(Skip), spawn_initial_hangarounds(Cleaner, NP+Skip, Max, Len+3, [HA1,HA2,HA3|HAs]). +wait_for_proc_slots(MinFreeSlots) -> + case erlang:system_info(process_limit) - erlang:system_info(process_count) of + FreeSlots when FreeSlots < MinFreeSlots -> + receive after 10 -> ok end, + wait_for_proc_slots(MinFreeSlots); + _FreeSlots -> + ok + end. + spawn_drop(N) when N =< 0 -> ok; spawn_drop(N) -> @@ -1613,7 +1700,7 @@ processes_bif_test() -> true -> %% Do it again with a process suspended while %% in the processes/0 bif. - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Suspendee = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), @@ -1626,7 +1713,7 @@ processes_bif_test() -> end), receive {suspend_me, Suspendee} -> ok end, erlang:suspend_process(Suspendee), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), [{status,suspended},{current_function,{erlang,ptab_list_continue,2}}] = process_info(Suspendee, [status, current_function]), @@ -1658,7 +1745,7 @@ do_processes_bif_test(WantReds, DieTest, Processes) -> DoIt = make_ref(), GetGoing = make_ref(), {NoTestProcs, TestProcs} = spawn_initial_hangarounds(Cleaner), - ?t:format("Testing with ~p processes~n", [NoTestProcs]), + io:format("Testing with ~p processes~n", [NoTestProcs]), SpawnHangAround = fun () -> spawn(?MODULE, hangaround, [Cleaner, new_hangaround]) end, @@ -1666,10 +1753,10 @@ do_processes_bif_test(WantReds, DieTest, Processes) -> Splt = NoTestProcs div 10, {TP1, TP23} = lists:split(Splt, TestProcs), {TP2, TP3} = lists:split(Splt, TP23), - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Tester ! DoIt, receive GetGoing -> ok end, - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), SpawnProcesses(high), lists:foreach( fun (P) -> SpawnHangAround(), @@ -1700,7 +1787,7 @@ do_processes_bif_test(WantReds, DieTest, Processes) -> Procs = lists:sort(Procs0), CorrectProcs = lists:sort(CorrectProcs0), LengthCorrectProcs = length(CorrectProcs), - ?t:format("~p = length(CorrectProcs)~n", [LengthCorrectProcs]), + io:format("~p = length(CorrectProcs)~n", [LengthCorrectProcs]), true = LengthCorrectProcs > NoTestProcs, case CorrectProcs =:= Procs of true -> @@ -1721,12 +1808,12 @@ do_processes_bif_test(WantReds, DieTest, Processes) -> do_processes_bif_die_test(false, _Processes) -> - ?t:format("Skipping test killing process executing processes/0~n",[]), + io:format("Skipping test killing process executing processes/0~n",[]), ok; do_processes_bif_die_test(true, Processes) -> do_processes_bif_die_test(5, Processes); do_processes_bif_die_test(N, Processes) -> - ?t:format("Doing test killing process executing processes/0~n",[]), + io:format("Doing test killing process executing processes/0~n",[]), try Tester = self(), Oooh_Nooooooo = make_ref(), @@ -1776,8 +1863,8 @@ do_processes_bif_die_test(N, Processes) -> ok catch throw:{kill_in_trap, R} when N > 0 -> - ?t:format("Failed to kill in trap: ~p~n", [R]), - ?t:format("Trying again~n", []), + io:format("Failed to kill in trap: ~p~n", [R]), + io:format("Trying again~n", []), do_processes_bif_die_test(N-1, Processes) end. @@ -1807,7 +1894,7 @@ wait_until_system_recover(Tmr) -> receive {timeout, Tmr, _} -> Comment = "WARNING: Test processes still hanging around!", - ?t:format("~s~n", [Comment]), + io:format("~s~n", [Comment]), put(processes_bif_testcase_comment, Comment), lists:foreach( fun (P) when P == self() -> @@ -1815,7 +1902,7 @@ wait_until_system_recover(Tmr) -> (P) -> case process_info(P, initial_call) of {initial_call,{?MODULE, _, _} = MFA} -> - ?t:format("~p ~p~n", [P, MFA]); + io:format("~p ~p~n", [P, MFA]); {initial_call,{_, _, _}} -> ok; undefined -> @@ -1831,10 +1918,6 @@ wait_until_system_recover(Tmr) -> receive {timeout, Tmr, _} -> ok after 0 -> ok end, ok. -processes_last_call_trap(doc) -> - []; -processes_last_call_trap(suite) -> - []; processes_last_call_trap(Config) when is_list(Config) -> enable_internal_state(), Processes = fun () -> processes() end, @@ -1857,10 +1940,6 @@ processes_last_call_trap(Config) when is_list(Config) -> my_processes() -> processes(). -processes_apply_trap(doc) -> - []; -processes_apply_trap(suite) -> - []; processes_apply_trap(Config) when is_list(Config) -> enable_internal_state(), PBInfo = erts_debug:get_internal_state(processes_bif_info), @@ -1875,10 +1954,6 @@ processes_apply_trap(Config) when is_list(Config) -> apply(erlang, processes, []) end, lists:seq(1,100)). -processes_gc_trap(doc) -> - []; -processes_gc_trap(suite) -> - []; processes_gc_trap(Config) when is_list(Config) -> Tester = self(), enable_internal_state(), @@ -1890,7 +1965,7 @@ processes_gc_trap(Config) when is_list(Config) -> processes() end, - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Suspendee = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), @@ -1900,7 +1975,7 @@ processes_gc_trap(Config) when is_list(Config) -> end), receive {suspend_me, Suspendee} -> ok end, erlang:suspend_process(Suspendee), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), [{status,suspended}, {current_function,{erlang,ptab_list_continue,2}}] = process_info(Suspendee, [status, current_function]), @@ -1917,10 +1992,6 @@ processes_gc_trap(Config) when is_list(Config) -> exit(Suspendee, bang), ok. -process_flag_heap_size(doc) -> - []; -process_flag_heap_size(suite) -> - []; process_flag_heap_size(Config) when is_list(Config) -> HSize = 2586, % must be gc fib+ number VHSize = 318187, % must be gc fib+ number @@ -1932,10 +2003,6 @@ process_flag_heap_size(Config) when is_list(Config) -> VHSize = erlang:process_flag(min_bin_vheap_size, OldVHmin), ok. -spawn_opt_heap_size(doc) -> - []; -spawn_opt_heap_size(suite) -> - []; spawn_opt_heap_size(Config) when is_list(Config) -> HSize = 987, % must be gc fib+ number VHSize = 46422, % must be gc fib+ number @@ -1946,10 +2013,122 @@ spawn_opt_heap_size(Config) when is_list(Config) -> Pid ! stop, ok. -processes_term_proc_list(doc) -> - []; -processes_term_proc_list(suite) -> - []; +spawn_opt_max_heap_size(_Config) -> + + error_logger:add_report_handler(?MODULE, self()), + + %% Test that numerical limit works + max_heap_size_test(1024, 1024, true, true), + + %% Test that map limit works + max_heap_size_test(#{ size => 1024 }, 1024, true, true), + + %% Test that no kill is sent + max_heap_size_test(#{ size => 1024, kill => false }, 1024, false, true), + + %% Test that no error_logger report is sent + max_heap_size_test(#{ size => 1024, error_logger => false }, 1024, true, false), + + %% Test that system_flag works + erlang:system_flag(max_heap_size, #{ size => 0, kill => false, + error_logger => true}), + max_heap_size_test(#{ size => 1024 }, 1024, false, true), + max_heap_size_test(#{ size => 1024, kill => true }, 1024, true, true), + + erlang:system_flag(max_heap_size, #{ size => 0, kill => true, + error_logger => false}), + max_heap_size_test(#{ size => 1024 }, 1024, true, false), + max_heap_size_test(#{ size => 1024, error_logger => true }, 1024, true, true), + + erlang:system_flag(max_heap_size, #{ size => 1 bsl 20, kill => true, + error_logger => true}), + max_heap_size_test(#{ }, 1 bsl 20, true, true), + + erlang:system_flag(max_heap_size, #{ size => 0, kill => true, + error_logger => true}), + + %% Test that ordinary case works as expected again + max_heap_size_test(1024, 1024, true, true), + + ok. + +max_heap_size_test(Option, Size, Kill, ErrorLogger) + when map_size(Option) == 0 -> + max_heap_size_test([], Size, Kill, ErrorLogger); +max_heap_size_test(Option, Size, Kill, ErrorLogger) + when is_map(Option); is_integer(Option) -> + max_heap_size_test([{max_heap_size, Option}], Size, Kill, ErrorLogger); +max_heap_size_test(Option, Size, Kill, ErrorLogger) -> + OomFun = fun F() -> timer:sleep(5),[lists:seq(1,1000)|F()] end, + Pid = spawn_opt(OomFun, Option), + {max_heap_size, MHSz} = erlang:process_info(Pid, max_heap_size), + ct:log("Default: ~p~nOption: ~p~nProc: ~p~n", + [erlang:system_info(max_heap_size), Option, MHSz]), + + #{ size := Size} = MHSz, + + Ref = erlang:monitor(process, Pid), + if Kill -> + receive + {'DOWN', Ref, process, Pid, killed} -> + ok + end; + true -> + ok + end, + if ErrorLogger -> + receive + %% There must be at least one error message. + {error, _, {emulator, _, [Pid|_]}} -> + ok + end; + true -> + ok + end, + if not Kill -> + exit(Pid, die), + receive + {'DOWN', Ref, process, Pid, die} -> + ok + end, + %% If the process was not killed, the limit may have + %% been reached more than once and there may be + %% more {error, ...} messages left. + receive_error_messages(Pid); + true -> + ok + end, + + %% Make sure that there are no unexpected messages. + receive_unexpected(). + +receive_error_messages(Pid) -> + receive + {error, _, {emulator, _, [Pid|_]}} -> + receive_error_messages(Pid) + after 1000 -> + ok + end. + +receive_unexpected() -> + receive + {info_report, _, _} -> + %% May be an alarm message from os_mon. Ignore. + receive_unexpected(); + M -> + ct:fail({unexpected_message, M}) + after 10 -> + ok + end. + +%% error_logger report handler proxy +init(Pid) -> + {ok, Pid}. + +handle_event(Event, Pid) -> + Pid ! Event, + {ok, Pid}. + processes_term_proc_list(Config) when is_list(Config) -> Tester = self(), as_expected = processes_term_proc_list_test(false), @@ -2015,7 +2194,7 @@ processes_term_proc_list_test(MustChk) -> end) end, SpawnSuspendProcessesProc = fun () -> - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), P = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), @@ -2025,7 +2204,7 @@ processes_term_proc_list_test(MustChk) -> end), receive {suspend_me, P} -> ok end, erlang:suspend_process(P), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), [{status,suspended}, {current_function,{erlang,ptab_list_continue,2}}] = process_info(P, [status, current_function]), @@ -2086,7 +2265,7 @@ processes_term_proc_list_test(MustChk) -> S8 = SpawnSuspendProcessesProc(), ?CHK_TERM_PROC_LIST(MustChk, 7), - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Exit(S8), ?CHK_TERM_PROC_LIST(MustChk, 7), Exit(S5), @@ -2095,28 +2274,16 @@ processes_term_proc_list_test(MustChk) -> ?CHK_TERM_PROC_LIST(MustChk, 6), Exit(S6), ?CHK_TERM_PROC_LIST(MustChk, 0), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), as_expected. -otp_7738_waiting(doc) -> - []; -otp_7738_waiting(suite) -> - []; otp_7738_waiting(Config) when is_list(Config) -> otp_7738_test(waiting). -otp_7738_suspended(doc) -> - []; -otp_7738_suspended(suite) -> - []; otp_7738_suspended(Config) when is_list(Config) -> otp_7738_test(suspended). -otp_7738_resume(doc) -> - []; -otp_7738_resume(suite) -> - []; otp_7738_resume(Config) when is_list(Config) -> otp_7738_test(resume). @@ -2185,8 +2352,8 @@ do_otp_7738_test(Type) -> ok after 2000 -> I = process_info(R, [status, message_queue_len]), - ?t:format("~p~n", [I]), - ?t:fail(no_progress) + io:format("~p~n", [I]), + ct:fail(no_progress) end, ok. @@ -2263,7 +2430,7 @@ no_priority_inversion2(Config) when is_list(Config) -> [{priority, max}, monitor, link]) end, lists:seq(1, 2*erlang:system_info(schedulers))), - receive after 500 -> ok end, + receive after 2000 -> ok end, {PL, ML} = spawn_opt(fun () -> tok_loop() end, @@ -2273,7 +2440,7 @@ no_priority_inversion2(Config) when is_list(Config) -> RH = request_gc(PL, high), receive {garbage_collect, _, _} -> - ?t:fail(unexpected_gc) + ct:fail(unexpected_gc) after 1000 -> ok end, @@ -2315,7 +2482,7 @@ no_priority_inversion2(Config) when is_list(Config) -> request_gc(Pid, Prio) -> Ref = make_ref(), - erts_internal:request_system_task(Pid, Prio, {garbage_collect, Ref}), + erts_internal:request_system_task(Pid, Prio, {garbage_collect, Ref, major}), Ref. system_task_blast(Config) when is_list(Config) -> @@ -2390,7 +2557,7 @@ gc_request_when_gc_disabled_do(ReqIdType) -> async = garbage_collect(P, [{async, ReqId}]), receive {garbage_collect, ReqId, Result} -> - ?t:fail({unexpected_gc, Result}); + ct:fail({unexpected_gc, Result}); {P, gc_state, true} -> ok end, @@ -2457,20 +2624,17 @@ start_node(Config) -> start_node(Config, Args) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) + ++ atom_to_list(proplists:get_value(testcase, Config)) ++ "-" - ++ integer_to_list(B) + ++ integer_to_list(erlang:system_time(second)) ++ "-" - ++ integer_to_list(C)), - ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). enable_internal_state() -> case catch erts_debug:get_internal_state(available_internal_state) of @@ -2478,7 +2642,10 @@ enable_internal_state() -> _ -> erts_debug:set_internal_state(available_internal_state, true) end. -sys_mem_cond_run(ReqSizeMB, TestFun) when is_integer(ReqSizeMB) -> +sys_mem_cond_run(OrigReqSizeMB, TestFun) when is_integer(OrigReqSizeMB) -> + %% Debug normally needs more memory, so double the requirement + Debug = erlang:system_info(debug_compiled), + ReqSizeMB = if Debug -> OrigReqSizeMB * 2; true -> OrigReqSizeMB end, case total_memory() of TotMem when is_integer(TotMem), TotMem >= ReqSizeMB -> TestFun(); diff --git a/erts/emulator/test/pseudoknot_SUITE.erl b/erts/emulator/test/pseudoknot_SUITE.erl index 5a7cdcecd5..ed4d40ac65 100644 --- a/erts/emulator/test/pseudoknot_SUITE.erl +++ b/erts/emulator/test/pseudoknot_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/random_iolist.erl b/erts/emulator/test/random_iolist.erl index 8f21b5a3b3..555f063e0a 100644 --- a/erts/emulator/test/random_iolist.erl +++ b/erts/emulator/test/random_iolist.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -35,7 +36,7 @@ run2(Iter,Fun1,Fun2) -> compare2(Iter,Fun1,Fun2). random_byte() -> - random:uniform(256) - 1. + rand:uniform(256) - 1. random_list(0,Acc) -> Acc; @@ -44,7 +45,7 @@ random_list(N,Acc) -> random_binary(N) -> B = list_to_binary(random_list(N,[])), - case {random:uniform(2),size(B)} of + case {rand:uniform(2),size(B)} of {2,M} when M > 1 -> S = M-1, <<_:3,C:S/binary,_:5>> = B, @@ -56,7 +57,7 @@ random_list(N) -> random_list(N,[]). front() -> - case random:uniform(10) of + case rand:uniform(10) of 10 -> false; _ -> @@ -64,7 +65,7 @@ front() -> end. any_type() -> - case random:uniform(10) of + case rand:uniform(10) of 1 -> list; 2 -> @@ -76,7 +77,7 @@ any_type() -> end. tail_type() -> - case random:uniform(5) of + case rand:uniform(5) of 1 -> list; 2 -> @@ -89,9 +90,9 @@ random_length(N) -> UpperLimit = 255, case N of M when M > UpperLimit -> - random:uniform(UpperLimit+1) - 1; + rand:uniform(UpperLimit+1) - 1; _ -> - random:uniform(N+1) - 1 + rand:uniform(N+1) - 1 end. random_iolist(0,Acc) -> @@ -138,7 +139,7 @@ random_iolist(N) -> standard_seed() -> - random:seed(1201,855653,380975). + rand:seed(exsplus, {1201,855653,380975}). do_comp(List,F1,F2) -> X = F1(List), diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl index 2e7ac1f50c..a12019ec83 100644 --- a/erts/emulator/test/receive_SUITE.erl +++ b/erts/emulator/test/receive_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,65 +22,57 @@ %% Tests receive after. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, call_with_huge_message_queue/1,receive_in_between/1]). --export([init_per_testcase/2,end_per_testcase/2]). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [call_with_huge_message_queue, receive_in_between]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - call_with_huge_message_queue(Config) when is_list(Config) -> Pid = spawn_link(fun echo_loop/0), - - {Time,ok} = tc(fun() -> calls(10, Pid) end), - - [self() ! {msg,N} || N <- lists:seq(1, 500000)], + _WarmUpTime = time_calls(Pid), + Time = time_calls(Pid), + _ = [self() ! {msg,N} || N <- lists:seq(1, 500000)], + io:format("Time for empty message queue: ~p", [Time]), erlang:garbage_collect(), - {NewTime1,ok} = tc(fun() -> calls(10, Pid) end), - {NewTime2,ok} = tc(fun() -> calls(10, Pid) end), + call_with_huge_message_queue_1(Pid, Time, 5). + +call_with_huge_message_queue_1(_Pid, _Time, 0) -> + ct:fail(bad_ratio); +call_with_huge_message_queue_1(Pid, Time, NumTries) -> + HugeTime = time_calls(Pid), + io:format("Time for huge message queue: ~p", [HugeTime]), + + case (HugeTime+1) / (Time+1) of + Q when Q < 10 -> + ok; + Q -> + io:format("Too high ratio: ~p\n", [Q]), + call_with_huge_message_queue_1(Pid, Time, NumTries-1) + end. - io:format("Time for empty message queue: ~p", [Time]), - io:format("Time1 for huge message queue: ~p", [NewTime1]), - io:format("Time2 for huge message queue: ~p", [NewTime2]), - - case hd(lists:sort([(NewTime1+1) / (Time+1), (NewTime2+1) / (Time+1)])) of - Q when Q < 10 -> - ok; - Q -> - io:format("Best Q = ~p", [Q]), - ?t:fail() - end, - ok. +%% Time a number calls. Try to avoid returning a zero time. +time_calls(Pid) -> + time_calls(Pid, 10). + +time_calls(_Pid, 0) -> + 0; +time_calls(Pid, NumTries) -> + case timer:tc(fun() -> calls(Pid) end) of + {0,ok} -> + time_calls(Pid, NumTries-1); + {Time,ok} -> + Time + end. + +calls(Pid) -> + calls(100, Pid). calls(0, _) -> ok; calls(N, Pid) -> @@ -130,6 +123,3 @@ echo_loop() -> Pid ! {Ref,Msg}, echo_loop() end. - -tc(Fun) -> - timer:tc(erlang, apply, [Fun,[]]). diff --git a/erts/emulator/test/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl index e13dfa1575..5f519d522e 100644 --- a/erts/emulator/test/ref_SUITE.erl +++ b/erts/emulator/test/ref_SUITE.erl @@ -1,72 +1,48 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(ref_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2]). +-export([all/0, suite/0]). -export([wrap_1/1]). -export([loop_ref/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -init_per_testcase(_, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(2)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [wrap_1]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -wrap_1(doc) -> "Check that refs don't wrap around easily."; +%% Check that refs don't wrap around easily. wrap_1(Config) when is_list(Config) -> - ?line spawn_link(?MODULE, loop_ref, [self()]), - ?line receive - done -> - test_server:fail(wrapfast) - after 30000 -> - ok - end, + spawn_link(?MODULE, loop_ref, [self()]), + receive + done -> + ct:fail(wrapfast) + after 30000 -> + ok + end, ok. loop_ref(Parent) -> diff --git a/erts/emulator/test/register_SUITE.erl b/erts/emulator/test/register_SUITE.erl index 9953df3458..49da94a775 100644 --- a/erts/emulator/test/register_SUITE.erl +++ b/erts/emulator/test/register_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,47 +23,20 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0]). -export([otp_8099/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(2)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [otp_8099]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Case, Config) when is_list(Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, Dog}, {testcase, Case} | Config]. - -end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - %% %% Test cases %% @@ -70,37 +44,25 @@ end_per_testcase(_Case, Config) when is_list(Config) -> -define(OTP_8099_NAME, otp_8099_reg_proc). otp_8099(Config) when is_list(Config) -> - case catch erlang:system_info(lock_counting) of - true -> {skipped, - "Lock counting enabled. Current lock counting " - "implementation cannot handle this many " - "processes."}; - _ -> - otp_8099_test(1000000) - end. + otp_8099_test(1000000). otp_8099_test(0) -> ok; otp_8099_test(N) -> - ?line P = spawn(fun () -> otp_8099_proc() end), - ?line case catch register(?OTP_8099_NAME, P) of + P = spawn(fun () -> otp_8099_proc() end), + case catch register(?OTP_8099_NAME, P) of true -> - ?line ok; + ok; _ -> - ?line OP = whereis(?OTP_8099_NAME), - ?line (catch unregister(?OTP_8099_NAME)), - ?line (catch exit(OP, kill)), - ?line true = (catch register(?OTP_8099_NAME, P)) + OP = whereis(?OTP_8099_NAME), + (catch unregister(?OTP_8099_NAME)), + (catch exit(OP, kill)), + true = (catch register(?OTP_8099_NAME, P)) end, - ?line P = whereis(?OTP_8099_NAME), - ?line exit(P, kill), - ?line otp_8099_test(N-1). + P = whereis(?OTP_8099_NAME), + exit(P, kill), + otp_8099_test(N-1). otp_8099_proc() -> receive _ -> ok end, otp_8099_proc(). - -%% -%% Utils -%% - diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl index ddf8b2d919..aae7651f6d 100644 --- a/erts/emulator/test/save_calls_SUITE.erl +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -1,30 +1,28 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(save_calls_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0, - init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2]). +-export([all/0, suite/0, init_per_testcase/2,end_per_testcase/2]). -export([save_calls_1/1,dont_break_reductions/1]). @@ -35,36 +33,21 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [save_calls_1, dont_break_reductions]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - init_per_testcase(dont_break_reductions,Config) -> %% Skip on --enable-native-libs as hipe rescedules after each %% function call. case erlang:system_info(hipe_architecture) of - undefined -> - Config; - Architecture -> - {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists), - ChunkName = hipe_unified_loader:chunk_name(Architecture), - NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]), - case NativeChunk of - {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> - {skip,"Does not work for --enable-native-libs"}; - {error, beam_lib, _} -> Config - end + undefined -> + Config; + Architecture -> + {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists), + ChunkName = hipe_unified_loader:chunk_name(Architecture), + NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]), + case NativeChunk of + {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> + {skip,"Does not work for --enable-native-libs"}; + {error, beam_lib, _} -> Config + end end; init_per_testcase(_,Config) -> Config. @@ -72,91 +55,99 @@ init_per_testcase(_,Config) -> end_per_testcase(_,_Config) -> ok. -dont_break_reductions(suite) -> - []; -dont_break_reductions(doc) -> - ["Check that save_calls dont break reduction-based scheduling"]; +%% Check that save_calls dont break reduction-based scheduling dont_break_reductions(Config) when is_list(Config) -> - ?line RPS1 = reds_per_sched(0), - ?line RPS2 = reds_per_sched(20), - ?line Diff = abs(RPS1 - RPS2), - ?line true = (Diff < (0.05 * RPS1)), + RPS1 = reds_per_sched(0), + RPS2 = reds_per_sched(20), + Diff = abs(RPS1 - RPS2), + true = (Diff < (0.2 * RPS1)), ok. reds_per_sched(SaveCalls) -> - ?line Parent = self(), - ?line HowMany = 10000, - ?line Pid = spawn(fun() -> - process_flag(save_calls,SaveCalls), - receive - go -> - carmichaels_below(HowMany), - Parent ! erlang:process_info(self(),reductions) - end - end), - ?line TH = spawn(fun() -> trace_handler(0,Parent,Pid) end), - ?line erlang:trace(Pid, true,[running,procs,{tracer,TH}]), - ?line Pid ! go, - ?line {Sched,Reds} = receive - {accumulated,X} -> - receive {reductions,Y} -> - {X,Y} - after 30000 -> - timeout - end - after 30000 -> - timeout - end, - ?line Reds div Sched. + Parent = self(), + HowMany = 10000, + Pid = spawn(fun() -> + process_flag(save_calls,SaveCalls), + receive + go -> + carmichaels_below(HowMany), + Parent ! erlang:process_info(self(),reductions) + end + end), + TH = spawn(fun() -> trace_handler(0,Parent,Pid) end), + erlang:trace(Pid, true,[running,procs,{tracer,TH}]), + Pid ! go, + {Sched,Reds} = receive + {accumulated,X} -> + receive {reductions,Y} -> + {X,Y} + after 30000 -> + timeout + end + after 30000 -> + timeout + end, + Reds div Sched. trace_handler(Acc,Parent,Client) -> receive - {trace,Client,out,_} -> - trace_handler(Acc+1,Parent,Client); - {trace,Client,exit,_} -> - Parent ! {accumulated, Acc}; - _ -> - trace_handler(Acc,Parent,Client) + {trace,Client,out,_} -> + trace_handler(Acc+1,Parent,Client); + {trace,Client,exit,_} -> + Parent ! {accumulated, Acc}; + _ -> + trace_handler(Acc,Parent,Client) after 10000 -> - ok + ok end. -save_calls_1(doc) -> "Test call saving."; +%% Test call saving. save_calls_1(Config) when is_list(Config) -> case test_server:is_native(?MODULE) of - true -> {skipped,"Native code"}; - false -> save_calls_1() + true -> {skipped,"Native code"}; + false -> save_calls_1() end. - + save_calls_1() -> - ?line erlang:process_flag(self(), save_calls, 0), - ?line {last_calls, false} = process_info(self(), last_calls), - - ?line erlang:process_flag(self(), save_calls, 10), - ?line {last_calls, _L1} = process_info(self(), last_calls), - ?line ?MODULE:do_bipp(), - ?line {last_calls, L2} = process_info(self(), last_calls), - ?line L21 = lists:filter(fun is_local_function/1, L2), - ?line case L21 of - [{?MODULE,do_bipp,0}, - timeout, - 'send', - {?MODULE,do_bopp,1}, - 'receive', - timeout, - {?MODULE,do_bepp,0}] -> - ok; - X -> - test_server:fail({l21, X}) - end, - - ?line erlang:process_flag(self(), save_calls, 10), - ?line {last_calls, L3} = process_info(self(), last_calls), - ?line L31 = lists:filter(fun is_local_function/1, L3), - ?line [] = L31, + erlang:process_flag(self(), save_calls, 0), + {last_calls, false} = process_info(self(), last_calls), + + erlang:process_flag(self(), save_calls, 10), + {last_calls, _L1} = process_info(self(), last_calls), + ?MODULE:do_bipp(), + {last_calls, L2} = process_info(self(), last_calls), + L21 = lists:filter(fun is_local_function/1, L2), + case L21 of + [{?MODULE,do_bipp,0}, + timeout, + 'send', + {?MODULE,do_bopp,1}, + 'receive', + timeout, + {?MODULE,do_bepp,0}] -> + ok; + X -> + ct:fail({l21, X}) + end, + + erlang:process_flag(self(), save_calls, 10), + {last_calls, L3} = process_info(self(), last_calls), + true = (L3 /= false), + L31 = lists:filter(fun is_local_function/1, L3), + [] = L31, + erlang:process_flag(self(), save_calls, 0), + + %% Also check that it works on another process ... + Pid = spawn(fun () -> receive after infinity -> ok end end), + erlang:process_flag(Pid, save_calls, 10), + {last_calls, L4} = process_info(Pid, last_calls), + true = (L4 /= false), + L41 = lists:filter(fun is_local_function/1, L4), + [] = L41, + exit(Pid,kill), ok. do_bipp() -> @@ -171,7 +162,7 @@ do_bapp() -> do_bopp(T) -> receive - X -> X + X -> X after T -> ok end. @@ -188,25 +179,25 @@ is_local_function(_) -> % Number crunching for reds test. carmichaels_below(N) -> - random:seed(3172,9814,20125), + rand:seed(exsplus, {3172,9814,20125}), carmichaels_below(1,N). carmichaels_below(N,N2) when N >= N2 -> 0; carmichaels_below(N,N2) -> X = case fast_prime(N,10) of - false -> 0; - true -> - case fast_prime2(N,10) of - true -> - %io:format("Prime: ~p~n",[N]), - 0; - false -> - io:format("Carmichael: ~p (dividable by ~p)~n", - [N,smallest_divisor(N)]), - 1 - end - end, + false -> 0; + true -> + case fast_prime2(N,10) of + true -> + %io:format("Prime: ~p~n",[N]), + 0; + false -> + io:format("Carmichael: ~p (dividable by ~p)~n", + [N,smallest_divisor(N)]), + 1 + end + end, X+carmichaels_below(N+2,N2). expmod(_,E,_) when E == 0 -> @@ -218,7 +209,7 @@ expmod(Base,Exp,Mod) -> (Base * expmod(Base,Exp - 1,Mod)) rem Mod. uniform(N) -> - random:uniform(N-1). + rand:uniform(N-1). fermat(N) -> R = uniform(N), @@ -230,30 +221,30 @@ do_fast_prime(_N,0) -> true; do_fast_prime(N,Times) -> case fermat(N) of - true -> - do_fast_prime(N,Times-1); - false -> - false + true -> + do_fast_prime(N,Times-1); + false -> + false end. - + fast_prime(N,T) -> do_fast_prime(N,T). expmod2(_,E,_) when E == 0 -> 1; expmod2(Base,Exp,Mod) when (Exp rem 2) == 0 -> -%% Uncomment the code below to simulate scheduling bug! -% case erlang:process_info(self(),last_calls) of -% {last_calls,false} -> ok; -% _ -> erlang:yield() -% end, + %% Uncomment the code below to simulate scheduling bug! + % case erlang:process_info(self(),last_calls) of + % {last_calls,false} -> ok; + % _ -> erlang:yield() + % end, X = expmod2(Base,Exp div 2,Mod), Y=(X*X) rem Mod, if - Y == 1, X =/= 1, X =/= (Mod - 1) -> - 0; - true -> - Y rem Mod + Y == 1, X =/= 1, X =/= (Mod - 1) -> + 0; + true -> + Y rem Mod end; expmod2(Base,Exp,Mod) -> (Base * expmod2(Base,Exp - 1,Mod)) rem Mod. @@ -268,12 +259,12 @@ do_fast_prime2(_N,0) -> true; do_fast_prime2(N,Times) -> case miller_rabbin(N) of - true -> - do_fast_prime2(N,Times-1); - false -> - false + true -> + do_fast_prime2(N,Times-1); + false -> + false end. - + fast_prime2(N,T) -> do_fast_prime2(N,T). @@ -282,17 +273,16 @@ smallest_divisor(N) -> find_divisor(N,TD) -> if - TD*TD > N -> - N; - true -> - case divides(TD,N) of - true -> - TD; - false -> - find_divisor(N,TD+1) - end + TD*TD > N -> + N; + true -> + case divides(TD,N) of + true -> + TD; + false -> + find_divisor(N,TD+1) + end end. divides(A,B) -> (B rem A) == 0. - diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 3906471f87..7eebbe8b19 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -30,12 +31,12 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). --export([all/0, suite/0,groups/0,init_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2, end_per_suite/1]). +-export([all/0, suite/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). -export([equal/1, few_low/1, @@ -53,23 +54,26 @@ sct_cmd/1, sbt_cmd/1, scheduler_threads/1, + scheduler_suspend_basic/1, scheduler_suspend/1, dirty_scheduler_threads/1, + poll_threads/1, reader_groups/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(15)). - --define(MIN_SCHEDULER_TEST_TIMEOUT, ?t:minutes(1)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 15}}]. all() -> [equal, few_low, many_low, equal_with_part_time_high, equal_with_part_time_max, equal_and_high_with_part_time_max, equal_with_high, - equal_with_high_max, bound_process, - {group, scheduler_bind}, scheduler_threads, scheduler_suspend, + equal_with_high_max, + bound_process, + {group, scheduler_bind}, scheduler_threads, + scheduler_suspend_basic, scheduler_suspend, dirty_scheduler_threads, + poll_threads, reader_groups]. groups() -> @@ -84,12 +88,6 @@ end_per_suite(Config) -> catch erts_debug:set_internal_state(available_internal_state, false), Config. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - init_per_testcase(update_cpu_info, Config) -> case os:find_executable("taskset") of false -> @@ -101,15 +99,12 @@ init_per_testcase(Case, Config) when is_list(Config) -> init_per_tc(Case, Config). init_per_tc(Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), process_flag(priority, max), erlang:display({'------------', ?MODULE, Case, '------------'}), OkRes = ok, - [{watchdog, Dog}, {testcase, Case}, {ok_res, OkRes} |Config]. + [{testcase, Case}, {ok_res, OkRes} |Config]. end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), ok. -define(ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED, (2000*2000)). @@ -129,130 +124,130 @@ many_low(Config) when is_list(Config) -> low_normal_test(Config, 2*active_schedulers(), 1000). low_normal_test(Config, NW, LW) -> - ?line Tracer = start_tracer(), - ?line Low = workers(LW, low), - ?line Normal = workers(NW, normal), - ?line Res = do_it(Tracer, Low, Normal, [], []), - ?line chk_result(Res, LW, NW, 0, 0, true, false, false), - ?line workers_exit([Low, Normal]), - ?line ok(Res, Config). + Tracer = start_tracer(), + Low = workers(LW, low), + Normal = workers(NW, normal), + Res = do_it(Tracer, Low, Normal, [], []), + chk_result(Res, LW, NW, 0, 0, true, false, false), + workers_exit([Low, Normal]), + ok(Res, Config). equal_with_part_time_high(Config) when is_list(Config) -> - ?line NW = 500, - ?line LW = 500, - ?line HW = 1, - ?line Tracer = start_tracer(), - ?line Normal = workers(NW, normal), - ?line Low = workers(LW, low), - ?line High = part_time_workers(HW, high), - ?line Res = do_it(Tracer, Low, Normal, High, []), - ?line chk_result(Res, LW, NW, HW, 0, true, true, false), - ?line workers_exit([Low, Normal, High]), - ?line ok(Res, Config). + NW = 500, + LW = 500, + HW = 1, + Tracer = start_tracer(), + Normal = workers(NW, normal), + Low = workers(LW, low), + High = part_time_workers(HW, high), + Res = do_it(Tracer, Low, Normal, High, []), + chk_result(Res, LW, NW, HW, 0, true, true, false), + workers_exit([Low, Normal, High]), + ok(Res, Config). equal_and_high_with_part_time_max(Config) when is_list(Config) -> - ?line NW = 500, - ?line LW = 500, - ?line HW = 500, - ?line MW = 1, - ?line Tracer = start_tracer(), - ?line Low = workers(LW, low), - ?line Normal = workers(NW, normal), - ?line High = workers(HW, high), - ?line Max = part_time_workers(MW, max), - ?line Res = do_it(Tracer, Low, Normal, High, Max), - ?line chk_result(Res, LW, NW, HW, MW, false, true, true), - ?line workers_exit([Low, Normal, Max]), - ?line ok(Res, Config). + NW = 500, + LW = 500, + HW = 500, + MW = 1, + Tracer = start_tracer(), + Low = workers(LW, low), + Normal = workers(NW, normal), + High = workers(HW, high), + Max = part_time_workers(MW, max), + Res = do_it(Tracer, Low, Normal, High, Max), + chk_result(Res, LW, NW, HW, MW, false, true, true), + workers_exit([Low, Normal, Max]), + ok(Res, Config). equal_with_part_time_max(Config) when is_list(Config) -> - ?line NW = 500, - ?line LW = 500, - ?line MW = 1, - ?line Tracer = start_tracer(), - ?line Low = workers(LW, low), - ?line Normal = workers(NW, normal), - ?line Max = part_time_workers(MW, max), - ?line Res = do_it(Tracer, Low, Normal, [], Max), - ?line chk_result(Res, LW, NW, 0, MW, true, false, true), - ?line workers_exit([Low, Normal, Max]), - ?line ok(Res, Config). + NW = 500, + LW = 500, + MW = 1, + Tracer = start_tracer(), + Low = workers(LW, low), + Normal = workers(NW, normal), + Max = part_time_workers(MW, max), + Res = do_it(Tracer, Low, Normal, [], Max), + chk_result(Res, LW, NW, 0, MW, true, false, true), + workers_exit([Low, Normal, Max]), + ok(Res, Config). equal_with_high(Config) when is_list(Config) -> - ?line NW = 500, - ?line LW = 500, - ?line HW = 1, - ?line Tracer = start_tracer(), - ?line Low = workers(LW, low), - ?line Normal = workers(NW, normal), - ?line High = workers(HW, high), - ?line Res = do_it(Tracer, Low, Normal, High, []), - ?line LNExe = case active_schedulers() of + NW = 500, + LW = 500, + HW = 1, + Tracer = start_tracer(), + Low = workers(LW, low), + Normal = workers(NW, normal), + High = workers(HW, high), + Res = do_it(Tracer, Low, Normal, High, []), + LNExe = case active_schedulers() of S when S =< HW -> false; _ -> true end, - ?line chk_result(Res, LW, NW, HW, 0, LNExe, true, false), - ?line workers_exit([Low, Normal, High]), - ?line ok(Res, Config). + chk_result(Res, LW, NW, HW, 0, LNExe, true, false), + workers_exit([Low, Normal, High]), + ok(Res, Config). equal_with_high_max(Config) when is_list(Config) -> - ?line NW = 500, - ?line LW = 500, - ?line HW = 1, - ?line MW = 1, - ?line Tracer = start_tracer(), - ?line Normal = workers(NW, normal), - ?line Low = workers(LW, low), - ?line High = workers(HW, high), - ?line Max = workers(MW, max), - ?line Res = do_it(Tracer, Low, Normal, High, Max), - ?line {LNExe, HExe} = case active_schedulers() of + NW = 500, + LW = 500, + HW = 1, + MW = 1, + Tracer = start_tracer(), + Normal = workers(NW, normal), + Low = workers(LW, low), + High = workers(HW, high), + Max = workers(MW, max), + Res = do_it(Tracer, Low, Normal, High, Max), + {LNExe, HExe} = case active_schedulers() of S when S =< MW -> {false, false}; S when S =< (MW + HW) -> {false, true}; _ -> {true, true} end, - ?line chk_result(Res, LW, NW, HW, MW, LNExe, HExe, true), - ?line workers_exit([Low, Normal, Max]), - ?line ok(Res, Config). + chk_result(Res, LW, NW, HW, MW, LNExe, HExe, true), + workers_exit([Low, Normal, Max]), + ok(Res, Config). bound_process(Config) when is_list(Config) -> case erlang:system_info(run_queues) == erlang:system_info(schedulers) of - true -> - ?line NStartBase = 20000, - ?line NStart = case {erlang:system_info(debug_compiled), - erlang:system_info(lock_checking)} of - {true, true} -> NStartBase div 100; - {_, true} -> NStartBase div 10; - _ -> NStartBase - end, - ?line MStart = 100, - ?line Seq = lists:seq(1, 100), - ?line Tester = self(), - ?line Procs = lists:map( - fun (N) when N rem 2 == 0 -> - spawn_opt(fun () -> - bound_loop(NStart, - NStart, - MStart, - 1), - Tester ! {self(), done} - end, - [{scheduler, 1}, link]); - (_N) -> - spawn_link(fun () -> - bound_loop(NStart, - NStart, - MStart, - false), - Tester ! {self(), done} - end) - end, - Seq), - ?line lists:foreach(fun (P) -> receive {P, done} -> ok end end, - Procs), - ?line ok; - false -> - {skipped, "Functionality not supported"} + true -> + NStartBase = 20000, + NStart = case {erlang:system_info(debug_compiled), + erlang:system_info(lock_checking)} of + {true, true} -> NStartBase div 100; + {_, true} -> NStartBase div 10; + _ -> NStartBase + end, + MStart = 100, + Seq = lists:seq(1, 100), + Tester = self(), + Procs = lists:map( + fun (N) when N rem 2 == 0 -> + spawn_opt(fun () -> + bound_loop(NStart, + NStart, + MStart, + 1), + Tester ! {self(), done} + end, + [{scheduler, 1}, link]); + (_N) -> + spawn_link(fun () -> + bound_loop(NStart, + NStart, + MStart, + false), + Tester ! {self(), done} + end) + end, + Seq), + lists:foreach(fun (P) -> receive {P, done} -> ok end end, + Procs), + ok; + false -> + {skipped, "Functionality not supported"} end. bound_loop(_, 0, 0, _) -> @@ -486,59 +481,59 @@ bound_loop(NS, N, M, Sched) -> ":L30-31t0-1c15n3p0"). -define(TOPOLOGY_F_TERM, - [{processor,[{node,[{core,[{thread,{logical,0}}, - {thread,{logical,1}}]}, - {core,[{thread,{logical,2}}, - {thread,{logical,3}}]}, - {core,[{thread,{logical,4}}, - {thread,{logical,5}}]}, - {core,[{thread,{logical,6}}, - {thread,{logical,7}}]}]}, - {node,[{core,[{thread,{logical,8}}, - {thread,{logical,9}}]}, - {core,[{thread,{logical,10}}, - {thread,{logical,11}}]}, - {core,[{thread,{logical,12}}, - {thread,{logical,13}}]}, - {core,[{thread,{logical,14}}, - {thread,{logical,15}}]}]}, - {node,[{core,[{thread,{logical,16}}, - {thread,{logical,17}}]}, - {core,[{thread,{logical,18}}, - {thread,{logical,19}}]}, - {core,[{thread,{logical,20}}, - {thread,{logical,21}}]}, - {core,[{thread,{logical,22}}, - {thread,{logical,23}}]}]}, - {node,[{core,[{thread,{logical,24}}, - {thread,{logical,25}}]}, - {core,[{thread,{logical,26}}, - {thread,{logical,27}}]}, - {core,[{thread,{logical,28}}, - {thread,{logical,29}}]}, - {core,[{thread,{logical,30}}, - {thread,{logical,31}}]}]}]}]). + [{processor,[{node,[{core,[{thread,{logical,0}}, + {thread,{logical,1}}]}, + {core,[{thread,{logical,2}}, + {thread,{logical,3}}]}, + {core,[{thread,{logical,4}}, + {thread,{logical,5}}]}, + {core,[{thread,{logical,6}}, + {thread,{logical,7}}]}]}, + {node,[{core,[{thread,{logical,8}}, + {thread,{logical,9}}]}, + {core,[{thread,{logical,10}}, + {thread,{logical,11}}]}, + {core,[{thread,{logical,12}}, + {thread,{logical,13}}]}, + {core,[{thread,{logical,14}}, + {thread,{logical,15}}]}]}, + {node,[{core,[{thread,{logical,16}}, + {thread,{logical,17}}]}, + {core,[{thread,{logical,18}}, + {thread,{logical,19}}]}, + {core,[{thread,{logical,20}}, + {thread,{logical,21}}]}, + {core,[{thread,{logical,22}}, + {thread,{logical,23}}]}]}, + {node,[{core,[{thread,{logical,24}}, + {thread,{logical,25}}]}, + {core,[{thread,{logical,26}}, + {thread,{logical,27}}]}, + {core,[{thread,{logical,28}}, + {thread,{logical,29}}]}, + {core,[{thread,{logical,30}}, + {thread,{logical,31}}]}]}]}]). bindings(Node, BindType) -> Parent = self(), Ref = make_ref(), Pid = spawn_link(Node, - fun () -> - enable_internal_state(), - Res = (catch erts_debug:get_internal_state( - {fake_scheduler_bindings, - BindType})), - Parent ! {Ref, Res} - end), + fun () -> + enable_internal_state(), + Res = (catch erts_debug:get_internal_state( + {fake_scheduler_bindings, + BindType})), + Parent ! {Ref, Res} + end), receive - {Ref, Res} -> - ?t:format("~p: ~p~n", [BindType, Res]), - unlink(Pid), - Res + {Ref, Res} -> + io:format("~p: ~p~n", [BindType, Res]), + unlink(Pid), + Res end. scheduler_bind_types(Config) when is_list(Config) -> - ?line OldRelFlags = clear_erl_rel_flags(), + OldRelFlags = clear_erl_rel_flags(), try scheduler_bind_types_test(Config, ?TOPOLOGY_A_TERM, @@ -567,297 +562,341 @@ scheduler_bind_types(Config) when is_list(Config) -> after restore_erl_rel_flags(OldRelFlags) end, - ?line ok. + ok. scheduler_bind_types_test(Config, Topology, CmdLine, TermLetter) -> - ?line ?t:format("Testing (~p): ~p~n", [TermLetter, Topology]), - ?line {ok, Node0} = start_node(Config), - ?line _ = rpc:call(Node0, erlang, system_flag, [cpu_topology, Topology]), - ?line cmp(Topology, rpc:call(Node0, erlang, system_info, [cpu_topology])), - ?line check_bind_types(Node0, TermLetter), - ?line stop_node(Node0), - ?line {ok, Node1} = start_node(Config, CmdLine), - ?line cmp(Topology, rpc:call(Node1, erlang, system_info, [cpu_topology])), - ?line check_bind_types(Node1, TermLetter), - ?line stop_node(Node1). + io:format("Testing (~p): ~p~n", [TermLetter, Topology]), + {ok, Node0} = start_node(Config), + _ = rpc:call(Node0, erlang, system_flag, [cpu_topology, Topology]), + cmp(Topology, rpc:call(Node0, erlang, system_info, [cpu_topology])), + check_bind_types(Node0, TermLetter), + stop_node(Node0), + {ok, Node1} = start_node(Config, CmdLine), + cmp(Topology, rpc:call(Node1, erlang, system_info, [cpu_topology])), + check_bind_types(Node1, TermLetter), + stop_node(Node1). check_bind_types(Node, a) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} - = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, thread_spread), - ?line {0,4,8,12,2,6,10,14,1,5,9,13,3,7,11,15} - = bindings(Node, processor_spread), - ?line {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15} - = bindings(Node, spread), - ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} - = bindings(Node, no_node_thread_spread), - ?line {0,4,2,6,1,5,3,7,8,12,10,14,9,13,11,15} - = bindings(Node, no_node_processor_spread), - ?line {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15} - = bindings(Node, thread_no_node_processor_spread), - ?line {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15} - = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} + = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_spread), + {0,4,8,12,2,6,10,14,1,5,9,13,3,7,11,15} + = bindings(Node, processor_spread), + {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15} + = bindings(Node, spread), + {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} + = bindings(Node, no_node_thread_spread), + {0,4,2,6,1,5,3,7,8,12,10,14,9,13,11,15} + = bindings(Node, no_node_processor_spread), + {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15} + = bindings(Node, thread_no_node_processor_spread), + {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15} + = bindings(Node, default_bind), + ok; check_bind_types(Node, b) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} - = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, thread_spread), - ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} - = bindings(Node, processor_spread), - ?line {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15} - = bindings(Node, spread), - ?line {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15} - = bindings(Node, no_node_thread_spread), - ?line {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15} - = bindings(Node, no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, thread_no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} + = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_spread), + {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} + = bindings(Node, processor_spread), + {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15} + = bindings(Node, spread), + {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15} + = bindings(Node, no_node_thread_spread), + {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15} + = bindings(Node, no_node_processor_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_no_node_processor_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, default_bind), + ok; check_bind_types(Node, c) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, - 25,26,27,28,29,30,31} = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, - 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), - ?line {0,4,8,16,20,24,2,6,10,18,22,26,12,28,14,30,1,5,9,17,21,25, - 3,7,11,19,23,27,13,29,15,31} = bindings(Node, processor_spread), - ?line {0,8,16,24,4,20,12,28,2,10,18,26,6,22,14,30,1,9,17,25,5,21,13,29,3,11, - 19,27,7,23,15,31} = bindings(Node, spread), - ?line {0,2,4,6,1,3,5,7,8,10,9,11,12,14,13,15,16,18,20,22,17,19,21,23,24,26, - 25,27,28,30,29,31} = bindings(Node, no_node_thread_spread), - ?line {0,4,2,6,1,5,3,7,8,10,9,11,12,14,13,15,16,20,18,22,17,21,19,23,24,26, - 25,27,28,30,29,31} = bindings(Node, no_node_processor_spread), - ?line {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21, - 19,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread), - ?line {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21, - 19,23,25,27,29,31} = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, + 25,26,27,28,29,30,31} = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, + 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), + {0,4,8,16,20,24,2,6,10,18,22,26,12,28,14,30,1,5,9,17,21,25, + 3,7,11,19,23,27,13,29,15,31} = bindings(Node, processor_spread), + {0,8,16,24,4,20,12,28,2,10,18,26,6,22,14,30,1,9,17,25,5,21,13,29,3,11, + 19,27,7,23,15,31} = bindings(Node, spread), + {0,2,4,6,1,3,5,7,8,10,9,11,12,14,13,15,16,18,20,22,17,19,21,23,24,26, + 25,27,28,30,29,31} = bindings(Node, no_node_thread_spread), + {0,4,2,6,1,5,3,7,8,10,9,11,12,14,13,15,16,20,18,22,17,21,19,23,24,26, + 25,27,28,30,29,31} = bindings(Node, no_node_processor_spread), + {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21, + 19,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread), + {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21, + 19,23,25,27,29,31} = bindings(Node, default_bind), + ok; check_bind_types(Node, d) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, - 25,26,27,28,29,30,31} = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, - 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), - ?line {0,8,12,16,24,28,2,10,14,18,26,30,4,20,6,22,1,9,13,17,25,29,3,11,15, - 19,27,31,5,21,7,23} = bindings(Node, processor_spread), - ?line {0,8,16,24,12,28,4,20,2,10,18,26,14,30,6,22,1,9,17,25,13,29,5,21,3,11, - 19,27,15,31,7,23} = bindings(Node, spread), - ?line {0,2,1,3,4,6,5,7,8,10,12,14,9,11,13,15,16,18,17,19,20,22,21,23,24,26, - 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread), - ?line {0,2,1,3,4,6,5,7,8,12,10,14,9,13,11,15,16,18,17,19,20,22,21,23,24,28, - 26,30,25,29,27,31} = bindings(Node, no_node_processor_spread), - ?line {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19, - 21,23,25,29,27,31} = bindings(Node, thread_no_node_processor_spread), - ?line {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19, - 21,23,25,29,27,31} = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, + 25,26,27,28,29,30,31} = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, + 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), + {0,8,12,16,24,28,2,10,14,18,26,30,4,20,6,22,1,9,13,17,25,29,3,11,15, + 19,27,31,5,21,7,23} = bindings(Node, processor_spread), + {0,8,16,24,12,28,4,20,2,10,18,26,14,30,6,22,1,9,17,25,13,29,5,21,3,11, + 19,27,15,31,7,23} = bindings(Node, spread), + {0,2,1,3,4,6,5,7,8,10,12,14,9,11,13,15,16,18,17,19,20,22,21,23,24,26, + 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread), + {0,2,1,3,4,6,5,7,8,12,10,14,9,13,11,15,16,18,17,19,20,22,21,23,24,28, + 26,30,25,29,27,31} = bindings(Node, no_node_processor_spread), + {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19, + 21,23,25,29,27,31} = bindings(Node, thread_no_node_processor_spread), + {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19, + 21,23,25,29,27,31} = bindings(Node, default_bind), + ok; check_bind_types(Node, e) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} - = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, thread_spread), - ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} - = bindings(Node, processor_spread), - ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} - = bindings(Node, spread), - ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} - = bindings(Node, no_node_thread_spread), - ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} - = bindings(Node, no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, thread_no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} + = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_spread), + {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} + = bindings(Node, processor_spread), + {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} + = bindings(Node, spread), + {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} + = bindings(Node, no_node_thread_spread), + {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} + = bindings(Node, no_node_processor_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_no_node_processor_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, default_bind), + ok; check_bind_types(Node, f) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, - 25,26,27,28,29,30,31} = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, - 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13, - 15,17,19,21,23,25,27,29,31} = bindings(Node, processor_spread), - ?line {0,8,16,24,2,10,18,26,4,12,20,28,6,14,22,30,1,9,17,25,3,11,19,27,5,13, - 21,29,7,15,23,31} = bindings(Node, spread), - ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26, - 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread), - ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26, - 28,30,25,27,29,31} = bindings(Node, no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19, - 21,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19, - 21,23,25,27,29,31} = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, + 25,26,27,28,29,30,31} = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, + 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13, + 15,17,19,21,23,25,27,29,31} = bindings(Node, processor_spread), + {0,8,16,24,2,10,18,26,4,12,20,28,6,14,22,30,1,9,17,25,3,11,19,27,5,13, + 21,29,7,15,23,31} = bindings(Node, spread), + {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26, + 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread), + {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26, + 28,30,25,27,29,31} = bindings(Node, no_node_processor_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19, + 21,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19, + 21,23,25,27,29,31} = bindings(Node, default_bind), + ok; check_bind_types(Node, _) -> - ?line bindings(Node, no_spread), - ?line bindings(Node, thread_spread), - ?line bindings(Node, processor_spread), - ?line bindings(Node, spread), - ?line bindings(Node, no_node_thread_spread), - ?line bindings(Node, no_node_processor_spread), - ?line bindings(Node, thread_no_node_processor_spread), - ?line bindings(Node, default_bind), - ?line ok. + bindings(Node, no_spread), + bindings(Node, thread_spread), + bindings(Node, processor_spread), + bindings(Node, spread), + bindings(Node, no_node_thread_spread), + bindings(Node, no_node_processor_spread), + bindings(Node, thread_no_node_processor_spread), + bindings(Node, default_bind), + ok. cpu_topology(Config) when is_list(Config) -> - ?line OldRelFlags = clear_erl_rel_flags(), + OldRelFlags = clear_erl_rel_flags(), try - ?line cpu_topology_test( - Config, - [{node,[{processor,[{core,{logical,0}}, - {core,{logical,1}}]}]}, - {processor,[{node,[{core,{logical,2}}, - {core,{logical,3}}]}]}, - {node,[{processor,[{core,{logical,4}}, - {core,{logical,5}}]}]}, - {processor,[{node,[{core,{logical,6}}, - {core,{logical,7}}]}]}], - "+sct " - "L0-1c0-1p0n0" - ":L2-3c0-1n1p1" - ":L4-5c0-1p2n2" - ":L6-7c0-1n3p3"), - ?line cpu_topology_test( - Config, - [{node,[{processor,[{core,{logical,0}}, - {core,{logical,1}}]}, - {processor,[{core,{logical,2}}, - {core,{logical,3}}]}]}, - {processor,[{node,[{core,{logical,4}}, - {core,{logical,5}}]}, - {node,[{core,{logical,6}}, - {core,{logical,7}}]}]}, - {node,[{processor,[{core,{logical,8}}, - {core,{logical,9}}]}, - {processor,[{core,{logical,10}}, - {core,{logical,11}}]}]}, - {processor,[{node,[{core,{logical,12}}, - {core,{logical,13}}]}, - {node,[{core,{logical,14}}, - {core,{logical,15}}]}]}], - "+sct " - "L0-1c0-1p0n0" - ":L2-3c0-1p1n0" - ":L4-5c0-1n1p2" - ":L6-7c2-3n2p2" - ":L8-9c0-1p3n3" - ":L10-11c0-1p4n3" - ":L12-13c0-1n4p5" - ":L14-15c2-3n5p5"), - ?line cpu_topology_test( - Config, - [{node,[{processor,[{core,{logical,0}}, - {core,{logical,1}}]}]}, - {processor,[{node,[{core,{logical,2}}, - {core,{logical,3}}]}]}, - {processor,[{node,[{core,{logical,4}}, - {core,{logical,5}}]}]}, - {node,[{processor,[{core,{logical,6}}, - {core,{logical,7}}]}]}, - {node,[{processor,[{core,{logical,8}}, - {core,{logical,9}}]}]}, - {processor,[{node,[{core,{logical,10}}, - {core,{logical,11}}]}]}], - "+sct " - "L0-1c0-1p0n0" - ":L2-3c0-1n1p1" - ":L4-5c0-1n2p2" - ":L6-7c0-1p3n3" - ":L8-9c0-1p4n4" - ":L10-11c0-1n5p5") + cpu_topology_test( + Config, + [{node,[{processor,[{core,{logical,0}}, + {core,{logical,1}}]}]}, + {processor,[{node,[{core,{logical,2}}, + {core,{logical,3}}]}]}, + {node,[{processor,[{core,{logical,4}}, + {core,{logical,5}}]}]}, + {processor,[{node,[{core,{logical,6}}, + {core,{logical,7}}]}]}], + "+sct " + "L0-1c0-1p0n0" + ":L2-3c0-1n1p1" + ":L4-5c0-1p2n2" + ":L6-7c0-1n3p3"), + cpu_topology_test( + Config, + [{node,[{processor,[{core,{logical,0}}, + {core,{logical,1}}]}, + {processor,[{core,{logical,2}}, + {core,{logical,3}}]}]}, + {processor,[{node,[{core,{logical,4}}, + {core,{logical,5}}]}, + {node,[{core,{logical,6}}, + {core,{logical,7}}]}]}, + {node,[{processor,[{core,{logical,8}}, + {core,{logical,9}}]}, + {processor,[{core,{logical,10}}, + {core,{logical,11}}]}]}, + {processor,[{node,[{core,{logical,12}}, + {core,{logical,13}}]}, + {node,[{core,{logical,14}}, + {core,{logical,15}}]}]}], + "+sct " + "L0-1c0-1p0n0" + ":L2-3c0-1p1n0" + ":L4-5c0-1n1p2" + ":L6-7c2-3n2p2" + ":L8-9c0-1p3n3" + ":L10-11c0-1p4n3" + ":L12-13c0-1n4p5" + ":L14-15c2-3n5p5"), + cpu_topology_test( + Config, + [{node,[{processor,[{core,{logical,0}}, + {core,{logical,1}}]}]}, + {processor,[{node,[{core,{logical,2}}, + {core,{logical,3}}]}]}, + {processor,[{node,[{core,{logical,4}}, + {core,{logical,5}}]}]}, + {node,[{processor,[{core,{logical,6}}, + {core,{logical,7}}]}]}, + {node,[{processor,[{core,{logical,8}}, + {core,{logical,9}}]}]}, + {processor,[{node,[{core,{logical,10}}, + {core,{logical,11}}]}]}], + "+sct " + "L0-1c0-1p0n0" + ":L2-3c0-1n1p1" + ":L4-5c0-1n2p2" + ":L6-7c0-1p3n3" + ":L8-9c0-1p4n4" + ":L10-11c0-1n5p5") after - restore_erl_rel_flags(OldRelFlags) + restore_erl_rel_flags(OldRelFlags) end, - ?line ok. + ok. cpu_topology_test(Config, Topology, Cmd) -> - ?line ?t:format("Testing~n ~p~n ~p~n", [Topology, Cmd]), - ?line cpu_topology_bif_test(Config, Topology), - ?line cpu_topology_cmdline_test(Config, Topology, Cmd), - ?line ok. + io:format("Testing~n ~p~n ~p~n", [Topology, Cmd]), + cpu_topology_bif_test(Config, Topology), + cpu_topology_cmdline_test(Config, Topology, Cmd), + ok. cpu_topology_bif_test(_Config, false) -> - ?line ok; + ok; cpu_topology_bif_test(Config, Topology) -> - ?line {ok, Node} = start_node(Config), - ?line _ = rpc:call(Node, erlang, system_flag, [cpu_topology, Topology]), - ?line cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), - ?line stop_node(Node), - ?line ok. + {ok, Node} = start_node(Config), + _ = rpc:call(Node, erlang, system_flag, [cpu_topology, Topology]), + cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), + stop_node(Node), + ok. cpu_topology_cmdline_test(_Config, _Topology, false) -> - ?line ok; + ok; cpu_topology_cmdline_test(Config, Topology, Cmd) -> - ?line {ok, Node} = start_node(Config, Cmd), - ?line cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), - ?line stop_node(Node), - ?line ok. + {ok, Node} = start_node(Config, Cmd), + cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), + stop_node(Node), + ok. update_cpu_info(Config) when is_list(Config) -> - ?line OldOnline = erlang:system_info(schedulers_online), - ?line OldAff = get_affinity_mask(), - ?line ?t:format("START - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", + OldOnline = erlang:system_info(schedulers_online), + OldAff = get_affinity_mask(), + io:format("START - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", [OldAff, OldOnline, erlang:system_info(scheduler_bindings)]), - ?line case {erlang:system_info(logical_processors_available), OldAff} of - {Avail, _} when Avail == unknown; OldAff == unknown -> + case {erlang:system_info(logical_processors_available), OldAff} of + {Avail, _} when Avail == unknown; OldAff == unknown; OldAff == 1 -> %% Nothing much to test; just a smoke test case erlang:system_info(update_cpu_info) of - unchanged -> ?line ok; - changed -> ?line ok + unchanged -> ok; + changed -> ok end; - _ -> + {_Avail, _} -> try - ?line adjust_schedulers_online(), + adjust_schedulers_online(), case erlang:system_info(schedulers_online) of 1 -> %% Nothing much to test; just a smoke test - ?line ok; + ok; Onln0 -> - %% unset least significant bit - ?line Aff = (OldAff band (OldAff - 1)), - ?line set_affinity_mask(Aff), - ?line Onln1 = Onln0 - 1, - ?line case adjust_schedulers_online() of - {Onln0, Onln1} -> - ?line Onln1 = erlang:system_info(schedulers_online), - ?line receive after 500 -> ok end, - ?line ?t:format("TEST - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", - [Aff, Onln1, erlang:system_info(scheduler_bindings)]), - ?line unchanged = adjust_schedulers_online(), - ?line ok; - Fail -> - ?line ?t:fail(Fail) - end + Cpus = bits_in_mask(OldAff), + RmCpus = case Cpus > Onln0 of + true -> Cpus - Onln0 + 1; + false -> Onln0 - Cpus + 1 + end, + Onln1 = Cpus - RmCpus, + case Onln1 > 0 of + false -> + %% Nothing much to test; just a smoke test + ok; + true -> + Aff = restrict_affinity_mask(OldAff, RmCpus), + set_affinity_mask(Aff), + case adjust_schedulers_online() of + {Onln0, Onln1} -> + Onln1 = erlang:system_info(schedulers_online), + receive after 500 -> ok end, + io:format("TEST - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", + [Aff, Onln1, erlang:system_info(scheduler_bindings)]), + unchanged = adjust_schedulers_online(), + ok; + Fail -> + ct:fail(Fail) + end + end end after set_affinity_mask(OldAff), adjust_schedulers_online(), erlang:system_flag(schedulers_online, OldOnline), receive after 500 -> ok end, - ?t:format("END - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", + io:format("END - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", [get_affinity_mask(), erlang:system_info(schedulers_online), erlang:system_info(scheduler_bindings)]) end end. +bits_in_mask(Mask) -> + bits_in_mask(Mask, 0, 0). + +bits_in_mask(0, _Shift, N) -> + N; +bits_in_mask(Mask, Shift, N) -> + case Mask band (1 bsl Shift) of + 0 -> bits_in_mask(Mask, Shift+1, N); + _ -> bits_in_mask(Mask band (bnot (1 bsl Shift)), + Shift+1, N+1) + end. + +restrict_affinity_mask(Mask, N) -> + try + restrict_affinity_mask(Mask, 0, N) + catch + throw : Reason -> + exit({Reason, Mask, N}) + end. + +restrict_affinity_mask(Mask, _Shift, 0) -> + Mask; +restrict_affinity_mask(0, _Shift, _N) -> + throw(overresticted_affinity_mask); +restrict_affinity_mask(Mask, Shift, N) -> + case Mask band (1 bsl Shift) of + 0 -> restrict_affinity_mask(Mask, Shift+1, N); + _ -> restrict_affinity_mask(Mask band (bnot (1 bsl Shift)), + Shift+1, N-1) + end. + adjust_schedulers_online() -> case erlang:system_info(update_cpu_info) of unchanged -> unchanged; changed -> Avail = erlang:system_info(logical_processors_available), - {erlang:system_flag(schedulers_online, Avail), Avail} + Scheds = erlang:system_info(schedulers), + SOnln = case Avail > Scheds of + true -> Scheds; + false -> Avail + end, + {erlang:system_flag(schedulers_online, SOnln), SOnln} end. read_affinity(Data) -> Exp = "pid " ++ os:getpid() ++ "'s current affinity mask", - case string:tokens(Data, ":") of + case string:lexemes(Data, ":") of [Exp, DirtyAffinityStr] -> - AffinityStr = string:strip(string:strip(DirtyAffinityStr, - both, $ ), - both, $\n), + AffinityStr = string:trim(DirtyAffinityStr), case catch erlang:list_to_integer(AffinityStr, 16) of Affinity when is_integer(Affinity) -> Affinity; @@ -882,7 +921,7 @@ get_affinity_mask(_Port, _Status, Affinity) -> Affinity. get_affinity_mask() -> - case ?t:os_type() of + case os:type() of {unix, linux} -> case catch open_port({spawn, "taskset -p " ++ os:getpid()}, [exit_status]) of @@ -926,21 +965,21 @@ set_affinity_mask(Mask) -> end. sct_cmd(Config) when is_list(Config) -> - ?line Topology = ?TOPOLOGY_A_TERM, - ?line OldRelFlags = clear_erl_rel_flags(), + Topology = ?TOPOLOGY_A_TERM, + OldRelFlags = clear_erl_rel_flags(), try - ?line {ok, Node} = start_node(Config, ?TOPOLOGY_A_CMD), - ?line cmp(Topology, + {ok, Node} = start_node(Config, ?TOPOLOGY_A_CMD), + cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), - ?line cmp(Topology, + cmp(Topology, rpc:call(Node, erlang, system_flag, [cpu_topology, Topology])), - ?line cmp(Topology, + cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), - ?line stop_node(Node) + stop_node(Node) after restore_erl_rel_flags(OldRelFlags) end, - ?line ok. + ok. -define(BIND_TYPES, [{"u", unbound}, @@ -964,7 +1003,7 @@ sbt_cmd(Config) when is_list(Config) -> end, case Bind of notsup -> - ?line {skipped, "Binding of schedulers not supported"}; + {skipped, "Binding of schedulers not supported"}; go_for_it -> CpuTCmd = case erlang:system_info({cpu_topology,detected}) of undefined -> @@ -987,14 +1026,14 @@ sbt_cmd(Config) when is_list(Config) -> end, case CpuTCmd of false -> - ?line {skipped, "Don't know how to create cpu topology"}; + {skipped, "Don't know how to create cpu topology"}; _ -> case erlang:system_info(logical_processors) of LP when is_integer(LP) -> OldRelFlags = clear_erl_rel_flags(), try lists:foreach(fun ({ClBt, Bt}) -> - ?line sbt_test(Config, + sbt_test(Config, CpuTCmd, ClBt, Bt, @@ -1004,66 +1043,58 @@ sbt_cmd(Config) when is_list(Config) -> after restore_erl_rel_flags(OldRelFlags) end, - ?line ok; + ok; _ -> - ?line {skipped, + {skipped, "Don't know the amount of logical processors"} end end end. sbt_test(Config, CpuTCmd, ClBt, Bt, LP) -> - ?line ?t:format("Testing +sbt ~s (~p)~n", [ClBt, Bt]), - ?line LPS = integer_to_list(LP), - ?line Cmd = CpuTCmd++" +sbt "++ClBt++" +S"++LPS++":"++LPS, - ?line {ok, Node} = start_node(Config, Cmd), - ?line Bt = rpc:call(Node, + io:format("Testing +sbt ~s (~p)~n", [ClBt, Bt]), + LPS = integer_to_list(LP), + Cmd = CpuTCmd++" +sbt "++ClBt++" +S"++LPS++":"++LPS, + {ok, Node} = start_node(Config, Cmd), + Bt = rpc:call(Node, erlang, system_info, [scheduler_bind_type]), - ?line SB = rpc:call(Node, + SB = rpc:call(Node, erlang, system_info, [scheduler_bindings]), - ?line ?t:format("scheduler bindings: ~p~n", [SB]), - ?line BS = case {Bt, erlang:system_info(logical_processors_available)} of + io:format("scheduler bindings: ~p~n", [SB]), + BS = case {Bt, erlang:system_info(logical_processors_available)} of {unbound, _} -> 0; {_, Int} when is_integer(Int) -> Int; {_, _} -> LP end, - ?line lists:foldl(fun (S, 0) -> - ?line unbound = S, + lists:foldl(fun (S, 0) -> + unbound = S, 0; (S, N) -> - ?line true = is_integer(S), + true = is_integer(S), N-1 end, BS, tuple_to_list(SB)), - ?line stop_node(Node), - ?line ok. + stop_node(Node), + ok. scheduler_threads(Config) when is_list(Config) -> - SmpSupport = erlang:system_info(smp_support), {Sched, SchedOnln, _} = get_sstate(Config, ""), %% Configure half the number of both the scheduler threads and %% the scheduler threads online. - {HalfSched, HalfSchedOnln} = case SmpSupport of - false -> {1,1}; - true -> - {Sched div 2, - SchedOnln div 2} - end, + {HalfSched, HalfSchedOnln} = {lists:max([1,Sched div 2]), + lists:max([1,SchedOnln div 2])}, {HalfSched, HalfSchedOnln, _} = get_sstate(Config, "+SP 50:50"), %% Use +S to configure 4x the number of scheduler threads and %% 4x the number of scheduler threads online, but alter that %% setting using +SP to 50% scheduler threads and 25% scheduler %% threads online. The result should be 2x scheduler threads and %% 1x scheduler threads online. - TwiceSched = case SmpSupport of - false -> 1; - true -> Sched*2 - end, + TwiceSched = Sched*2, FourSched = integer_to_list(Sched*4), FourSchedOnln = integer_to_list(SchedOnln*4), CombinedCmd1 = "+S "++FourSched++":"++FourSchedOnln++" +SP50:25", @@ -1079,39 +1110,38 @@ scheduler_threads(Config) when is_list(Config) -> {Sched, HalfSchedOnln, _} = get_sstate(Config, "+SP:50"), %% Configure 2x scheduler threads only {TwiceSched, SchedOnln, _} = get_sstate(Config, "+SP 200"), - %% Test resetting the scheduler counts - ResetCmd = "+S "++FourSched++":"++FourSchedOnln++" +S 0:0", - {Sched, SchedOnln, _} = get_sstate(Config, ResetCmd), - %% Test negative +S settings, but only for SMP-enabled emulators - case SmpSupport of - false -> ok; - true -> - SchedMinus1 = Sched-1, - SchedOnlnMinus1 = SchedOnln-1, - {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1"), - {Sched, SchedOnlnMinus1, _} = get_sstate(Config, "+S :-1"), - {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1:-1") - end, - ok. + case {erlang:system_info(logical_processors), + erlang:system_info(logical_processors_available)} of + {LProc, LProcAvail} when is_integer(LProc), is_integer(LProcAvail) -> + %% Test resetting the scheduler counts + ResetCmd = "+S "++FourSched++":"++FourSchedOnln++" +S 0:0", + {LProc, LProcAvail, _} = get_sstate(Config, ResetCmd), + %% Test negative +S settings, but only for SMP-enabled emulators + case {LProc > 1, LProcAvail > 1} of + {true, true} -> + SchedMinus1 = LProc-1, + SchedOnlnMinus1 = LProcAvail-1, + {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1"), + {LProc, SchedOnlnMinus1, _} = get_sstate(Config, "+S :-1"), + {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1:-1"), + ok; + _ -> + {comment, "Skipped reduced amount of schedulers test due to too few logical processors"} + end; + _ -> %% Skipped when missing info about logical processors... + {comment, "Skipped reset amount of schedulers test, and reduced amount of schedulers test due to too unknown amount of logical processors"} + end. dirty_scheduler_threads(Config) when is_list(Config) -> - SmpSupport = erlang:system_info(smp_support), - try - erlang:system_info(dirty_cpu_schedulers), - dirty_scheduler_threads_test(Config, SmpSupport) - catch - error:badarg -> - {skipped, "No dirty scheduler support"} + case erlang:system_info(dirty_cpu_schedulers) of + 0 -> {skipped, "No dirty scheduler support"}; + _ -> dirty_scheduler_threads_test(Config) end. -dirty_scheduler_threads_test(Config, SmpSupport) -> +dirty_scheduler_threads_test(Config) -> {Sched, SchedOnln, _} = get_dsstate(Config, ""), - {HalfSched, HalfSchedOnln} = case SmpSupport of - false -> {1,1}; - true -> - {Sched div 2, - SchedOnln div 2} - end, + {HalfSched, HalfSchedOnln} = {lists:max([1,Sched div 2]), + lists:max([1,SchedOnln div 2])}, Cmd1 = "+SDcpu "++integer_to_list(HalfSched)++":"++ integer_to_list(HalfSchedOnln), {HalfSched, HalfSchedOnln, _} = get_dsstate(Config, Cmd1), @@ -1123,12 +1153,10 @@ dirty_scheduler_threads_test(Config, SmpSupport) -> ok. dirty_schedulers_online_test() -> - dirty_schedulers_online_test(erlang:system_info(smp_support)). -dirty_schedulers_online_test(false) -> ok; -dirty_schedulers_online_test(true) -> dirty_schedulers_online_smp_test(erlang:system_info(schedulers_online)). dirty_schedulers_online_smp_test(SchedOnln) when SchedOnln < 4 -> ok; dirty_schedulers_online_smp_test(SchedOnln) -> + receive after 500 -> ok end, DirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online), SchedOnln = DirtyCPUSchedOnln, HalfSchedOnln = SchedOnln div 2, @@ -1137,9 +1165,11 @@ dirty_schedulers_online_smp_test(SchedOnln) -> HalfDirtyCPUSchedOnln = erlang:system_flag(schedulers_online, SchedOnln), DirtyCPUSchedOnln = erlang:system_flag(dirty_cpu_schedulers_online, HalfDirtyCPUSchedOnln), + receive after 500 -> ok end, HalfDirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online), QrtrDirtyCPUSchedOnln = HalfDirtyCPUSchedOnln div 2, SchedOnln = erlang:system_flag(schedulers_online, HalfSchedOnln), + receive after 500 -> ok end, QrtrDirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online), ok. @@ -1165,50 +1195,184 @@ get_dsstate(Config, Cmd) -> stop_node(Node), {DSCPU, DSCPUOnln, DSIO}. +scheduler_suspend_basic(Config) when is_list(Config) -> + case erlang:system_info(multi_scheduling) of + disabled -> + {skip, "Nothing to test"}; + _ -> + Onln = erlang:system_info(schedulers_online), + try + scheduler_suspend_basic_test() + after + erlang:system_flag(schedulers_online, Onln) + end + end. + +scheduler_suspend_basic_test() -> + %% The receives after setting scheduler states are there + %% since the operation is not fully synchronous. For example, + %% we do not wait for dirty cpu schedulers online to complete + %% before returning from erlang:system_flag(schedulers_online, _). + + erlang:system_flag(schedulers_online, + erlang:system_info(schedulers)), + try + erlang:system_flag(dirty_cpu_schedulers_online, + erlang:system_info(dirty_cpu_schedulers)), + receive after 500 -> ok end + catch + _ : _ -> + ok + end, + + S0 = sched_state(), + io:format("~p~n", [S0]), + {{normal,NTot0,NOnln0,NAct0}, + {dirty_cpu,DCTot0,DCOnln0,DCAct0}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = S0, + enabled = erlang:system_info(multi_scheduling), + + DCOne = case DCTot0 of + 0 -> 0; + _ -> 1 + end, + + blocked_normal = erlang:system_flag(multi_scheduling, block_normal), + blocked_normal = erlang:system_info(multi_scheduling), + {{normal,NTot0,NOnln0,1}, + {dirty_cpu,DCTot0,DCOnln0,DCAct0}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + NOnln0 = erlang:system_flag(schedulers_online, 1), + receive after 500 -> ok end, + {{normal,NTot0,1,1}, + {dirty_cpu,DCTot0,DCOne,DCOne}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + 1 = erlang:system_flag(schedulers_online, NOnln0), + receive after 500 -> ok end, + {{normal,NTot0,NOnln0,1}, + {dirty_cpu,DCTot0,DCOnln0,DCAct0}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + blocked = erlang:system_flag(multi_scheduling, block), + blocked = erlang:system_info(multi_scheduling), + receive after 500 -> ok end, + {{normal,NTot0,NOnln0,1}, + {dirty_cpu,DCTot0,DCOnln0,0}, + {dirty_io,DITot0,DIOnln0,0}} = sched_state(), + + NOnln0 = erlang:system_flag(schedulers_online, 1), + receive after 500 -> ok end, + {{normal,NTot0,1,1}, + {dirty_cpu,DCTot0,DCOne,0}, + {dirty_io,DITot0,DIOnln0,0}} = sched_state(), + + 1 = erlang:system_flag(schedulers_online, NOnln0), + receive after 500 -> ok end, + {{normal,NTot0,NOnln0,1}, + {dirty_cpu,DCTot0,DCOnln0,0}, + {dirty_io,DITot0,DIOnln0,0}} = sched_state(), + + blocked = erlang:system_flag(multi_scheduling, unblock_normal), + blocked = erlang:system_info(multi_scheduling), + {{normal,NTot0,NOnln0,1}, + {dirty_cpu,DCTot0,DCOnln0,0}, + {dirty_io,DITot0,DIOnln0,0}} = sched_state(), + + enabled = erlang:system_flag(multi_scheduling, unblock), + enabled = erlang:system_info(multi_scheduling), + receive after 500 -> ok end, + {{normal,NTot0,NOnln0,NAct0}, + {dirty_cpu,DCTot0,DCOnln0,DCAct0}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + NOnln0 = erlang:system_flag(schedulers_online, 1), + receive after 500 -> ok end, + {{normal,NTot0,1,1}, + {dirty_cpu,DCTot0,DCOne,DCOne}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + 1 = erlang:system_flag(schedulers_online, NOnln0), + receive after 500 -> ok end, + {{normal,NTot0,NOnln0,NAct0}, + {dirty_cpu,DCTot0,DCOnln0,DCAct0}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + ok. + + scheduler_suspend(Config) when is_list(Config) -> - ?line Dog = ?t:timetrap(?t:minutes(5)), - ?line lists:foreach(fun (S) -> scheduler_suspend_test(Config, S) end, + ct:timetrap({minutes, 5}), + lists:foreach(fun (S) -> scheduler_suspend_test(Config, S) end, [64, 32, 16, default]), - ?line ?t:timetrap_cancel(Dog), - ?line ok. + ok. scheduler_suspend_test(Config, Schedulers) -> - ?line Cmd = case Schedulers of + Cmd = case Schedulers of default -> ""; _ -> S = integer_to_list(Schedulers), "+S"++S++":"++S end, - ?line {ok, Node} = start_node(Config, Cmd), - ?line [SState] = mcall(Node, [fun () -> - erlang:system_info(schedulers_state) - end]), - ?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]), - ?line [ok] = mcall(Node, [fun () -> sst2_loop(300) end]), - ?line [ok, ok, ok, ok, ok] = mcall(Node, - [fun () -> sst0_loop(200) end, - fun () -> sst1_loop(200) end, - fun () -> sst2_loop(200) end, - 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), - ?line ok. - + {ok, Node} = start_node(Config, Cmd), + [SState] = mcall(Node, [fun () -> + erlang:system_info(schedulers_state) + end]), + + io:format("SState=~p~n", [SState]), + {Sched, SchedOnln, _SchedAvail} = SState, + true = is_integer(Sched), + [ok] = mcall(Node, [fun () -> sst0_loop(300) end]), + [ok] = mcall(Node, [fun () -> sst1_loop(300) end]), + [ok] = mcall(Node, [fun () -> sst2_loop(300) end]), + [ok] = mcall(Node, [fun () -> sst4_loop(300) end]), + [ok] = mcall(Node, [fun () -> sst5_loop(300) end]), + [ok, ok, ok, ok, + ok, ok, ok] = mcall(Node, + [fun () -> sst0_loop(200) end, + fun () -> sst1_loop(200) end, + fun () -> sst2_loop(200) end, + fun () -> sst2_loop(200) end, + fun () -> sst3_loop(Sched, 200) end, + fun () -> sst4_loop(200) end, + fun () -> sst5_loop(200) end]), + [SState] = mcall(Node, [fun () -> + case Sched == SchedOnln of + false -> + Sched = erlang:system_flag( + schedulers_online, + SchedOnln); + true -> + ok + end, + until(fun () -> + {_A, B, C} = erlang:system_info( + schedulers_state), + B == C + end, + erlang:monotonic_time() + + erlang:convert_time_unit(1, + seconds, + native)), + erlang:system_info(schedulers_state) + end]), + stop_node(Node), + ok. + +until(Pred, MaxTime) -> + case Pred() of + true -> + true; + false -> + case erlang:monotonic_time() > MaxTime of + true -> + false; + false -> + receive after 100 -> ok end, + until(Pred, MaxTime) + end + end. sst0_loop(0) -> ok; @@ -1237,12 +1401,9 @@ sst2_loop(N) -> sst2_loop(N-1). sst3_loop(S, N) -> - try erlang:system_info(dirty_cpu_schedulers) of - DS -> - sst3_loop_with_dirty_schedulers(S, DS, N) - catch - error:badarg -> - sst3_loop_normal_schedulers_only(S, N) + case erlang:system_info(dirty_cpu_schedulers) of + 0 -> sst3_loop_normal_schedulers_only(S, N); + DS -> sst3_loop_with_dirty_schedulers(S, DS, N) end. sst3_loop_normal_schedulers_only(_S, 0) -> @@ -1271,270 +1432,356 @@ sst3_loop_with_dirty_schedulers(S, DS, N) -> erlang:system_flag(dirty_cpu_schedulers_online, DS), sst3_loop_with_dirty_schedulers(S, DS, N-1). +sst4_loop(0) -> + ok; +sst4_loop(N) -> + erlang:system_flag(multi_scheduling, block_normal), + erlang:system_flag(multi_scheduling, unblock_normal), + sst4_loop(N-1). + +sst5_loop(0) -> + ok; +sst5_loop(N) -> + erlang:system_flag(multi_scheduling, block_normal), + erlang:system_flag(multi_scheduling, unblock_normal), + sst5_loop(N-1). + +poll_threads(Config) when is_list(Config) -> + {Conc, PollType, KP} = get_ioconfig(Config), + {Sched, SchedOnln, _} = get_sstate(Config, ""), + + [1, 1] = get_ionum(Config,"+IOt 2 +IOp 2"), + [1, 1, 1, 1, 1] = get_ionum(Config,"+IOt 5 +IOp 5"), + + [1, 1] = get_ionum(Config, "+S 2 +IOPt 100 +IOPp 100"), + + if + Conc -> + [5] = get_ionum(Config,"+IOt 5 +IOp 1"), + [3, 2] = get_ionum(Config,"+IOt 5 +IOp 2"), + [2, 2, 2, 2, 2] = get_ionum(Config,"+IOt 10 +IOPp 50"), + + [2] = get_ionum(Config, "+S 2 +IOPt 100"), + [4] = get_ionum(Config, "+S 4 +IOPt 100"), + [4] = get_ionum(Config, "+S 4:2 +IOPt 100"), + [4, 4] = get_ionum(Config, "+S 8 +IOPt 100 +IOPp 25"), + + fail = get_ionum(Config, "+IOt 1 +IOp 2"), + + ok; + not Conc -> + [1, 1, 1, 1, 1] = get_ionum(Config,"+IOt 5 +IOp 1"), + [1, 1, 1, 1, 1] = get_ionum(Config,"+IOt 5 +IOp 2"), + [1, 1, 1, 1, 1, 1, 1, 1, 1, 1] = get_ionum(Config,"+IOt 10 +IOPp 50"), + + [1, 1] = get_ionum(Config, "+S 2 +IOPt 100"), + [1, 1, 1, 1] = get_ionum(Config, "+S 4 +IOPt 100"), + [1, 1, 1, 1] = get_ionum(Config, "+S 4:2 +IOPt 100"), + [1, 1, 1, 1, 1, 1, 1, 1] = get_ionum(Config, "+S 8 +IOPt 100 +IOPp 25"), + + [1] = get_ionum(Config, "+IOt 1 +IOp 2"), + + ok + end, + + fail = get_ionum(Config, "+IOt 1 +IOPp 101"), + fail = get_ionum(Config, "+IOt 0"), + fail = get_ionum(Config, "+IOPt 101"), + + ok. + +get_ioconfig(Config) -> + [PS | _] = get_iostate(Config, ""), + {proplists:get_value(concurrent_updates, PS), + proplists:get_value(primary, PS), + proplists:get_value(kernel_poll, PS)}. + +get_ionum(Config, Cmd) -> + case get_iostate(Config, Cmd) of + fail -> fail; + PSs -> + lists:reverse( + lists:sort( + [proplists:get_value(poll_threads, PS) || PS <- PSs])) + end. + +get_iostate(Config, Cmd)-> + case start_node(Config, Cmd) of + {ok, Node} -> + [IOStates] = mcall(Node,[fun () -> + erlang:system_info(check_io) + end]), + IO = [IOState || IOState <- IOStates, + proplists:get_value(fallback, IOState) == false], + stop_node(Node), + IO; + {error,timeout} -> + fail + end. + 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), + {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}}]}]}], + + [{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), + 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))])])])], + + [{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), + + [{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), + + [{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), + + [{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), + + 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))])], + + [{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), + + + [{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), + + [{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), + + [{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), + + [{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), + + [{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), + + [{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), + + [{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))])], + 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), + [{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. + 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))])], + + [{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), + + [{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), + + [{0,1},{65535,2}] = reader_groups_map([c(l(0)),c(l(65535))], 10), + ok. reader_groups_map(CPUT, Groups) -> @@ -1549,6 +1796,34 @@ reader_groups_map(CPUT, Groups) -> %% Utils %% +sched_state() -> + sched_state(erlang:system_info(all_schedulers_state), + undefined, + {dirty_cpu,0,0,0}, + {dirty_io,0,0,0}). + + +sched_state([], N, DC, DI) -> + try + chk_basic(N), + chk_basic(DC), + chk_basic(DI), + {N, DC, DI} + catch + _ : _ -> + ct:fail({inconsisten_scheduler_state, {N, DC, DI}}) + end; +sched_state([{normal, _, _, _} = S | Rest], _S, DC, DI) -> + sched_state(Rest, S, DC, DI); +sched_state([{dirty_cpu, _, _, _} = DC | Rest], S, _DC, DI) -> + sched_state(Rest, S, DC, DI); +sched_state([{dirty_io, _, _, _} = DI | Rest], S, DC, _DI) -> + sched_state(Rest, S, DC, DI). + +chk_basic({_Type, Tot, Onln, Act}) -> + true = Tot >= Onln, + true = Onln >= Act. + l(Id) -> {logical, Id}. @@ -1567,21 +1842,27 @@ n(X) -> mcall(Node, Funs) -> Parent = self(), Refs = lists:map(fun (Fun) -> - Ref = make_ref(), - spawn_link(Node, - fun () -> - Res = Fun(), - unlink(Parent), - Parent ! {Ref, Res} - end), - Ref - end, Funs), - lists:map(fun (Ref) -> - receive - {Ref, Res} -> - Res - end - end, Refs). + Ref = make_ref(), + Pid = spawn(Node, + fun () -> + Res = Fun(), + unlink(Parent), + Parent ! {Ref, Res} + end), + MRef = erlang:monitor(process, Pid), + {Ref, MRef} + end, Funs), + lists:map(fun ({Ref, MRef}) -> + receive + {Ref, Res} -> + receive + {'DOWN',MRef,_,_,_} -> + Res + end; + {'DOWN',MRef,_,_,Reason} -> + Reason + end + end, Refs). erl_rel_flag_var() -> "ERL_OTP"++erlang:system_info(otp_release)++"_FLAGS". @@ -1605,101 +1886,101 @@ restore_erl_rel_flags(OldValue) -> ok(too_slow, _Config) -> {comment, "Too slow system to do any actual testing..."}; ok(_Res, Config) -> - ?config(ok_res, Config). + proplists:get_value(ok_res, Config). chk_result(too_slow, - _LWorkers, - _NWorkers, - _HWorkers, - _MWorkers, - _LNShouldWork, - _HShouldWork, - _MShouldWork) -> - ?line ok; + _LWorkers, + _NWorkers, + _HWorkers, + _MWorkers, + _LNShouldWork, + _HShouldWork, + _MShouldWork) -> + ok; chk_result([{low, L, Lmin, _Lmax}, - {normal, N, Nmin, _Nmax}, - {high, H, Hmin, _Hmax}, - {max, M, Mmin, _Mmax}] = Res, - LWorkers, - NWorkers, - HWorkers, - MWorkers, - LNShouldWork, - HShouldWork, - MShouldWork) -> - ?line ?t:format("~p~n", [Res]), - ?line Relax = relax_limits(), + {normal, N, Nmin, _Nmax}, + {high, H, Hmin, _Hmax}, + {max, M, Mmin, _Mmax}] = Res, + LWorkers, + NWorkers, + HWorkers, + MWorkers, + LNShouldWork, + HShouldWork, + MShouldWork) -> + io:format("~p~n", [Res]), + Relax = relax_limits(), case {L, N} of - {0, 0} -> - ?line false = LNShouldWork; - _ -> - ?line {LminRatioLim, - NminRatioLim, - LNRatioLimMin, - LNRatioLimMax} = case Relax of - false -> {0.5, 0.5, 0.05, 0.25}; - true -> {0.05, 0.05, 0.01, 0.4} - end, - ?line Lavg = L/LWorkers, - ?line Navg = N/NWorkers, - ?line Ratio = Lavg/Navg, - ?line LminRatio = Lmin/Lavg, - ?line NminRatio = Nmin/Navg, - ?line ?t:format("low min ratio=~p~n" - "normal min ratio=~p~n" - "low avg=~p~n" - "normal avg=~p~n" - "low/normal ratio=~p~n", - [LminRatio, NminRatio, Lavg, Navg, Ratio]), - erlang:display({low_min_ratio, LminRatio}), - erlang:display({normal_min_ratio, NminRatio}), - erlang:display({low_avg, Lavg}), - erlang:display({normal_avg, Navg}), - erlang:display({low_normal_ratio, Ratio}), - ?line chk_lim(LminRatioLim, LminRatio, 1.0, low_min_ratio), - ?line chk_lim(NminRatioLim, NminRatio, 1.0, normal_min_ratio), - ?line chk_lim(LNRatioLimMin, Ratio, LNRatioLimMax, low_normal_ratio), - ?line true = LNShouldWork, - ?line ok + {0, 0} -> + false = LNShouldWork; + _ -> + {LminRatioLim, + NminRatioLim, + LNRatioLimMin, + LNRatioLimMax} = case Relax of + false -> {0.5, 0.5, 0.05, 0.25}; + true -> {0.05, 0.05, 0.01, 0.4} + end, + Lavg = L/LWorkers, + Navg = N/NWorkers, + Ratio = Lavg/Navg, + LminRatio = Lmin/Lavg, + NminRatio = Nmin/Navg, + io:format("low min ratio=~p~n" + "normal min ratio=~p~n" + "low avg=~p~n" + "normal avg=~p~n" + "low/normal ratio=~p~n", + [LminRatio, NminRatio, Lavg, Navg, Ratio]), + erlang:display({low_min_ratio, LminRatio}), + erlang:display({normal_min_ratio, NminRatio}), + erlang:display({low_avg, Lavg}), + erlang:display({normal_avg, Navg}), + erlang:display({low_normal_ratio, Ratio}), + chk_lim(LminRatioLim, LminRatio, 1.0, low_min_ratio), + chk_lim(NminRatioLim, NminRatio, 1.0, normal_min_ratio), + chk_lim(LNRatioLimMin, Ratio, LNRatioLimMax, low_normal_ratio), + true = LNShouldWork, + ok end, case H of - 0 -> - ?line false = HShouldWork; - _ -> - ?line HminRatioLim = case Relax of - false -> 0.5; - true -> 0.1 - end, - ?line Havg = H/HWorkers, - ?line HminRatio = Hmin/Havg, - erlang:display({high_min_ratio, HminRatio}), - ?line chk_lim(HminRatioLim, HminRatio, 1.0, high_min_ratio), - ?line true = HShouldWork, - ?line ok + 0 -> + false = HShouldWork; + _ -> + HminRatioLim = case Relax of + false -> 0.5; + true -> 0.1 + end, + Havg = H/HWorkers, + HminRatio = Hmin/Havg, + erlang:display({high_min_ratio, HminRatio}), + chk_lim(HminRatioLim, HminRatio, 1.0, high_min_ratio), + true = HShouldWork, + ok end, case M of - 0 -> - ?line false = MShouldWork; - _ -> - ?line MminRatioLim = case Relax of - false -> 0.5; - true -> 0.1 - end, - ?line Mavg = M/MWorkers, - ?line MminRatio = Mmin/Mavg, - erlang:display({max_min_ratio, MminRatio}), - ?line chk_lim(MminRatioLim, MminRatio, 1.0, max_min_ratio), - ?line true = MShouldWork, - ?line ok + 0 -> + false = MShouldWork; + _ -> + MminRatioLim = case Relax of + false -> 0.5; + true -> 0.1 + end, + Mavg = M/MWorkers, + MminRatio = Mmin/Mavg, + erlang:display({max_min_ratio, MminRatio}), + chk_lim(MminRatioLim, MminRatio, 1.0, max_min_ratio), + true = MShouldWork, + ok end, - ?line ok. + ok. chk_lim(Min, V, Max, _What) when Min =< V, V =< Max -> ok; chk_lim(_Min, V, _Max, What) -> - ?t:fail({bad, What, V}). + ct:fail({bad, What, V}). snd(_Msg, []) -> []; @@ -1710,7 +1991,7 @@ snd(Msg, [P|Ps]) -> relax_limits() -> case strange_system_scale() of Scale when Scale > 1 -> - ?t:format("Relaxing limits~n", []), + io:format("Relaxing limits~n", []), true; _ -> false @@ -1829,14 +2110,14 @@ do_it(Tracer, Low, Normal, High, Max) -> do_it(Tracer, Low, Normal, High, Max, RedsPerSchedLimit) -> OldPrio = process_flag(priority, max), go_work(Low, Normal, High, Max), - StartWait = now(), + StartWait = erlang:monotonic_time(millisecond), %% Give the emulator a chance to balance the load... wait_balance(5), - EndWait = now(), - BalanceWait = timer:now_diff(EndWait,StartWait) div 1000, + EndWait = erlang:monotonic_time(millisecond), + BalanceWait = EndWait-StartWait, erlang:display({balance_wait, BalanceWait}), - Timeout = ?DEFAULT_TIMEOUT - ?t:minutes(4) - BalanceWait, - Res = case Timeout < ?MIN_SCHEDULER_TEST_TIMEOUT of + Timeout = (15 - 4)*60*1000 - BalanceWait, + Res = case Timeout < 60*1000 of true -> stop_work(Low, Normal, High, Max), too_slow; @@ -1906,55 +2187,55 @@ part_time_workers(N, Prio) -> tracer(Low, Normal, High, Max) -> receive - {tracees, Prio, Tracees} -> - save_tracees(Prio, Tracees), - case Prio of - low -> tracer(Tracees++Low, Normal, High, Max); - normal -> tracer(Low, Tracees++Normal, High, Max); - high -> tracer(Low, Normal, Tracees++High, Max); - max -> tracer(Low, Normal, High, Tracees++Max) - end; - {get_result, Ref, Who} -> - Delivered = erlang:trace_delivered(all), - receive - {trace_delivered, all, Delivered} -> - ok - end, - {Lc, Nc, Hc, Mc} = read_trace(), - GetMinMax - = fun (Prio, Procs) -> - LargeNum = 1 bsl 64, - case lists:foldl(fun (P, {Mn, Mx} = MnMx) -> - {Prio, C} = get(P), - case C < Mn of - true -> - case C > Mx of - true -> - {C, C}; - false -> - {C, Mx} - end; - false -> - case C > Mx of - true -> {Mn, C}; - false -> MnMx - end - end - end, - {LargeNum, 0}, - Procs) of - {LargeNum, 0} -> {0, 0}; - Res -> Res - end - end, - {Lmin, Lmax} = GetMinMax(low, Low), - {Nmin, Nmax} = GetMinMax(normal, Normal), - {Hmin, Hmax} = GetMinMax(high, High), - {Mmin, Mmax} = GetMinMax(max, Max), - Who ! {trace_result, Ref, [{low, Lc, Lmin, Lmax}, - {normal, Nc, Nmin, Nmax}, - {high, Hc, Hmin, Hmax}, - {max, Mc, Mmin, Mmax}]} + {tracees, Prio, Tracees} -> + save_tracees(Prio, Tracees), + case Prio of + low -> tracer(Tracees++Low, Normal, High, Max); + normal -> tracer(Low, Tracees++Normal, High, Max); + high -> tracer(Low, Normal, Tracees++High, Max); + max -> tracer(Low, Normal, High, Tracees++Max) + end; + {get_result, Ref, Who} -> + Delivered = erlang:trace_delivered(all), + receive + {trace_delivered, all, Delivered} -> + ok + end, + {Lc, Nc, Hc, Mc} = read_trace(), + GetMinMax + = fun (Prio, Procs) -> + LargeNum = 1 bsl 64, + case lists:foldl(fun (P, {Mn, Mx} = MnMx) -> + {Prio, C} = get(P), + case C < Mn of + true -> + case C > Mx of + true -> + {C, C}; + false -> + {C, Mx} + end; + false -> + case C > Mx of + true -> {Mn, C}; + false -> MnMx + end + end + end, + {LargeNum, 0}, + Procs) of + {LargeNum, 0} -> {0, 0}; + Res -> Res + end + end, + {Lmin, Lmax} = GetMinMax(low, Low), + {Nmin, Nmax} = GetMinMax(normal, Normal), + {Hmin, Hmax} = GetMinMax(high, High), + {Mmin, Mmax} = GetMinMax(max, Max), + Who ! {trace_result, Ref, [{low, Lc, Lmin, Lmax}, + {normal, Nc, Nmin, Nmax}, + {high, Hc, Hmin, Hmax}, + {max, Mc, Mmin, Mmax}]} end. read_trace() -> @@ -2027,21 +2308,18 @@ start_node(Config) -> start_node(Config, ""). start_node(Config, Args) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), - ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). enable_internal_state() -> @@ -2053,7 +2331,7 @@ enable_internal_state() -> cmp(X, X) -> ok; cmp(X, Y) -> - ?t:format("cmp failed:~n X=~p~n Y=~p~n", [X,Y]), + io:format("cmp failed:~n X=~p~n Y=~p~n", [X,Y]), cmp_aux(X, Y). @@ -2065,7 +2343,7 @@ cmp_aux(T0, T1) when is_tuple(T0), is_tuple(T1), size(T0) == size(T1) -> cmp_aux(X, X) -> ok; cmp_aux(F0, F1) -> - ?t:fail({no_match, F0, F1}). + ct:fail({no_match, F0, F1}). cmp_tuple(_T0, _T1, N, Sz) when N > Sz -> ok; diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl index 8e1f8df43a..8afe4e4ac1 100644 --- a/erts/emulator/test/send_term_SUITE.erl +++ b/erts/emulator/test/send_term_SUITE.erl @@ -1,67 +1,44 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2014. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(send_term_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,basic/1]). --export([init_per_testcase/2,end_per_testcase/2]). +-export([all/0, suite/0, basic/1]). -export([generate_external_terms_files/1]). --include_lib("test_server/include/test_server.hrl"). - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. +-include_lib("common_test/include/ct.hrl"). -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [basic]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - basic(Config) when is_list(Config) -> Drv = "send_term_drv", - ?line P = start_driver(Config, Drv), + P = start_driver(Config, Drv), - ?line [] = term(P, 0), - ?line Self = self(), + [] = term(P, 0), + Self = self(), {blurf,42,[],[-42,{}|"abc"++P],"kalle",3.1416,Self,#{}} = term(P, 1), Map41 = maps:from_list([{blurf, 42}, @@ -75,36 +52,36 @@ basic(Config) when is_list(Config) -> {3.1416, Self}, {#{}, blurf}]), Map42 = term(P, 42), - ?line Deep = lists:seq(0, 199), - ?line Deep = term(P, 2), - ?line {B1,B2} = term(P, 3), - ?line B1 = list_to_binary(lists:seq(0, 255)), - ?line B2 = list_to_binary(lists:seq(23, 255-17)), + Deep = lists:seq(0, 199), + Deep = term(P, 2), + {B1,B2} = term(P, 3), + B1 = list_to_binary(lists:seq(0, 255)), + B2 = list_to_binary(lists:seq(23, 255-17)), %% Pid sending. We need another process. - ?line Child = spawn_link(fun() -> + Child = spawn_link(fun() -> erlang:port_command(P, [4]) end), - ?line {Self,Child} = receive_any(), + {Self,Child} = receive_any(), %% ERL_DRV_EXT2TERM - ?line ExpectExt2Term = expected_ext2term_drv(?config(data_dir, Config)), - ?line ExpectExt2Term = term(P, 5), + ExpectExt2Term = expected_ext2term_drv(proplists:get_value(data_dir, Config)), + ExpectExt2Term = term(P, 5), %% ERL_DRV_INT, ERL_DRV_UINT - ?line case erlang:system_info({wordsize, external}) of + case erlang:system_info({wordsize, external}) of 4 -> - ?line {-1, 4294967295} = term(P, 6); + {-1, 4294967295} = term(P, 6); 8 -> - ?line {-1, 18446744073709551615} = term(P, 6) + {-1, 18446744073709551615} = term(P, 6) end, %% ERL_DRV_BUF2BINARY - ?line ExpectedBinTup = {<<>>, + ExpectedBinTup = {<<>>, <<>>, list_to_binary(lists:duplicate(17,17)), list_to_binary(lists:duplicate(1024,17))}, - ?line ExpectedBinTup = term(P, 7), + ExpectedBinTup = term(P, 7), %% single terms Singles = [{[], 8}, % ERL_DRV_NIL @@ -139,35 +116,34 @@ basic(Config) when is_list(Config) -> {-20233590931456, 38}, % ERL_DRV_INT64 {-9223372036854775808, 39}, {#{}, 40}], % ERL_DRV_MAP - ?line {Terms, Ops} = lists:unzip(Singles), - ?line Terms = term(P,Ops), + {Terms, Ops} = lists:unzip(Singles), + Terms = term(P,Ops), AFloat = term(P, 26), % ERL_DRV_FLOAT - ?line true = AFloat < 0.001, - ?line true = AFloat > -0.001, + true = AFloat < 0.001, + true = AFloat > -0.001, %% Failure cases. - ?line [] = term(P, 127), - ?line receive + [] = term(P, 127), + receive Any -> - ?line io:format("Unexpected: ~p\n", [Any]), - ?line ?t:fail() + ct:fail("Unexpected: ~p\n", [Any]) after 0 -> ok end, - ?line ok = chk_temp_alloc(), + ok = chk_temp_alloc(), %% In a private heap system, verify that there are no binaries %% left for the process. - ?line erlang:garbage_collect(), %Get rid of binaries. + erlang:garbage_collect(), %Get rid of binaries. case erlang:system_info(heap_type) of private -> - ?line {binary,[]} = process_info(self(), binary); + {binary,[]} = process_info(self(), binary); _ -> ok end, - ?line stop_driver(P, Drv), + stop_driver(P, Drv), ok. term(P, Op) -> @@ -183,28 +159,28 @@ chk_temp_alloc() -> case erlang:system_info({allocator,temp_alloc}) of false -> %% Temp alloc is not enabled - ?line ok; + ok; TIL -> %% Verify that we havn't got anything allocated by temp_alloc lists:foreach( fun ({instance, _, TI}) -> - ?line {value, {mbcs, MBCInfo}} + {value, {mbcs, MBCInfo}} = lists:keysearch(mbcs, 1, TI), - ?line {value, {blocks, 0, _, _}} + {value, {blocks, 0, _, _}} = lists:keysearch(blocks, 1, MBCInfo), - ?line {value, {sbcs, SBCInfo}} + {value, {sbcs, SBCInfo}} = lists:keysearch(sbcs, 1, TI), - ?line {value, {blocks, 0, _, _}} + {value, {blocks, 0, _, _}} = lists:keysearch(blocks, 1, SBCInfo) end, TIL), - ?line ok + ok end. %% Start/stop drivers. start_driver(Config, Name) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), ok = load_driver(Path, Name), open_port({spawn, Name}, []). @@ -218,17 +194,17 @@ load_driver(Dir, Driver) -> end. stop_driver(Port, Name) -> - ?line true = erlang:port_close(Port), + true = erlang:port_close(Port), receive {Port,Message} -> - ?t:fail({strange_message_from_port,Message}) + ct:fail({strange_message_from_port,Message}) after 0 -> ok end, %% Unload the driver. ok = erl_ddll:unload_driver(Name), - ?line ok = erl_ddll:stop(). + ok = erl_ddll:stop(). get_external_terms(DataDir) -> {ok, Bin} = file:read_file([DataDir, "ext_terms.bin"]), @@ -260,34 +236,36 @@ generate_external_terms_files(BaseDir) -> RPort = hd(rpc:call(Node, erlang, ports, [])), true = is_port(RPort), slave:stop(Node), - Terms = - [{4711, -4711, [an_atom, "a list"]}, - [1000000000000000000000,-1111111111111111, "blupp!", blipp], - {RPid, {RRef, RPort}, self(), hd(erlang:ports()), make_ref()}, - {{}, [], [], fun () -> ok end, <<"hej hopp trallalaaaaaaaaaaaaaaa">>}, - [44444444444444444444444,-44444444444, "b!", blippppppp], - {4711, RPid, {RRef, RPort}, -4711, [an_atom, "a list"]}, - {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())}, - {4711, -4711, [an_atom, "a list"]}, - {4711, -4711, [atom, "list"]}, - {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())}, - {4444444444444444444,-44444, {{{{{{{{{{{{}}}}}}}}}}}}, make_ref()}, - {444444444444444444444,-44444, [[[[[[[[[[[1]]]]]]]]]]], make_ref()}, - {444444444444444444,-44444, {{{{{{{{{{{{2}}}}}}}}}}}}, make_ref()}, - {4444444444444444444444,-44444, {{{{{{{{{{{{3}}}}}}}}}}}}, make_ref()}, - {44444444444444444444,-44444, {{{{{{{{{{{{4}}}}}}}}}}}}, make_ref()}, - {4444444444444444,-44444, [[[[[[[[[[[5]]]]]]]]]]], make_ref()}, - {444444444444444444444,-44444, {{{{{{{{{{{{6}}}}}}}}}}}}, make_ref()}, - {444444444444444,-44444, {{{{{{{{{{{{7}}}}}}}}}}}}, make_ref()}, - {4444444444444444444,-44444, {{{{{{{{{{{{8}}}}}}}}}}}}, make_ref()}], + Terms = [{4711, -4711, [an_atom, "a list"]}, + [1000000000000000000000,-1111111111111111, "blupp!", blipp], + {RPid, {RRef, RPort}, self(), hd(erlang:ports()), make_ref()}, + {{}, [], [], fun () -> ok end, <<"hej hopp trallalaaaaaaaaaaaaaaa">>}, + [44444444444444444444444,-44444444444, "b!", blippppppp], + {4711, RPid, {RRef, RPort}, -4711, [an_atom, "a list"]}, + {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())}, + {4711, -4711, [an_atom, "a list"]}, + {4711, -4711, [atom, "list"]}, + {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())}, + {4444444444444444444,-44444, {{{{{{{{{{{{}}}}}}}}}}}}, make_ref()}, + {444444444444444444444,-44444, [[[[[[[[[[[1]]]]]]]]]]], make_ref()}, + {444444444444444444,-44444, {{{{{{{{{{{{2}}}}}}}}}}}}, make_ref()}, + {4444444444444444444444,-44444, {{{{{{{{{{{{3}}}}}}}}}}}}, make_ref()}, + {44444444444444444444,-44444, {{{{{{{{{{{{4}}}}}}}}}}}}, make_ref()}, + {4444444444444444,-44444, [[[[[[[[[[[5]]]]]]]]]]], make_ref()}, + {444444444444444444444,-44444, {{{{{{{{{{{{6}}}}}}}}}}}}, make_ref()}, + {444444444444444,-44444, {{{{{{{{{{{{7}}}}}}}}}}}}, make_ref()}, + {4444444444444444444,-44444, {{{{{{{{{{{{8}}}}}}}}}}}}, make_ref()}, + #{}, + #{1 => 11, 2 => 22, 3 => 33}, + maps:from_list([{K,K*11} || K <- lists:seq(1,100)])], ok = file:write_file(filename:join([BaseDir, - "send_term_SUITE_data", - "ext_terms.bin"]), - term_to_binary(Terms, [compressed])), + "send_term_SUITE_data", + "ext_terms.bin"]), + term_to_binary(Terms, [compressed])), {ok, IoDev} = file:open(filename:join([BaseDir, - "send_term_SUITE_data", - "ext_terms.h"]), - [write]), + "send_term_SUITE_data", + "ext_terms.h"]), + [write]), write_ext_terms_h(IoDev, Terms), file:close(IoDev). @@ -297,12 +275,12 @@ write_ext_terms_h(IoDev, Terms) -> io:format(IoDev, "#define EXT_TERMS_H__~n",[]), {ExtTerms, MaxSize} = make_ext_terms(Terms), io:format(IoDev, - "static struct {~n" - " unsigned char ext[~p];~n" - " int ext_size;~n" - " unsigned char cext[~p];~n" - " int cext_size;~n" - "} ext_terms[] = {~n",[MaxSize, MaxSize]), + "static struct {~n" + " unsigned char ext[~p];~n" + " int ext_size;~n" + " unsigned char cext[~p];~n" + " int cext_size;~n" + "} ext_terms[] = {~n",[MaxSize, MaxSize]), E = write_ext_terms_h(IoDev, ExtTerms, 0), io:format(IoDev, "};~n",[]), io:format(IoDev, "#define NO_OF_EXT_TERMS ~p~n", [E]), @@ -354,16 +332,17 @@ write_bytes(IoDev, Prefix, [B|Bs], N) -> write_bytes(IoDev, ",", Bs, N+1). write_license(IoDev) -> - S = "/* ``The contents of this file are subject to the Erlang Public License,~n" - " * Version 1.1, (the \"License\"); you may not use this file except in~n" - " * compliance with the License. You should have received a copy of the~n" - " * Erlang Public License along with this software. If not, it can be~n" - " * retrieved via the world wide web at http://www.erlang.org/.~n" - " * ~n" - " * Software distributed under the License is distributed on an \"AS IS\"~n" - " * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See~n" - " * the License for the specific language governing rights and limitations~n" - " * under the License.~n" + S = "/* ``Licensed under the Apache License, Version 2.0 (the \"License\");~n" + " * you may not use this file except in compliance with the License.~n" + " * You may obtain a copy of the License at~n" + " * ~n" + " * http://www.apache.org/licenses/LICENSE-2.0~n" + " * ~n" + " * Unless required by applicable law or agreed to in writing, software~n" + " * distributed under the License is distributed on an \"AS IS\" BASIS,~n" + " * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.~n" + " * See the License for the specific language governing permissions and~n" + " * limitations under the License.~n" " * ~n" " * The Initial Developer of the Original Code is Ericsson AB.~n" " * Portions created by Ericsson are Copyright 2007, Ericsson AB.~n" diff --git a/erts/emulator/test/send_term_SUITE_data/ext_terms.bin b/erts/emulator/test/send_term_SUITE_data/ext_terms.bin Binary files differindex b239284323..5ff0b2ccf1 100644 --- a/erts/emulator/test/send_term_SUITE_data/ext_terms.bin +++ b/erts/emulator/test/send_term_SUITE_data/ext_terms.bin diff --git a/erts/emulator/test/send_term_SUITE_data/ext_terms.h b/erts/emulator/test/send_term_SUITE_data/ext_terms.h index 08134f3b05..83277078c6 100644 --- a/erts/emulator/test/send_term_SUITE_data/ext_terms.h +++ b/erts/emulator/test/send_term_SUITE_data/ext_terms.h @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson AB. * Portions created by Ericsson are Copyright 2007, Ericsson AB. @@ -24,9 +25,9 @@ #ifndef EXT_TERMS_H__ #define EXT_TERMS_H__ static struct { - unsigned char ext[162]; + unsigned char ext[637]; int ext_size; - unsigned char cext[162]; + unsigned char cext[637]; int cext_size; } ext_terms[] = { {{131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106}, @@ -37,26 +38,26 @@ static struct { 46, {131,108,0,0,0,4,110,9,0,0,0,160,222,197,173,201,53,54,110,7,1,199,113,21,183,140,242,3,107,0,6,98,108,117,112,112,33,100,0,5,98,108,105,112,112,106}, 46}, - {{131,104,5,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,37,0,0,0,0,3,102,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,59,0,0,0,0,0,0,0,0}, - 162, - {131,80,0,0,0,161,120,156,203,96,77,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,12,52,145,39,17,85,80,21,108,96,26,166,4,35,51,216,14,20,97,144,21,214,48,43,0,1,209,36,52}, - 82}, - {{131,104,5,104,0,106,106,112,0,0,0,79,0,21,87,190,182,1,38,106,214,65,228,1,52,27,227,2,212,0,0,0,1,0,0,0,0,100,0,15,115,101,110,100,95,116,101,114,109,95,83,85,73,84,69,97,1,98,0,184,11,180,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,37,0,0,0,0,3,109,0,0,0,31,104,101,106,32,104,111,112,112,32,116,114,97,108,108,97,108,97,97,97,97,97,97,97,97,97,97,97,97,97,97,97}, - 123, - {131,80,0,0,0,122,120,156,203,96,205,96,200,202,42,96,96,96,240,103,16,13,223,183,141,81,45,235,154,227,19,70,19,233,199,76,87,128,130,140,64,204,144,194,192,95,156,154,151,18,95,146,90,148,27,31,28,234,25,226,154,200,152,196,176,131,123,75,122,10,3,79,98,94,126,74,170,67,122,126,81,82,98,58,80,173,42,72,3,115,46,144,144,207,72,205,82,200,200,47,40,80,40,41,74,204,201,73,204,73,68,5,0,18,237,35,68}, - 117}, + {{131,104,5,103,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,41,0,0,0,0,2,104,2,114,0,3,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,2,0,0,0,42,0,0,0,3,0,0,0,0,102,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,2,103,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,40,0,0,0,0,3,102,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,3,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,56,0,0,0,3,0,0,0,0}, + 204, + {131,80,0,0,0,203,120,156,203,96,77,79,97,16,73,140,207,203,79,73,117,72,205,169,48,54,201,200,171,52,50,210,53,76,98,96,96,208,4,98,6,166,12,166,34,6,102,28,138,152,128,10,180,128,152,25,164,50,13,183,73,12,76,64,107,132,179,19,115,114,48,229,52,64,242,204,105,56,229,25,152,193,246,99,147,5,89,107,1,179,30,0,103,37,46,144}, + 96}, + {{131,104,5,104,0,106,106,112,0,0,0,86,0,123,56,104,225,98,55,108,63,185,201,160,64,191,31,210,203,0,0,0,2,0,0,0,0,100,0,15,115,101,110,100,95,116,101,114,109,95,83,85,73,84,69,97,2,98,3,217,195,71,103,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,40,0,0,0,0,3,109,0,0,0,31,104,101,106,32,104,111,112,112,32,116,114,97,108,108,97,108,97,97,97,97,97,97,97,97,97,97,97,97,97,97,97}, + 130, + {131,80,0,0,0,129,120,156,203,96,205,96,200,202,42,96,96,96,8,99,168,182,200,120,152,100,158,99,191,243,228,2,135,253,242,151,78,3,5,153,128,152,33,133,129,191,56,53,47,37,190,36,181,40,55,62,56,212,51,196,53,145,41,137,249,230,97,247,244,20,6,225,236,196,156,156,84,135,212,156,10,99,147,140,188,74,35,35,93,195,36,160,22,13,144,62,230,92,32,33,159,145,154,165,144,145,95,80,160,80,82,4,84,154,152,147,136,10,0,219,221,39,33}, + 123}, {{131,108,0,0,0,4,110,10,0,28,199,113,166,118,185,145,86,105,9,110,5,1,28,103,24,89,10,107,0,2,98,33,100,0,10,98,108,105,112,112,112,112,112,112,112,106}, 46, {131,108,0,0,0,4,110,10,0,28,199,113,166,118,185,145,86,105,9,110,5,1,28,103,24,89,10,107,0,2,98,33,100,0,10,98,108,105,112,112,112,112,112,112,112,106}, 46}, - {{131,104,5,98,0,0,18,103,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106}, - 120, - {131,80,0,0,0,119,120,156,203,96,77,98,96,16,74,79,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,156,244,255,255,219,153,57,64,38,83,10,3,123,98,94,124,98,73,126,110,54,3,91,162,66,78,102,113,73,22,0,167,192,30,158}, - 93}, - {{131,104,4,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,0,0,0,0,0,3,102,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3}, - 131, - {131,80,0,0,0,130,120,156,203,96,73,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,12,52,145,39,17,85,16,12,152,211,48,37,24,153,1,215,214,30,50}, - 72}, + {{131,104,5,98,0,0,18,103,103,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,41,0,0,0,0,2,104,2,114,0,3,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,2,0,0,0,42,0,0,0,3,0,0,0,0,102,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,2,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106}, + 141, + {131,80,0,0,0,140,120,156,203,96,77,98,96,16,74,79,79,97,16,73,140,207,203,79,73,117,72,205,169,48,54,201,200,171,52,50,210,53,4,202,49,104,2,49,3,83,6,83,17,3,51,14,69,76,64,5,90,64,204,12,82,153,134,219,36,6,166,164,255,255,223,206,204,1,177,82,24,216,19,243,226,19,75,242,115,179,25,216,18,21,114,50,139,75,178,0,77,99,35,202}, + 100}, + {{131,104,4,103,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,41,0,0,0,0,2,104,2,114,0,3,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,2,0,0,0,42,0,0,0,3,0,0,0,0,102,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,2,103,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,0,0,0,0,3,102,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,3}, + 166, + {131,80,0,0,0,165,120,156,203,96,73,79,97,16,73,140,207,203,79,73,117,72,205,169,48,54,201,200,171,52,50,210,53,76,98,96,96,208,4,98,6,166,12,166,34,6,102,28,138,152,128,10,180,128,152,25,164,50,13,183,73,12,76,64,107,132,179,19,115,114,176,200,129,0,115,26,110,121,102,0,219,33,38,209}, + 84}, {{131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106}, 38, {131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106}, @@ -65,46 +66,58 @@ static struct { 33, {131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,4,97,116,111,109,107,0,4,108,105,115,116,106}, 33}, - {{131,104,4,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,0,0,0,0,0,3,102,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3}, - 131, - {131,80,0,0,0,130,120,156,203,96,73,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,12,52,145,39,17,85,16,12,152,211,48,37,24,153,1,215,214,30,50}, + {{131,104,4,103,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,41,0,0,0,0,2,104,2,114,0,3,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,2,0,0,0,42,0,0,0,3,0,0,0,0,102,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,2,103,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,0,0,0,0,3,102,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,3}, + 166, + {131,80,0,0,0,165,120,156,203,96,73,79,97,16,73,140,207,203,79,73,117,72,205,169,48,54,201,200,171,52,50,210,53,76,98,96,96,208,4,98,6,166,12,166,34,6,102,28,138,152,128,10,180,128,152,25,164,50,13,183,73,12,76,64,107,132,179,19,115,114,176,200,129,0,115,26,110,121,102,0,219,33,38,209}, + 84}, + {{131,104,4,110,8,0,28,199,17,175,172,214,173,61,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,0,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,57,0,0,0,3,0,0,0,0}, + 81, + {131,80,0,0,0,80,120,156,203,96,201,227,96,144,57,46,184,126,205,181,181,182,73,255,255,7,165,100,48,98,133,12,69,12,204,41,12,194,217,137,57,57,169,14,169,57,21,198,38,25,121,149,70,70,186,134,73,204,12,12,12,150,64,12,162,25,0,231,161,20,138}, + 71}, + {{131,104,4,110,9,0,28,199,241,98,116,219,231,23,24,98,255,255,82,100,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,107,0,1,1,106,106,106,106,106,106,106,106,106,106,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,58,0,0,0,3,0,0,0,0}, + 122, + {131,80,0,0,0,121,120,156,203,96,201,227,100,144,57,254,49,169,228,246,115,113,137,164,255,255,131,82,114,24,24,24,24,73,34,178,25,24,25,179,224,160,136,129,57,133,65,56,59,49,39,39,213,33,53,167,194,216,36,35,175,210,200,72,215,48,137,25,168,214,10,136,65,52,3,0,142,142,25,0}, + 80}, + {{131,104,4,110,8,0,28,199,129,17,222,251,42,6,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,2,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,59,0,0,0,3,0,0,0,0}, + 83, + {131,80,0,0,0,82,120,156,203,96,201,227,96,144,57,222,40,120,239,183,22,91,210,255,255,65,41,25,140,216,97,34,83,17,3,115,10,131,112,118,98,78,78,170,67,106,78,133,177,73,70,94,165,145,145,174,97,18,51,3,3,131,53,16,131,104,6,0,233,167,20,95}, 72}, - {{131,104,4,110,8,0,28,199,17,175,172,214,173,61,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,0,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,60,0,0,0,0,0,0,0,0}, - 74, - {131,80,0,0,0,73,120,156,203,96,201,227,96,144,57,46,184,126,205,181,181,182,73,255,255,7,165,100,48,98,133,12,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,54,12,80,0,0,73,17,18,208}, - 63}, - {{131,104,4,110,9,0,28,199,241,98,116,219,231,23,24,98,255,255,82,100,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,107,0,1,1,106,106,106,106,106,106,106,106,106,106,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,61,0,0,0,0,0,0,0,0}, - 115, - {131,80,0,0,0,114,120,156,203,96,201,227,100,144,57,254,49,169,228,246,115,113,137,164,255,255,131,82,114,24,24,24,24,73,34,178,25,24,25,179,224,160,136,129,57,133,129,39,49,47,63,37,213,33,61,191,40,41,49,157,25,168,200,150,1,10,0,208,188,23,70}, + {{131,104,4,110,9,0,28,199,113,221,139,146,14,239,240,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,3,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,60,0,0,0,3,0,0,0,0}, + 84, + {131,80,0,0,0,83,120,156,203,96,201,227,100,144,57,94,120,183,123,18,223,251,15,73,255,255,7,165,100,48,98,135,137,204,69,12,204,41,12,194,217,137,57,57,169,14,169,57,21,198,38,25,121,149,70,70,186,134,73,204,12,12,12,54,64,12,162,25,0,106,11,22,31}, + 73}, + {{131,104,4,110,9,0,28,199,177,214,190,98,202,104,2,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,4,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,61,0,0,0,3,0,0,0,0}, + 84, + {131,80,0,0,0,83,120,156,203,96,201,227,100,144,57,190,241,218,190,164,83,25,76,73,255,255,7,165,100,48,98,135,137,44,69,12,204,41,12,194,217,137,57,57,169,14,169,57,21,198,38,25,121,149,70,70,186,134,73,204,12,12,12,182,64,12,162,25,0,74,151,21,164}, + 73}, + {{131,104,4,110,7,0,28,199,85,220,50,202,15,98,255,255,82,100,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,107,0,1,5,106,106,106,106,106,106,106,106,106,106,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,62,0,0,0,3,0,0,0,0}, + 120, + {131,80,0,0,0,119,120,156,203,96,201,99,103,144,57,30,122,199,232,20,127,210,255,255,65,41,57,12,12,12,140,36,17,217,12,140,172,89,112,80,196,192,156,194,32,156,157,152,147,147,234,144,154,83,97,108,146,145,87,105,100,164,107,152,196,12,84,107,7,196,32,154,1,0,225,225,23,138}, + 78}, + {{131,104,4,110,9,0,28,199,241,98,116,219,231,23,24,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,6,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,63,0,0,0,3,0,0,0,0}, + 84, + {131,80,0,0,0,83,120,156,203,96,201,227,100,144,57,254,49,169,228,246,115,113,137,164,255,255,131,82,50,24,177,195,68,182,34,6,230,20,6,225,236,196,156,156,84,135,212,156,10,99,147,140,188,74,35,35,93,195,36,102,6,6,6,123,32,6,209,12,0,64,205,21,133}, + 73}, + {{131,104,4,110,7,0,28,199,59,73,56,148,1,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,7,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,64,0,0,0,3,0,0,0,0}, + 82, + {131,80,0,0,0,81,120,156,203,96,201,99,103,144,57,110,237,105,49,133,49,233,255,255,160,148,12,70,236,48,145,189,136,129,57,133,65,56,59,49,39,39,213,33,53,167,194,216,36,35,175,210,200,72,215,48,137,153,129,129,193,1,136,65,52,3,0,137,143,19,30}, 71}, - {{131,104,4,110,8,0,28,199,129,17,222,251,42,6,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,2,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,62,0,0,0,0,0,0,0,0}, - 76, - {131,80,0,0,0,75,120,156,203,96,201,227,96,144,57,222,40,120,239,183,22,91,210,255,255,65,41,25,140,216,97,34,83,17,3,115,10,3,79,98,94,126,74,170,67,122,126,81,82,98,58,51,3,3,131,29,3,20,0,0,76,82,18,165}, - 64}, - {{131,104,4,110,9,0,28,199,113,221,139,146,14,239,240,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,3,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,63,0,0,0,0,0,0,0,0}, - 77, - {131,80,0,0,0,76,120,156,203,96,201,227,100,144,57,94,120,183,123,18,223,251,15,73,255,255,7,165,100,48,98,135,137,204,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,246,12,80,0,0,192,110,20,101}, - 65}, - {{131,104,4,110,9,0,28,199,177,214,190,98,202,104,2,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,4,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,64,0,0,0,0,0,0,0,0}, - 77, - {131,80,0,0,0,76,120,156,203,96,201,227,100,144,57,190,241,218,190,164,83,25,76,73,255,255,7,165,100,48,98,135,137,44,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,14,12,80,0,0,164,94,19,234}, - 65}, - {{131,104,4,110,7,0,28,199,85,220,50,202,15,98,255,255,82,100,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,107,0,1,5,106,106,106,106,106,106,106,106,106,106,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,65,0,0,0,0,0,0,0,0}, - 113, - {131,80,0,0,0,112,120,156,203,96,201,99,103,144,57,30,122,199,232,20,127,210,255,255,65,41,57,12,12,12,140,36,17,217,12,140,172,89,112,80,196,192,156,194,192,147,152,151,159,146,234,144,158,95,148,148,152,206,12,84,228,200,0,5,0,46,116,21,208}, - 69}, - {{131,104,4,110,9,0,28,199,241,98,116,219,231,23,24,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,6,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,66,0,0,0,0,0,0,0,0}, - 77, - {131,80,0,0,0,76,120,156,203,96,201,227,100,144,57,254,49,169,228,246,115,113,137,164,255,255,131,82,50,24,177,195,68,182,34,6,230,20,6,158,196,188,252,148,84,135,244,252,162,164,196,116,102,6,6,6,39,6,40,0,0,155,123,19,203}, - 65}, - {{131,104,4,110,7,0,28,199,59,73,56,148,1,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,7,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,67,0,0,0,0,0,0,0,0}, - 75, - {131,80,0,0,0,74,120,156,203,96,201,99,103,144,57,110,237,105,49,133,49,233,255,255,160,148,12,70,236,48,145,189,136,129,57,133,129,39,49,47,63,37,213,33,61,191,40,41,49,157,153,129,129,193,153,1,10,0,245,21,17,100}, - 62}, - {{131,104,4,110,8,0,28,199,17,175,172,214,173,61,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,8,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,68,0,0,0,0,0,0,0,0}, - 76, - {131,80,0,0,0,75,120,156,203,96,201,227,96,144,57,46,184,126,205,181,181,182,73,255,255,7,165,100,48,98,135,137,28,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,46,12,80,0,0,112,226,19,66}, - 64} + {{131,104,4,110,8,0,28,199,17,175,172,214,173,61,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,8,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,65,0,0,0,3,0,0,0,0}, + 83, + {131,80,0,0,0,82,120,156,203,96,201,227,96,144,57,46,184,126,205,181,181,182,73,255,255,7,165,100,48,98,135,137,28,69,12,204,41,12,194,217,137,57,57,169,14,169,57,21,198,38,25,121,149,70,70,186,134,73,204,12,12,12,142,64,12,162,25,0,18,103,20,252}, + 72}, + {{131,116,0,0,0,0}, + 6, + {131,116,0,0,0,0}, + 6}, + {{131,116,0,0,0,3,97,1,97,11,97,2,97,22,97,3,97,33}, + 18, + {131,116,0,0,0,3,97,1,97,11,97,2,97,22,97,3,97,33}, + 18}, + {{131,116,0,0,0,100,97,48,98,0,0,2,16,97,62,98,0,0,2,170,97,11,97,121,97,39,98,0,0,1,173,97,83,98,0,0,3,145,97,63,98,0,0,2,181,97,34,98,0,0,1,118,97,68,98,0,0,2,236,97,26,98,0,0,1,30,97,78,98,0,0,3,90,97,52,98,0,0,2,60,97,15,97,165,97,64,98,0,0,2,192,97,75,98,0,0,3,57,97,81,98,0,0,3,123,97,71,98,0,0,3,13,97,20,97,220,97,50,98,0,0,2,38,97,17,97,187,97,25,98,0,0,1,19,97,65,98,0,0,2,203,97,98,98,0,0,4,54,97,79,98,0,0,3,101,97,13,97,143,97,44,98,0,0,1,228,97,8,97,88,97,99,98,0,0,4,65,97,36,98,0,0,1,140,97,67,98,0,0,2,225,97,7,97,77,97,66,98,0,0,2,214,97,85,98,0,0,3,167,97,76,98,0,0,3,68,97,1,97,11,97,32,98,0,0,1,96,97,69,98,0,0,2,247,97,37,98,0,0,1,151,97,35,98,0,0,1,129,97,84,98,0,0,3,156,97,3,97,33,97,82,98,0,0,3,134,97,45,98,0,0,1,239,97,55,98,0,0,2,93,97,6,97,66,97,2,97,22,97,94,98,0,0,4,10,97,49,98,0,0,2,27,97,41,98,0,0,1,195,97,91,98,0,0,3,233,97,87,98,0,0,3,189,97,33,98,0,0,1,107,97,42,98,0,0,1,206,97,74,98,0,0,3,46,97,60,98,0,0,2,148,97,43,98,0,0,1,217,97,10,97,110,97,70,98,0,0,3,2,97,9,97,99,97,72,98,0,0,3,24,97,86,98,0,0,3,178,97,19,97,209,97,56,98,0,0,2,104,97,95,98,0,0,4,21,97,57,98,0,0,2,115,97,51,98,0,0,2,49,97,14,97,154,97,5,97,55,97,54,98,0,0,2,82,97,18,97,198,97,61,98,0,0,2,159,97,31,98,0,0,1,85,97,22,97,242,97,29,98,0,0,1,63,97,97,98,0,0,4,43,97,21,97,231,97,89,98,0,0,3,211,97,27,98,0,0,1,41,97,24,98,0,0,1,8,97,47,98,0,0,2,5,97,100,98,0,0,4,76,97,40,98,0,0,1,184,97,96,98,0,0,4,32,97,73,98,0,0,3,35,97,90,98,0,0,3,222,97,30,98,0,0,1,74,97,58,98,0,0,2,126,97,80,98,0,0,3,112,97,88,98,0,0,3,200,97,59,98,0,0,2,137,97,77,98,0,0,3,79,97,23,97,253,97,28,98,0,0,1,52,97,46,98,0,0,1,250,97,92,98,0,0,3,244,97,53,98,0,0,2,71,97,93,98,0,0,3,255,97,16,97,176,97,38,98,0,0,1,162,97,4,97,44,97,12,97,132}, + 637, + {131,80,0,0,2,124,120,156,21,143,123,100,87,113,24,135,207,126,219,218,165,86,171,109,181,182,118,107,181,181,123,171,181,181,218,90,91,91,171,93,90,91,173,221,219,158,93,24,145,40,145,49,70,98,140,68,68,70,196,196,136,137,24,137,136,68,68,70,140,68,68,34,34,35,34,117,158,191,158,247,115,121,223,239,57,55,130,32,152,228,224,120,16,68,146,57,33,150,217,204,45,10,195,49,234,41,23,66,68,223,163,193,224,57,123,53,111,210,172,250,65,134,42,155,115,86,6,169,210,172,99,27,75,156,116,124,69,187,65,45,221,98,134,86,145,68,42,159,56,100,94,192,118,94,176,219,27,41,52,234,188,99,60,68,76,53,93,86,167,72,226,46,165,230,95,137,167,159,9,195,70,246,233,44,112,202,141,47,196,209,73,147,227,71,122,221,122,66,135,104,38,42,252,139,92,171,99,180,152,255,102,191,234,1,249,98,142,139,214,22,137,38,143,30,199,59,148,25,252,164,198,246,8,155,104,34,194,78,46,251,106,34,149,186,153,20,217,121,205,144,27,223,233,19,47,201,211,188,66,177,120,79,155,102,57,117,46,220,167,68,115,157,68,174,114,218,32,66,2,19,156,113,76,231,146,120,70,10,31,56,106,125,154,81,95,75,163,86,117,157,195,162,146,173,60,36,150,26,170,149,61,236,224,13,245,142,143,200,241,122,111,248,149,191,200,114,108,0,15,148,144,198,55,6,188,190,70,166,65,17,233,34,158,10,23,99,153,180,214,193,1,205,85,198,84,185,156,117,33,159,65,241,153,108,179,54,142,185,48,203,121,205,107,244,139,183,28,215,156,167,83,213,197,46,254,178,199,118,21,229,226,15,195,6,27,28,177,214,202,136,234,31,201,172,80,96,254,152,24,74,217,194,237,255,248,120,145,79}, + 418} }; -#define NO_OF_EXT_TERMS 19 +#define NO_OF_EXT_TERMS 22 #endif 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 381a4f20d5..abb13d4603 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 @@ -1,13 +1,14 @@ -/* ``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. +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. * * The Initial Developer of the Original Code is Ericsson Utvecklings AB. * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl index e073eab596..c3e303bbd1 100644 --- a/erts/emulator/test/sensitive_SUITE.erl +++ b/erts/emulator/test/sensitive_SUITE.erl @@ -1,46 +1,39 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(sensitive_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - stickiness/1,send_trace/1,recv_trace/1,proc_trace/1,call_trace/1, - meta_trace/1,running_trace/1,gc_trace/1,seq_trace/1, - t_process_info/1,t_process_display/1,save_calls/1]). +-export([all/0, suite/0, + stickiness/1,send_trace/1,recv_trace/1,proc_trace/1,call_trace/1, + meta_trace/1,running_trace/1,gc_trace/1,seq_trace/1, + t_process_info/1,t_process_display/1,save_calls/1]). -export([remote_process_display/0,an_exported_function/1]). -import(lists, [keysearch/3,foreach/2,sort/1]). -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(5)), - [{watchdog,Dog}|Config]. - -end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> [stickiness, send_trace, recv_trace, proc_trace, @@ -48,164 +41,148 @@ all() -> seq_trace, t_process_info, t_process_display, save_calls]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - stickiness(Config) when is_list(Config) -> - ?line {Tracer,Mref} = spawn_monitor(fun() -> - receive after infinity -> ok end - end), - ?line false = process_flag(sensitive, true), + {Tracer,Mref} = spawn_monitor(fun() -> + receive after infinity -> ok end + end), + false = process_flag(sensitive, true), put(foo, bar), Flags = sort([send,'receive',procs,call,running,garbage_collection, - set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link]), - ?line foreach(fun(F) -> - 1 = erlang:trace(self(), true, [F,{tracer,Tracer}]) - end, Flags), - ?line foreach(fun(F) -> - 1 = erlang:trace(self(), false, [F,{tracer,Tracer}]) - end, Flags), - ?line 1 = erlang:trace(self(), true, [{tracer,Tracer}|Flags]), - ?line 1 = erlang:trace(self(), false, [{tracer,Tracer}|Flags]), - - ?line {messages,[]} = process_info(Tracer, messages), + set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link]), + foreach(fun(F) -> + 1 = erlang:trace(self(), true, [F,{tracer,Tracer}]) + end, Flags), + foreach(fun(F) -> + 1 = erlang:trace(self(), false, [F,{tracer,Tracer}]) + end, Flags), + 1 = erlang:trace(self(), true, [{tracer,Tracer}|Flags]), + 1 = erlang:trace(self(), false, [{tracer,Tracer}|Flags]), + + {messages,[]} = process_info(Tracer, messages), exit(Tracer, kill), receive {'DOWN',Mref,_,_,_} -> ok end, - + case process_info(self(), dictionary) of - {dictionary,[]} -> ok; - {dictionary,_} -> ?line ?t:fail(sensitive_flag_cleared) + {dictionary,[]} -> ok; + {dictionary,_} -> ct:fail(sensitive_flag_cleared) end, NewTracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line 1 = erlang:trace(self(), true, [{tracer,NewTracer}|Flags]), - ?line Flags = sort(element(2, erlang:trace_info(self(), flags))), - ?line {tracer,NewTracer} = erlang:trace_info(self(), tracer), + 1 = erlang:trace(self(), true, [{tracer,NewTracer}|Flags]), + Flags = sort(element(2, erlang:trace_info(self(), flags))), + {tracer,NewTracer} = erlang:trace_info(self(), tracer), %% Process still sensitive. Tracer should disappear when we clear %% all trace flags. - ?line 1 = erlang:trace(self(), false, [{tracer,NewTracer}|Flags]), - ?line {tracer,[]} = erlang:trace_info(self(), tracer), + 1 = erlang:trace(self(), false, [{tracer,NewTracer}|Flags]), + {tracer,[]} = erlang:trace_info(self(), tracer), - ?line unlink(NewTracer), exit(NewTracer, kill), + unlink(NewTracer), exit(NewTracer, kill), ok. send_trace(Config) when is_list(Config) -> - ?line {Dead,Mref} = spawn_monitor(fun() -> ok end), + {Dead,Mref} = spawn_monitor(fun() -> ok end), receive {'DOWN',Mref,_,_,_} -> ok end, - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line Sink = spawn_link(fun() -> receive after infinity -> ok end end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + Sink = spawn_link(fun() -> receive after infinity -> ok end end), Self = self(), - ?line 1 = erlang:trace(self(), true, [send,{tracer,Tracer}]), - ?line Dead ! before, - ?line Sink ! before, - ?line false = process_flag(sensitive, true), - ?line Sink ! {blurf,lists:seq(1, 50)}, - ?line true = process_flag(sensitive, true), - ?line Sink ! lists:seq(1, 100), - ?line Dead ! forget_me, - ?line true = process_flag(sensitive, false), - ?line Sink ! after1, - ?line false = process_flag(sensitive, false), - ?line Sink ! after2, - ?line Dead ! after2, - ?line wait_trace(Self), - - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{trace,Self,send_to_non_existing_process,before,Dead}, - {trace,Self,send,before,Sink}, - {trace,Self,send,after1,Sink}, - {trace,Self,send,after2,Sink}, - {trace,Self,send_to_non_existing_process,after2,Dead}] = Messages, - - ?line unlink(Tracer), exit(Tracer, kill), - ?line unlink(Sink), exit(Sink, kill), + 1 = erlang:trace(self(), true, [send,{tracer,Tracer}]), + Dead ! before, + Sink ! before, + false = process_flag(sensitive, true), + Sink ! {blurf,lists:seq(1, 50)}, + true = process_flag(sensitive, true), + Sink ! lists:seq(1, 100), + Dead ! forget_me, + true = process_flag(sensitive, false), + Sink ! after1, + false = process_flag(sensitive, false), + Sink ! after2, + Dead ! after2, + wait_trace(Self), + + {messages,Messages} = process_info(Tracer, messages), + [{trace,Self,send_to_non_existing_process,before,Dead}, + {trace,Self,send,before,Sink}, + {trace,Self,send,after1,Sink}, + {trace,Self,send,after2,Sink}, + {trace,Self,send_to_non_existing_process,after2,Dead}] = Messages, + + unlink(Tracer), exit(Tracer, kill), + unlink(Sink), exit(Sink, kill), ok. recv_trace(Config) when is_list(Config) -> Parent = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line Sender = spawn_link(fun() -> recv_trace_sender(Parent) end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + Sender = spawn_link(fun() -> recv_trace_sender(Parent) end), - ?line 1 = erlang:trace(self(), true, ['receive',{tracer,Tracer}]), + 1 = erlang:trace(self(), true, ['receive',{tracer,Tracer}]), Sender ! 1, receive a -> wait_trace(Sender) end, - ?line false = process_flag(sensitive, true), + false = process_flag(sensitive, true), Sender ! 2, receive {b,[x,y,z]} -> wait_trace(Sender) end, - - ?line true = process_flag(sensitive, false), + + true = process_flag(sensitive, false), Sender ! 3, receive c -> wait_trace(Sender) end, - - ?line {messages,Messages} = process_info(Tracer, messages), + + {messages,Messages} = process_info(Tracer, messages), [{trace,Parent,'receive',a}, {trace,Parent,'receive',{trace_delivered,_,_}}, {trace,Parent,'receive',c}|_] = Messages, - ?line unlink(Tracer), exit(Tracer, kill), - ?line unlink(Sender), exit(Sender, kill), + unlink(Tracer), exit(Tracer, kill), + unlink(Sender), exit(Sender, kill), ok. recv_trace_sender(Pid) -> receive - 1 -> Pid ! a; - 2 -> Pid ! {b,[x,y,z]}; - 3 -> Pid ! c + 1 -> Pid ! a; + 2 -> Pid ! {b,[x,y,z]}; + 3 -> Pid ! c end, recv_trace_sender(Pid). proc_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line 1 = erlang:trace(self(), true, [procs,{tracer,Tracer}]), - ?line false = process_flag(sensitive, true), + 1 = erlang:trace(self(), true, [procs,{tracer,Tracer}]), + false = process_flag(sensitive, true), spawn(fun() -> ok end), - ?line register(nisse, self()), - ?line unregister(nisse), - ?line link(Tracer), - ?line unlink(Tracer), - ?line Linker0 = spawn_link(fun() -> ok end), + register(nisse, self()), + unregister(nisse), + link(Tracer), + unlink(Tracer), + Linker0 = spawn_link(fun() -> ok end), Mref0 = erlang:monitor(process, Linker0), - ?line {_,Mref} = spawn_monitor(fun() -> link(Self), unlink(Self) end), + {_,Mref} = spawn_monitor(fun() -> link(Self), unlink(Self) end), receive {'DOWN',Mref0,_,_,_} -> ok end, receive {'DOWN',Mref,_,_,_} -> ok end, - ?line true = process_flag(sensitive, false), + true = process_flag(sensitive, false), Dead = spawn(fun() -> ok end), - ?line register(arne, self()), - ?line unregister(arne), - ?line {Linker,Mref2} = spawn_monitor(fun() -> link(Self), unlink(Self) end), + register(arne, self()), + unregister(arne), + {Linker,Mref2} = spawn_monitor(fun() -> link(Self), unlink(Self) end), receive {'DOWN',Mref2,_,_,_} -> ok end, - ?line Last = spawn_link(fun() -> ok end), + Last = spawn_link(fun() -> ok end), receive after 10 -> ok end, - ?line wait_trace(all), - ?line {messages,Messages} = process_info(Tracer, messages), + wait_trace(all), + {messages,Messages} = process_info(Tracer, messages), [{trace,Self,spawn,Dead,{erlang,apply,_}}, {trace,Self,register,arne}, {trace,Self,unregister,arne}, @@ -216,80 +193,80 @@ proc_trace(Config) when is_list(Config) -> {trace,Self,link,Last}, {trace,Self,getting_unlinked,Last}] = Messages, - ?line unlink(Tracer), exit(Tracer, kill), + unlink(Tracer), exit(Tracer, kill), ok. call_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - - ?line 1 = erlang:trace(self(), true, [call,{tracer,Tracer}]), - ?line 1 = erlang:trace_pattern({?MODULE,an_exported_function,1}, - true, [global]), - ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [global]), - ?line 1 = erlang:trace_pattern({erlang,binary_to_list,1}, true, [local]), - ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [local]), - - ?line false = process_flag(sensitive, true), - ?line {ok,42} = a_local_function(42), - ?line 7 = an_exported_function(6), - ?line <<7,8,9,10>> = list_to_binary(id([7,8,9,10])), - ?line [42,43] = binary_to_list(id(<<42,43>>)), - ?line true = process_flag(sensitive, false), - - ?line {ok,{a,b}} = a_local_function({a,b}), - ?line 1 = an_exported_function(0), - ?line <<1,2,3>> = list_to_binary(id([1,2,3])), - ?line [42,43,44] = binary_to_list(id(<<42,43,44>>)), - - ?line wait_trace(Self), - - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{trace,Self,call,{?MODULE,a_local_function,[{a,b}]}}, - {trace,Self,call,{?MODULE,an_exported_function,[0]}}, - {trace,Self,call,{?MODULE,id,[_]}}, - {trace,Self,call,{erlang,list_to_binary,[[1,2,3]]}}, - {trace,Self,call,{sensitive_SUITE,id,[<<42,43,44>>]}}, - {trace,Self,call,{erlang,binary_to_list,[<<42,43,44>>]}}, - {trace,Self,call,{?MODULE,wait_trace,[Self]}}] = Messages, - - ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [local]), - ?line erlang:trace_pattern({erlang,'_','_'}, false, [local]), - ?line erlang:trace_pattern({'_','_','_'}, false, [global]), - - ?line unlink(Tracer), exit(Tracer, kill), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + + 1 = erlang:trace(self(), true, [call,{tracer,Tracer}]), + 1 = erlang:trace_pattern({?MODULE,an_exported_function,1}, + true, [global]), + 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [global]), + 1 = erlang:trace_pattern({erlang,binary_to_list,1}, true, [local]), + Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [local]), + + false = process_flag(sensitive, true), + {ok,42} = a_local_function(42), + 7 = an_exported_function(6), + <<7,8,9,10>> = list_to_binary(id([7,8,9,10])), + [42,43] = binary_to_list(id(<<42,43>>)), + true = process_flag(sensitive, false), + + {ok,{a,b}} = a_local_function({a,b}), + 1 = an_exported_function(0), + <<1,2,3>> = list_to_binary(id([1,2,3])), + [42,43,44] = binary_to_list(id(<<42,43,44>>)), + + wait_trace(Self), + + {messages,Messages} = process_info(Tracer, messages), + [{trace,Self,call,{?MODULE,a_local_function,[{a,b}]}}, + {trace,Self,call,{?MODULE,an_exported_function,[0]}}, + {trace,Self,call,{?MODULE,id,[_]}}, + {trace,Self,call,{erlang,list_to_binary,[[1,2,3]]}}, + {trace,Self,call,{sensitive_SUITE,id,[<<42,43,44>>]}}, + {trace,Self,call,{erlang,binary_to_list,[<<42,43,44>>]}}, + {trace,Self,call,{?MODULE,wait_trace,[Self]}}] = Messages, + + Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [local]), + erlang:trace_pattern({erlang,'_','_'}, false, [local]), + erlang:trace_pattern({'_','_','_'}, false, [global]), + + unlink(Tracer), exit(Tracer, kill), ok. meta_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - - ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [{meta,Tracer}]), - ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [{meta,Tracer}]), - - ?line false = process_flag(sensitive, true), - ?line {ok,blurf} = a_local_function(blurf), - ?line 100 = an_exported_function(99), - ?line <<8,9,10>> = list_to_binary(id([8,9,10])), - ?line true = process_flag(sensitive, false), - - ?line {ok,{x,y}} = a_local_function({x,y}), - ?line 1 = an_exported_function(0), - ?line <<10>> = list_to_binary(id([10])), - ?line wait_trace(Self), - - ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [meta]), - ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, false, [meta]), - ?line a_local_function(0), - - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{trace_ts,Self,call,{?MODULE,a_local_function,[{x,y}]},{_,_,_}}, - {trace_ts,Self,call,{?MODULE,an_exported_function,[0]},{_,_,_}}, - {trace_ts,Self,call,{?MODULE,id,[_]},{_,_,_}}, - {trace_ts,Self,call,{erlang,list_to_binary,[[10]]},{_,_,_}}, - {trace_ts,Self,call,{?MODULE,wait_trace,[Self]},{_,_,_}}] = Messages, - - ?line unlink(Tracer), exit(Tracer, kill), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + + Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [{meta,Tracer}]), + 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [{meta,Tracer}]), + + false = process_flag(sensitive, true), + {ok,blurf} = a_local_function(blurf), + 100 = an_exported_function(99), + <<8,9,10>> = list_to_binary(id([8,9,10])), + true = process_flag(sensitive, false), + + {ok,{x,y}} = a_local_function({x,y}), + 1 = an_exported_function(0), + <<10>> = list_to_binary(id([10])), + wait_trace(Self), + + Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [meta]), + 1 = erlang:trace_pattern({erlang,list_to_binary,1}, false, [meta]), + a_local_function(0), + + {messages,Messages} = process_info(Tracer, messages), + [{trace_ts,Self,call,{?MODULE,a_local_function,[{x,y}]},{_,_,_}}, + {trace_ts,Self,call,{?MODULE,an_exported_function,[0]},{_,_,_}}, + {trace_ts,Self,call,{?MODULE,id,[_]},{_,_,_}}, + {trace_ts,Self,call,{erlang,list_to_binary,[[10]]},{_,_,_}}, + {trace_ts,Self,call,{?MODULE,wait_trace,[Self]},{_,_,_}}] = Messages, + + unlink(Tracer), exit(Tracer, kill), ok. a_local_function(A) -> @@ -300,66 +277,66 @@ an_exported_function(X) -> running_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line false = process_flag(sensitive, true), - ?line 1 = erlang:trace(Self, true, [running,{tracer,Tracer}]), + false = process_flag(sensitive, true), + 1 = erlang:trace(Self, true, [running,{tracer,Tracer}]), erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), - ?line true = process_flag(sensitive, false), + true = process_flag(sensitive, false), erlang:yield(), - ?line 1 = erlang:trace(Self, false, [running,{tracer,Tracer}]), + 1 = erlang:trace(Self, false, [running,{tracer,Tracer}]), - ?line wait_trace(Self), - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{trace,Self,out,{sensitive_SUITE,running_trace,1}}, - {trace,Self,in,{sensitive_SUITE,running_trace,1}}] = Messages, + wait_trace(Self), + {messages,Messages} = process_info(Tracer, messages), + [{trace,Self,out,{sensitive_SUITE,running_trace,1}}, + {trace,Self,in,{sensitive_SUITE,running_trace,1}}] = Messages, - ?line unlink(Tracer), exit(Tracer, kill), + unlink(Tracer), exit(Tracer, kill), ok. gc_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line false = process_flag(sensitive, true), - ?line 1 = erlang:trace(Self, true, [garbage_collection,{tracer,Tracer}]), + false = process_flag(sensitive, true), + 1 = erlang:trace(Self, true, [garbage_collection,{tracer,Tracer}]), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), - ?line true = process_flag(sensitive, false), + true = process_flag(sensitive, false), erlang:garbage_collect(), - ?line 1 = erlang:trace(Self, false, [garbage_collection,{tracer,Tracer}]), + 1 = erlang:trace(Self, false, [garbage_collection,{tracer,Tracer}]), - ?line wait_trace(Self), - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{trace,Self,gc_start,_},{trace,Self,gc_end,_}] = Messages, + wait_trace(Self), + {messages,Messages} = process_info(Tracer, messages), + [{trace,Self,gc_major_start,_},{trace,Self,gc_major_end,_}] = Messages, - ?line unlink(Tracer), exit(Tracer, kill), + unlink(Tracer), exit(Tracer, kill), ok. seq_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line seq_trace:set_system_tracer(Tracer), - - ?line false = process_flag(sensitive, true), - - ?line Echo = spawn_link(fun() -> - receive - {Pid,Message} -> - Pid ! {reply,Message} - end - end), - ?line Sender = spawn_link(fun() -> - seq_trace:set_token(label, 42), - seq_trace:set_token('receive', true), - seq_trace:set_token(send, true), - seq_trace:set_token(print, true), - seq_trace:print(42, "trace started"), - Self ! blurf - end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + seq_trace:set_system_tracer(Tracer), + + false = process_flag(sensitive, true), + + Echo = spawn_link(fun() -> + receive + {Pid,Message} -> + Pid ! {reply,Message} + end + end), + Sender = spawn_link(fun() -> + seq_trace:set_token(label, 42), + seq_trace:set_token('receive', true), + seq_trace:set_token(send, true), + seq_trace:set_token(print, true), + seq_trace:print(42, "trace started"), + Self ! blurf + end), seq_trace:set_token(label, 17), seq_trace:set_token('receive', true), seq_trace:set_token(send, true), @@ -369,49 +346,49 @@ seq_trace(Config) when is_list(Config) -> receive {reply,hello} -> ok end, receive blurf -> ok end, - ?line wait_trace(all), + wait_trace(all), - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{seq_trace,17,{'receive',{0,2},Self,Echo,{Self,hello}}}, - {seq_trace,17,{send,{2,3},Echo,Self,{reply,hello}}}] = - [M || {seq_trace,17,_}=M <- Messages], + {messages,Messages} = process_info(Tracer, messages), + [{seq_trace,17,{'receive',{0,2},Self,Echo,{Self,hello}}}, + {seq_trace,17,{send,{2,3},Echo,Self,{reply,hello}}}] = + [M || {seq_trace,17,_}=M <- Messages], - ?line [{seq_trace,42,{print,{0,1},Sender,[],"trace started"}}, - {seq_trace,42,{send,{0,2},Sender,Self,blurf}}] = - [M || {seq_trace,42,_}=M <- Messages], - - ?line unlink(Tracer), exit(Tracer, kill), - ?line unlink(Echo), exit(Echo, kill), - ?line unlink(Sender), exit(Sender, kill), + [{seq_trace,42,{print,{0,1},Sender,[],"trace started"}}, + {seq_trace,42,{send,{0,2},Sender,Self,blurf}}] = + [M || {seq_trace,42,_}=M <- Messages], + + unlink(Tracer), exit(Tracer, kill), + unlink(Echo), exit(Echo, kill), + unlink(Sender), exit(Sender, kill), ok. t_process_info(Config) when is_list(Config) -> Parent = self(), - ?line Pid = spawn_link(fun() -> - put(foo, bar), - false = process_flag(sensitive, true), - Parent ! go, - receive - revert -> - true = process_flag(sensitive, false), - Parent ! go_again, - receive never -> ok end - end end), + Pid = spawn_link(fun() -> + put(foo, bar), + false = process_flag(sensitive, true), + Parent ! go, + receive + revert -> + true = process_flag(sensitive, false), + Parent ! go_again, + receive never -> ok end + end end), receive go -> ok end, - ?line put(foo, bar), - ?line self() ! Pid ! {i,am,a,message}, + put(foo, bar), + self() ! Pid ! {i,am,a,message}, - ?line false = process_flag(sensitive, true), - ?line t_process_info_suppressed(self()), - ?line t_process_info_suppressed(Pid), + false = process_flag(sensitive, true), + t_process_info_suppressed(self()), + t_process_info_suppressed(Pid), - ?line true = process_flag(sensitive, false), + true = process_flag(sensitive, false), Pid ! revert, receive go_again -> ok end, - ?line t_process_info_normal(self()), - ?line t_process_info_normal(Pid), + t_process_info_normal(self()), + t_process_info_normal(Pid), ok. t_process_info_suppressed(Pid) -> @@ -422,7 +399,7 @@ t_process_info_suppressed(Pid) -> t_process_info_normal(Pid) -> {value,{foo,bar}} = keysearch(foo, 1, my_process_info(Pid, dictionary)), case process_info(Pid, backtrace) of - {backtrace,Bin} when size(Bin) > 20 -> ok + {backtrace,Bin} when size(Bin) > 20 -> ok end, [{i,am,a,message}] = my_process_info(Pid, messages). @@ -430,16 +407,16 @@ my_process_info(Pid, Tag) -> {Tag,Value} = process_info(Pid, Tag), All = process_info(Pid), case keysearch(Tag, 1, All) of - false -> Value; - {value,{Tag,Value}} -> Value + false -> Value; + {value,{Tag,Value}} -> Value end. t_process_display(Config) when is_list(Config) -> - ?line Dir = filename:dirname(code:which(?MODULE)), - ?line Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++ - " -run " ++ ?MODULE_STRING ++ " remote_process_display", - ?line io:put_chars(Cmd), - ?line P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]), + Dir = filename:dirname(code:which(?MODULE)), + Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++ + " -run " ++ ?MODULE_STRING ++ " remote_process_display", + io:put_chars(Cmd), + P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]), <<"done",_/binary>> = get_all(P), ok. @@ -455,27 +432,26 @@ get_all(P) -> get_all(P, Acc) -> receive - {P,{data,S}} -> - get_all(P, [Acc|S]); - {P,eof} -> - iolist_to_binary(Acc) + {P,{data,S}} -> + get_all(P, [Acc|S]); + {P,eof} -> + iolist_to_binary(Acc) end. save_calls(Config) when is_list(Config) -> process_flag(save_calls, 10), false = process_flag(sensitive, true), - ?line {last_calls,LastCalls} = process_info(self(), last_calls), - ?line [{erlang,process_flag,2}] = LastCalls, - ?line [2,4,6] = lists:map(fun(E) -> 2*E end, [1,2,3]), - ?line {last_calls,LastCalls} = process_info(self(), last_calls), + {last_calls,LastCalls} = process_info(self(), last_calls), + [{erlang,process_flag,2}] = LastCalls, + [2,4,6] = lists:map(fun(E) -> 2*E end, [1,2,3]), + {last_calls,LastCalls} = process_info(self(), last_calls), ok. wait_trace(Pid) -> Ref = erlang:trace_delivered(Pid), receive - {trace_delivered,Pid,Ref} -> ok + {trace_delivered,Pid,Ref} -> ok end. - + id(I) -> I. - diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl index 736dfe5b56..61a8617165 100644 --- a/erts/emulator/test/signal_SUITE.erl +++ b/erts/emulator/test/signal_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,12 +28,10 @@ -module(signal_SUITE). -author('[email protected]'). --define(DEFAULT_TIMEOUT_SECONDS, 120). - %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-include_lib("common_test/include/ct.hrl"). +-export([all/0, suite/0,init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). % Test cases -export([xm_sig_order/1, @@ -50,16 +49,12 @@ pending_exit_group_leader/1, exit_before_pending_exit/1]). --export([init_per_testcase/2, end_per_testcase/2]). - init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - ?line Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMEOUT_SECONDS)), available_internal_state(true), - ?line [{testcase, Func},{watchdog, Dog}|Config]. + [{testcase, Func}|Config]. -end_per_testcase(_Func, Config) -> - ?line Dog = ?config(watchdog, Config), - ?line ?t:timetrap_cancel(Dog). +end_per_testcase(_Func, _Config) -> + ok. init_per_suite(Config) -> Config. @@ -69,7 +64,9 @@ end_per_suite(_Config) -> catch erts_debug:set_internal_state(not_running_optimization, true), available_internal_state(false). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [xm_sig_order, pending_exit_unlink_process, @@ -82,41 +79,30 @@ all() -> pending_exit_process_info_2, pending_exit_group_leader, exit_before_pending_exit]. -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -xm_sig_order(doc) -> ["Test that exit signals and messages are received " - "in correct order"]; -xm_sig_order(suite) -> []; +%% Test that exit signals and messages are received in correct order xm_sig_order(Config) when is_list(Config) -> - ?line LNode = node(), - ?line repeat(fun () -> xm_sig_order_test(LNode) end, 1000), - ?line {ok, RNode} = start_node(Config), - ?line repeat(fun () -> xm_sig_order_test(RNode) end, 1000), - ?line stop_node(RNode), - ?line ok. + LNode = node(), + repeat(fun () -> xm_sig_order_test(LNode) end, 1000), + {ok, RNode} = start_node(Config), + repeat(fun () -> xm_sig_order_test(RNode) end, 1000), + stop_node(RNode), + ok. xm_sig_order_test(Node) -> - ?line P = spawn(Node, fun () -> xm_sig_order_proc() end), - ?line M = erlang:monitor(process, P), - ?line P ! may_reach, - ?line P ! may_reach, - ?line P ! may_reach, - ?line exit(P, good_signal_order), - ?line P ! may_not_reach, - ?line P ! may_not_reach, - ?line P ! may_not_reach, - ?line receive + P = spawn(Node, fun () -> xm_sig_order_proc() end), + M = erlang:monitor(process, P), + P ! may_reach, + P ! may_reach, + P ! may_reach, + exit(P, good_signal_order), + P ! may_not_reach, + P ! may_not_reach, + P ! may_not_reach, + receive {'DOWN', M, process, P, R} -> - ?line good_signal_order = R + good_signal_order = R end. xm_sig_order_proc() -> @@ -127,168 +113,144 @@ xm_sig_order_proc() -> end, xm_sig_order_proc(). -pending_exit_unlink_process(doc) -> []; -pending_exit_unlink_process(suite) -> []; pending_exit_unlink_process(Config) when is_list(Config) -> - ?line pending_exit_test(self(), unlink). + pending_exit_test(self(), unlink). -pending_exit_unlink_dist_process(doc) -> []; -pending_exit_unlink_dist_process(suite) -> []; pending_exit_unlink_dist_process(Config) when is_list(Config) -> - ?line {ok, Node} = start_node(Config), - ?line From = spawn(Node, fun () -> receive after infinity -> ok end end), - ?line Res = pending_exit_test(From, unlink), - ?line stop_node(Node), - ?line Res. - -pending_exit_unlink_port(doc) -> []; -pending_exit_unlink_port(suite) -> []; + {ok, Node} = start_node(Config), + From = spawn(Node, fun () -> receive after infinity -> ok end end), + Res = pending_exit_test(From, unlink), + stop_node(Node), + Res. + pending_exit_unlink_port(Config) when is_list(Config) -> - ?line pending_exit_test(hd(erlang:ports()), unlink). + pending_exit_test(hd(erlang:ports()), unlink). -pending_exit_trap_exit(doc) -> []; -pending_exit_trap_exit(suite) -> []; pending_exit_trap_exit(Config) when is_list(Config) -> - ?line pending_exit_test(self(), trap_exit). + pending_exit_test(self(), trap_exit). -pending_exit_receive(doc) -> []; -pending_exit_receive(suite) -> []; pending_exit_receive(Config) when is_list(Config) -> - ?line pending_exit_test(self(), 'receive'). + pending_exit_test(self(), 'receive'). -pending_exit_exit(doc) -> []; -pending_exit_exit(suite) -> []; pending_exit_exit(Config) when is_list(Config) -> - ?line pending_exit_test(self(), exit). + pending_exit_test(self(), exit). -pending_exit_gc(doc) -> []; -pending_exit_gc(suite) -> []; pending_exit_gc(Config) when is_list(Config) -> - ?line pending_exit_test(self(), gc). + pending_exit_test(self(), gc). pending_exit_test(From, Type) -> - ?line case catch erlang:system_info(smp_support) of - true -> - ?line OTE = process_flag(trap_exit, true), - ?line Ref = make_ref(), - ?line Master = self(), - ?line ExitBySignal = case Type of - gc -> - lists:duplicate(10000, - exit_by_signal); - _ -> - exit_by_signal - end, - ?line Pid = spawn_link( - fun () -> - receive go -> ok end, - false = have_pending_exit(), - exit = fake_exit(From, - self(), - ExitBySignal), - true = have_pending_exit(), - Master ! {self(), Ref, Type}, - case Type of - gc -> - force_gc(), - erlang:yield(); - unlink -> - unlink(From); - trap_exit -> - process_flag(trap_exit, true); - 'receive' -> - receive _ -> ok - after 0 -> ok - end; - exit -> - ok - end, - exit(exit_by_myself) - end), - ?line Mon = erlang:monitor(process, Pid), - ?line Pid ! go, - ?line Reason = receive - {'DOWN', Mon, process, Pid, R} -> - ?line receive - {Pid, Ref, Type} -> - ?line ok - after 0 -> - ?line ?t:fail(premature_exit) - end, - ?line case Type of - exit -> - ?line exit_by_myself = R; - _ -> - ?line ExitBySignal = R - end - end, - ?line receive - {'EXIT', Pid, R2} -> - ?line Reason = R2 - end, - ?line process_flag(trap_exit, OTE), - ?line ok, - {comment, - "Test only valid with current SMP emulator."}; - _ -> - {skipped, - "SMP support not enabled. " - "Test only valid with current SMP emulator."} - end. + OTE = process_flag(trap_exit, true), + Ref = make_ref(), + Master = self(), + ExitBySignal = case Type of + gc -> + lists:duplicate(10000, + exit_by_signal); + _ -> + exit_by_signal + end, + Pid = spawn_link( + fun () -> + receive go -> ok end, + false = have_pending_exit(), + exit = fake_exit(From, + self(), + ExitBySignal), + true = have_pending_exit(), + Master ! {self(), Ref, Type}, + case Type of + gc -> + force_gc(), + erlang:yield(); + unlink -> + unlink(From); + trap_exit -> + process_flag(trap_exit, true); + 'receive' -> + receive _ -> ok + after 0 -> ok + end; + exit -> + ok + end, + exit(exit_by_myself) + end), + Mon = erlang:monitor(process, Pid), + Pid ! go, + Reason = receive + {'DOWN', Mon, process, Pid, R} -> + receive + {Pid, Ref, Type} -> + ok + after 0 -> + ct:fail(premature_exit) + end, + case Type of + exit -> + exit_by_myself = R; + _ -> + ExitBySignal = R + end + end, + receive + {'EXIT', Pid, R2} -> + Reason = R2 + end, + process_flag(trap_exit, OTE), + ok, + {comment, "Test only valid with current SMP emulator."}. -exit_before_pending_exit(doc) -> []; -exit_before_pending_exit(suite) -> []; exit_before_pending_exit(Config) when is_list(Config) -> %% This is a testcase testcase very specific to the smp %% implementation as it is of the time of writing. %% %% The testcase tries to check that a process can %% exit by itself even though it has a pending exit. - ?line OTE = process_flag(trap_exit, true), - ?line Master = self(), - ?line Tester = spawn_link( - fun () -> - Opts = case {erlang:system_info(run_queues), - erlang:system_info(schedulers_online)} of - {RQ, SO} when RQ =:= 1; SO =:= 1 -> []; - _ -> - process_flag(scheduler, 1), - [{scheduler, 2}] - end, - P = self(), - Exiter = spawn_opt(fun () -> - receive - {exit_me, P, R} -> - exit(P, R) - end - end, Opts), - erlang:yield(), - Exiter ! {exit_me, self(), exited_by_exiter}, - %% We want to get a pending exit - %% before we exit ourselves. We - %% don't want to be scheduled out - %% since we will then see the - %% pending exit. - %% - %% Do something that takes - %% relatively long time but - %% consumes few reductions... - repeat(fun() -> erlang:system_info(procs) end,10), - %% ... then exit. - Master ! {self(), - pending_exit, - have_pending_exit()}, - exit(exited_by_myself) - end), - ?line PendingExit = receive {Tester, pending_exit, PE} -> PE end, - ?line receive + OTE = process_flag(trap_exit, true), + Master = self(), + Tester = spawn_link( + fun () -> + Opts = case {erlang:system_info(run_queues), + erlang:system_info(schedulers_online)} of + {RQ, SO} when RQ =:= 1; SO =:= 1 -> []; + _ -> + process_flag(scheduler, 1), + [{scheduler, 2}] + end, + P = self(), + Exiter = spawn_opt(fun () -> + receive + {exit_me, P, R} -> + exit(P, R) + end + end, Opts), + erlang:yield(), + Exiter ! {exit_me, self(), exited_by_exiter}, + %% We want to get a pending exit + %% before we exit ourselves. We + %% don't want to be scheduled out + %% since we will then see the + %% pending exit. + %% + %% Do something that takes + %% relatively long time but + %% consumes few reductions... + repeat(fun() -> erlang:system_info(procs) end,10), + %% ... then exit. + Master ! {self(), + pending_exit, + have_pending_exit()}, + exit(exited_by_myself) + end), + PendingExit = receive {Tester, pending_exit, PE} -> PE end, + receive {'EXIT', Tester, exited_by_myself} -> - ?line process_flag(trap_exit, OTE), - ?line ok; + process_flag(trap_exit, OTE), + ok; Msg -> - ?line ?t:fail({unexpected_message, Msg}) + ct:fail({unexpected_message, Msg}) end, NoScheds = integer_to_list(erlang:system_info(schedulers_online)), {comment, @@ -303,101 +265,101 @@ exit_before_pending_exit(Config) when is_list(Config) -> -define(PE_INFO_REPEAT, 100). pending_exit_is_process_alive(Config) when is_list(Config) -> - ?line S = exit_op_test_init(), - ?line TestFun = fun (P) -> false = is_process_alive(P) end, - ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - ?line verify_pending_exit_success(S), - ?line comment(). + S = exit_op_test_init(), + TestFun = fun (P) -> false = is_process_alive(P) end, + repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + verify_pending_exit_success(S), + comment(). pending_exit_process_info_1(Config) when is_list(Config) -> - ?line S = exit_op_test_init(), - ?line TestFun = fun (P) -> + S = exit_op_test_init(), + TestFun = fun (P) -> undefined = process_info(P) end, - ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - ?line verify_pending_exit_success(S), - ?line comment(). + repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + verify_pending_exit_success(S), + comment(). pending_exit_process_info_2(Config) when is_list(Config) -> - ?line S0 = exit_op_test_init(), - ?line repeated_exit_op_test(fun (P) -> + S0 = exit_op_test_init(), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, messages) end, ?PE_INFO_REPEAT), - ?line S1 = verify_pending_exit_success(S0), - ?line repeated_exit_op_test(fun (P) -> + S1 = verify_pending_exit_success(S0), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, status) end, ?PE_INFO_REPEAT), - ?line S2 = verify_pending_exit_success(S1), - ?line repeated_exit_op_test(fun (P) -> + S2 = verify_pending_exit_success(S1), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, links) end, ?PE_INFO_REPEAT), - ?line S3 = verify_pending_exit_success(S2), - ?line repeated_exit_op_test(fun (P) -> + S3 = verify_pending_exit_success(S2), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [messages]) end, ?PE_INFO_REPEAT), - ?line S4 = verify_pending_exit_success(S3), - ?line repeated_exit_op_test(fun (P) -> + S4 = verify_pending_exit_success(S3), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [status]) end, ?PE_INFO_REPEAT), - ?line S5 = verify_pending_exit_success(S4), - ?line repeated_exit_op_test(fun (P) -> + S5 = verify_pending_exit_success(S4), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [links]) end, ?PE_INFO_REPEAT), - ?line S6 = verify_pending_exit_success(S5), - ?line repeated_exit_op_test(fun (P) -> + S6 = verify_pending_exit_success(S5), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [status, links]) end, ?PE_INFO_REPEAT), - ?line S7 = verify_pending_exit_success(S6), - ?line repeated_exit_op_test(fun (P) -> + S7 = verify_pending_exit_success(S6), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [messages, status]) end, ?PE_INFO_REPEAT), - ?line S8 = verify_pending_exit_success(S7), - ?line repeated_exit_op_test(fun (P) -> + S8 = verify_pending_exit_success(S7), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [messages, links]) end, ?PE_INFO_REPEAT), - ?line S9 = verify_pending_exit_success(S8), - ?line repeated_exit_op_test( + S9 = verify_pending_exit_success(S8), + repeated_exit_op_test( fun (P) -> undefined = process_info(P, [message_queue_len, status]) end, ?PE_INFO_REPEAT), - ?line S10 = verify_pending_exit_success(S9), - ?line repeated_exit_op_test(fun (P) -> + S10 = verify_pending_exit_success(S9), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [messages, links, status]) end, ?PE_INFO_REPEAT), - ?line verify_pending_exit_success(S10), - ?line comment(). + verify_pending_exit_success(S10), + comment(). pending_exit_process_display(Config) when is_list(Config) -> - ?line S = exit_op_test_init(), - ?line TestFun = fun (P) -> + S = exit_op_test_init(), + TestFun = fun (P) -> badarg = try erlang:process_display(P, backtrace) catch error:badarg -> badarg end end, - ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - ?line verify_pending_exit_success(S), - ?line comment(). + repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + verify_pending_exit_success(S), + comment(). pending_exit_group_leader(Config) when is_list(Config) -> - ?line S = exit_op_test_init(), - ?line TestFun = fun (P) -> + S = exit_op_test_init(), + TestFun = fun (P) -> badarg = try group_leader(self(), P) catch error:badarg -> badarg end end, - ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - ?line verify_pending_exit_success(S), - ?line comment(). + repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + verify_pending_exit_success(S), + comment(). %% %% -- Internal utils -------------------------------------------------------- @@ -515,17 +477,15 @@ repeat(Fun, N) when is_integer(N) -> repeat(Fun, N-1). start_node(Config) -> - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" ++ atom_to_list(?config(testcase, Config)) - ++ "-" ++ integer_to_list(A) - ++ "-" ++ integer_to_list(B) - ++ "-" ++ integer_to_list(C)), + ++ "-" ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" ++ integer_to_list(erlang:system_time(second)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), Pa = filename:dirname(code:which(?MODULE)), - ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]). + test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). have_pending_exit() -> have_pending_exit(self()). @@ -541,15 +501,15 @@ fake_exit(From, To, Reason) -> available_internal_state(Bool) when Bool == true; Bool == false -> case {Bool, - (catch erts_debug:get_internal_state(available_internal_state))} of - {true, true} -> - true; - {false, true} -> - erts_debug:set_internal_state(available_internal_state, false), - true; - {true, _} -> - erts_debug:set_internal_state(available_internal_state, true), - false; - {false, _} -> - false + (catch erts_debug:get_internal_state(available_internal_state))} of + {true, true} -> + true; + {false, true} -> + erts_debug:set_internal_state(available_internal_state, false), + true; + {true, _} -> + erts_debug:set_internal_state(available_internal_state, true), + false; + {false, _} -> + false end. diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl index 10b7e16a74..adc6f56c06 100644 --- a/erts/emulator/test/smoke_test_SUITE.erl +++ b/erts/emulator/test/smoke_test_SUITE.erl @@ -1,56 +1,40 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% Copyright Ericsson AB 2011-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(smoke_test_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). -export([boot_combo/1, native_atomics/1, jump_table/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(2)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [boot_combo, native_atomics, jump_table]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - init_per_testcase(boot_combo = Case, Config) when is_list(Config) -> case erlang:system_info(build_type) of opt -> @@ -62,12 +46,9 @@ init_per_testcase(Case, Config) when is_list(Config) -> init_per_tc(Case, Config). init_per_tc(Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{testcase, Case},{watchdog, Dog}|Config]. + [{testcase, Case}|Config]. end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), ok. %%% @@ -85,17 +66,10 @@ boot_combo(Config) when is_list(Config) -> ok end end, - SMPDisable = fun () -> false = erlang:system_info(smp_support) end, try chk_boot(Config, "+Ktrue", NOOP), chk_boot(Config, "+A42", A42), - chk_boot(Config, "-smp disable", SMPDisable), chk_boot(Config, "+Ktrue +A42", A42), - chk_boot(Config, "-smp disable +A42", - fun () -> SMPDisable(), A42() end), - chk_boot(Config, "-smp disable +Ktrue", SMPDisable), - chk_boot(Config, "-smp disable +Ktrue +A42", - fun () -> SMPDisable(), A42() end), %% A lot more combos could be implemented... ok after @@ -110,15 +84,13 @@ native_atomics(Config) when is_list(Config) -> NA64Key = "64-bit native atomics", DWNAKey = "Double word native atomics", EthreadInfo = erlang:system_info(ethread_info), - ?t:format("~p~n", [EthreadInfo]), + io:format("~p~n", [EthreadInfo]), {value,{NA32Key, NA32, _}} = lists:keysearch(NA32Key, 1, EthreadInfo), {value,{NA64Key, NA64, _}} = lists:keysearch(NA64Key, 1, EthreadInfo), {value,{DWNAKey, DWNA, _}} = lists:keysearch(DWNAKey, 1, EthreadInfo), - case {erlang:system_info(build_type), erlang:system_info(smp_support), NA32, NA64, DWNA} of - {opt, true, "no", "no", _} -> - ?t:fail(optimized_smp_runtime_without_native_atomics); - {_, false, "no", "no", _} -> - {comment, "No native atomics"}; + case {erlang:system_info(build_type), NA32, NA64, DWNA} of + {opt, "no", "no", _} -> + ct:fail(optimized_smp_runtime_without_native_atomics); _ -> {comment, NA32 ++ " 32-bit, " @@ -133,7 +105,7 @@ jump_table(Config) when is_list(Config) -> false -> case erlang:system_info(build_type) of opt -> - ?t:fail(optimized_without_beam_jump_table); + ct:fail(optimized_without_beam_jump_table); BT -> {comment, "No beam jump table, but build type is " ++ atom_to_list(BT)} end @@ -148,7 +120,7 @@ chk_boot(Config, Args, Fun) -> true = os:putenv("ERL_ZFLAGS", Args), Success = make_ref(), Parent = self(), - ?t:format("--- Testing ~s~n", [Args]), + io:format("--- Testing ~s~n", [Args]), {ok, Node} = start_node(Config), Pid = spawn_link(Node, fun () -> Fun(), @@ -158,7 +130,7 @@ chk_boot(Config, Args, Fun) -> {Pid, Success} -> Node = node(Pid), stop_node(Node), - ?t:format("--- Success!~n", []), + io:format("--- Success!~n", []), ok end. @@ -167,19 +139,16 @@ start_node(Config) -> start_node(Config, Args) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), - {A, B, C} = now(), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) + ++ atom_to_list(proplists:get_value(testcase, Config)) ++ "-" - ++ integer_to_list(B) + ++ integer_to_list(erlang:system_time(second)) ++ "-" - ++ integer_to_list(C)), + ++ integer_to_list(erlang:unique_integer([positive]))), Opts = [{args, "-pa "++Pa++" "++Args}], - ?t:start_node(Name, slave, Opts). + test_server:start_node(Name, slave, Opts). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index c428be6c5a..029a6de897 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,102 +22,93 @@ %% Tests the statistics/1 bif. --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, +-export([all/0, suite/0, groups/0, + wall_clock_sanity/1, wall_clock_zero_diff/1, wall_clock_update/1, - runtime_zero_diff/1, + runtime_sanity/1, + runtime_zero_diff/1, runtime_update/1, runtime_diff/1, run_queue_one/1, scheduler_wall_time/1, + scheduler_wall_time_all/1, + msb_scheduler_wall_time/1, reductions/1, reductions_big/1, garbage_collection/1, io/1, - badarg/1]). + badarg/1, run_queues_lengths_active_tasks/1, msacc/1]). %% Internal exports. -export([hog/1]). --include_lib("test_server/include/test_server.hrl"). - -init_per_testcase(_, Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(300)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_, Config) -> - Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [{group, wall_clock}, {group, runtime}, reductions, - reductions_big, {group, run_queue}, scheduler_wall_time, - garbage_collection, io, badarg]. + reductions_big, {group, run_queue}, + scheduler_wall_time, scheduler_wall_time_all, + msb_scheduler_wall_time, + garbage_collection, io, badarg, + run_queues_lengths_active_tasks, + msacc]. groups() -> [{wall_clock, [], - [wall_clock_zero_diff, wall_clock_update]}, + [wall_clock_sanity, wall_clock_zero_diff, wall_clock_update]}, {runtime, [], - [runtime_zero_diff, runtime_update, runtime_diff]}, + [runtime_sanity, runtime_zero_diff, runtime_update, runtime_diff]}, {run_queue, [], [run_queue_one]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> +wall_clock_sanity(Config) when is_list(Config) -> + erlang:yield(), + {WallClock, _} = statistics(wall_clock), + MT = erlang:monotonic_time(), + Time = erlang:convert_time_unit(MT - erlang:system_info(start_time), + native, millisecond), + io:format("Time=~p WallClock=~p~n", + [Time, WallClock]), + true = WallClock =< Time, + true = Time - 100 =< WallClock, ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - - %%% Testing statistics(wall_clock). - - -wall_clock_zero_diff(doc) -> - "Tests that the 'Wall clock since last call' element of the result " - "is zero when statistics(runtime) is called twice in succession."; +%% Tests that the 'Wall clock since last call' element of the result +%% is zero when statistics(runtime) is called twice in succession. wall_clock_zero_diff(Config) when is_list(Config) -> wall_clock_zero_diff1(16). wall_clock_zero_diff1(N) when N > 0 -> - ?line {Time, _} = statistics(wall_clock), - ?line case statistics(wall_clock) of - {Time, 0} -> ok; - _ -> wall_clock_zero_diff1(N-1) + {Time, _} = statistics(wall_clock), + case statistics(wall_clock) of + {Time, 0} -> ok; + _ -> wall_clock_zero_diff1(N-1) end; wall_clock_zero_diff1(0) -> - ?line test_server:fail("Difference never zero."). + ct:fail("Difference never zero."). -wall_clock_update(doc) -> - "Test that the time differences returned by two calls to " - "statistics(wall_clock) are compatible, and are within a small number " - "of ms of the amount of real time we waited for."; +%% Test that the time differences returned by two calls to +%% statistics(wall_clock) are compatible, and are within a small number +%% of ms of the amount of real time we waited for. wall_clock_update(Config) when is_list(Config) -> wall_clock_update1(6). wall_clock_update1(N) when N > 0 -> - ?line {T1_wc_time, _} = statistics(wall_clock), - ?line receive after 1000 -> ok end, - ?line {T2_wc_time, Wc_Diff} = statistics(wall_clock), - - ?line Wc_Diff = T2_wc_time - T1_wc_time, - ?line test_server:format("Wall clock diff = ~p; should be = 1000..1040~n", - [Wc_Diff]), - case ?t:is_debug() of - false -> - ?line true = Wc_Diff =< 1040; - true -> - ?line true = Wc_Diff =< 2000 %Be more tolerant in debug-compiled emulator. + {T1_wc_time, _} = statistics(wall_clock), + receive after 1000 -> ok end, + {T2_wc_time, Wc_Diff} = statistics(wall_clock), + + Wc_Diff = T2_wc_time - T1_wc_time, + io:format("Wall clock diff = ~p; should be = 1000..1040~n", [Wc_Diff]), + case test_server:is_debug() of + false -> + true = Wc_Diff =< 1040; + true -> + true = Wc_Diff =< 2000 %Be more tolerant in debug-compiled emulator. end, - ?line true = Wc_Diff >= 1000, + true = Wc_Diff >= 1000, wall_clock_update1(N-1); wall_clock_update1(0) -> ok. @@ -124,65 +116,79 @@ wall_clock_update1(0) -> %%% Test statistics(runtime). +runtime_sanity(Config) when is_list(Config) -> + case erlang:system_info(logical_processors_available) of + unknown -> + {skipped, "Don't know available logical processors"}; + LP when is_integer(LP) -> + erlang:yield(), + {RunTime, _} = statistics(runtime), + MT = erlang:monotonic_time(), + Time = erlang:convert_time_unit(MT - erlang:system_info(start_time), + native, millisecond), + io:format("Time=~p RunTime=~p~n", + [Time, RunTime]), + true = RunTime =< Time*LP + end. -runtime_zero_diff(doc) -> - "Tests that the difference between the times returned from two consectuitive " - "calls to statistics(runtime) is zero."; +%% Tests that the difference between the times returned from two consectuitive +%% calls to statistics(runtime) is zero. runtime_zero_diff(Config) when is_list(Config) -> - ?line runtime_zero_diff1(16). + runtime_zero_diff1(16). runtime_zero_diff1(N) when N > 0 -> - ?line {T1, _} = statistics(runtime), - ?line case statistics(runtime) of - {T1, 0} -> ok; - _ -> runtime_zero_diff1(N-1) - end; + {T1, _} = statistics(runtime), + case statistics(runtime) of + {T1, 0} -> ok; + _ -> runtime_zero_diff1(N-1) + end; runtime_zero_diff1(0) -> - ?line test_server:fail("statistics(runtime) never returned zero difference"). + ct:fail("statistics(runtime) never returned zero difference"). -runtime_update(doc) -> - "Test that the statistics(runtime) returns a substanstially " - "updated difference after running a process that takes all CPU " - " power of the Erlang process for a second."; +%% Test that the statistics(runtime) returns a substanstially +%% updated difference after running a process that takes all CPU +%% power of the Erlang process for a second. runtime_update(Config) when is_list(Config) -> - case ?t:is_cover() of - false -> - ?line process_flag(priority, high), - do_runtime_update(10); - true -> - {skip,"Cover-compiled"} + case test_server:is_cover() of + false -> + process_flag(priority, high), + do_runtime_update(10); + true -> + {skip,"Cover-compiled"} end. do_runtime_update(0) -> {comment,"Never close enough"}; do_runtime_update(N) -> - ?line {T1,Diff0} = statistics(runtime), - ?line spawn_link(fun cpu_heavy/0), + {T1,Diff0} = statistics(runtime), + {CPUHog, CPUHogMon} = spawn_opt(fun cpu_heavy/0,[link,monitor]), receive after 1000 -> ok end, - ?line {T2,Diff} = statistics(runtime), - ?line true = is_integer(T1+T2+Diff0+Diff), - ?line test_server:format("T1 = ~p, T2 = ~p, Diff = ~p, T2-T1 = ~p", - [T1,T2,Diff,T2-T1]), - ?line if - T2 - T1 =:= Diff, 900 =< Diff, Diff =< 1500 -> ok; - true -> do_runtime_update(N-1) - end. + {T2,Diff} = statistics(runtime), + unlink(CPUHog), + exit(CPUHog, kill), + true = is_integer(T1+T2+Diff0+Diff), + io:format("T1 = ~p, T2 = ~p, Diff = ~p, T2-T1 = ~p", [T1,T2,Diff,T2-T1]), + receive {'DOWN',CPUHogMon,process,CPUHog,_} -> ok end, + if + T2 - T1 =:= Diff, 900 =< Diff, Diff =< 1500 -> ok; + true -> do_runtime_update(N-1) + end. + cpu_heavy() -> cpu_heavy(). -runtime_diff(doc) -> - "Test that the difference between two consecutive absolute runtimes is " - "equal to the last relative runtime. The loop runs a lot of times since " - "the bug which this test case tests for showed up only rarely."; +%% Test that the difference between two consecutive absolute runtimes is +%% equal to the last relative runtime. The loop runs a lot of times since +%% the bug which this test case tests for showed up only rarely. runtime_diff(Config) when is_list(Config) -> runtime_diff1(1000). runtime_diff1(N) when N > 0 -> - ?line {T1_wc_time, _} = statistics(runtime), - ?line do_much(), - ?line {T2_wc_time, Wc_Diff} = statistics(runtime), - ?line Wc_Diff = T2_wc_time - T1_wc_time, + {T1_wc_time, _} = statistics(runtime), + do_much(), + {T2_wc_time, Wc_Diff} = statistics(runtime), + Wc_Diff = T2_wc_time - T1_wc_time, runtime_diff1(N-1); runtime_diff1(0) -> ok. @@ -200,10 +206,9 @@ do_much(N) -> do_much(N-1). -reductions(doc) -> - "Test that statistics(reductions) is callable, and that " - "Total_Reductions and Reductions_Since_Last_Call make sense. " - "(This to fail on pre-R3A version of JAM."; +%% Test that statistics(reductions) is callable, and that +%% Total_Reductions and Reductions_Since_Last_Call make sense. +%% This to fail on pre-R3A version of JAM. reductions(Config) when is_list(Config) -> {Reductions, _} = statistics(reductions), @@ -216,13 +221,13 @@ reductions(Config) when is_list(Config) -> reductions(300, Reductions, Mask). reductions(N, Previous, Mask) when N > 0 -> - ?line {Reductions, Diff} = statistics(reductions), - ?line build_some_garbage(), - ?line if Reductions > 0 -> ok end, - ?line if Diff >= 0 -> ok end, + {Reductions, Diff} = statistics(reductions), + build_some_garbage(), + if Reductions > 0 -> ok end, + if Diff >= 0 -> ok end, io:format("Previous = ~p, Reductions = ~p, Diff = ~p, DiffShouldBe = ~p", - [Previous, Reductions, Diff, (Reductions-Previous) band Mask]), - ?line if Reductions == ((Previous+Diff) band Mask) -> reductions(N-1, Reductions, Mask) end; + [Previous, Reductions, Diff, (Reductions-Previous) band Mask]), + if Reductions == ((Previous+Diff) band Mask) -> reductions(N-1, Reductions, Mask) end; reductions(0, _, _) -> ok. @@ -231,180 +236,479 @@ build_some_garbage() -> %% a garbage collection in the scheduler. processes(). -reductions_big(doc) -> - "Test that the number of reductions can be returned as a big number."; +%% Test that the number of reductions can be returned as a big number. reductions_big(Config) when is_list(Config) -> - ?line reductions_big_loop(), + reductions_big_loop(), ok. reductions_big_loop() -> erlang:yield(), case statistics(reductions) of - {Red, Diff} when Red >= 16#7ffFFFF -> - ok = io:format("Reductions = ~w, Diff = ~w", [Red, Diff]); - _ -> - reductions_big_loop() + {Red, Diff} when Red >= 16#7ffFFFF -> + ok = io:format("Reductions = ~w, Diff = ~w", [Red, Diff]); + _ -> + reductions_big_loop() end. %%% Tests of statistics(run_queue). -run_queue_one(doc) -> - "Tests that statistics(run_queue) returns 1 if we start a " - "CPU-bound process."; +%% Tests that statistics(run_queue) returns 1 if we start a +%% CPU-bound process. run_queue_one(Config) when is_list(Config) -> - ?line MS = erlang:system_flag(multi_scheduling, block), - ?line run_queue_one_test(Config), - ?line erlang:system_flag(multi_scheduling, unblock), + MS = erlang:system_flag(multi_scheduling, block), + run_queue_one_test(Config), + erlang:system_flag(multi_scheduling, unblock), case MS of - blocked -> - {comment, - "Multi-scheduling blocked during test. This test-case " - "was not written to work with multiple schedulers."}; - _ -> ok + blocked -> + {comment, + "Multi-scheduling blocked during test. This test-case " + "was not written to work with multiple schedulers."}; + _ -> ok end. - + run_queue_one_test(Config) when is_list(Config) -> - ?line _Hog = spawn_link(?MODULE, hog, [self()]), - ?line receive - hog_started -> ok - end, - ?line receive after 100 -> ok end, % Give hog a head start. - ?line case statistics(run_queue) of - N when N >= 1 -> ok; - Other -> ?line ?t:fail({unexpected,Other}) - end, + _Hog = spawn_link(?MODULE, hog, [self()]), + receive + hog_started -> ok + end, + receive after 100 -> ok end, % Give hog a head start. + case statistics(run_queue) of + N when N >= 1 -> ok; + Other -> ct:fail({unexpected,Other}) + end, ok. %% CPU-bound process, going at low priority. It will always be ready %% to run. hog(Pid) -> - ?line process_flag(priority, low), - ?line Pid ! hog_started, - ?line Mon = erlang:monitor(process, Pid), - ?line hog_iter(0, Mon). + process_flag(priority, low), + Pid ! hog_started, + Mon = erlang:monitor(process, Pid), + hog_iter(0, Mon). hog_iter(N, Mon) when N > 0 -> receive - {'DOWN', Mon, _, _, _} -> ok + {'DOWN', Mon, _, _, _} -> ok after 0 -> - ?line hog_iter(N-1, Mon) + hog_iter(N-1, Mon) end; hog_iter(0, Mon) -> - ?line hog_iter(10000, Mon). + hog_iter(10000, Mon). %%% Tests of statistics(scheduler_wall_time). -scheduler_wall_time(doc) -> - "Tests that statistics(scheduler_wall_time) works as intended"; +%% Tests that statistics(scheduler_wall_time) works as intended scheduler_wall_time(Config) when is_list(Config) -> + scheduler_wall_time_test(scheduler_wall_time). + +%% Tests that statistics(scheduler_wall_time_all) works as intended +scheduler_wall_time_all(Config) when is_list(Config) -> + scheduler_wall_time_test(scheduler_wall_time_all). + +scheduler_wall_time_test(Type) -> %% Should return undefined if system_flag is not turned on yet - undefined = statistics(scheduler_wall_time), + undefined = statistics(Type), %% Turn on statistics false = erlang:system_flag(scheduler_wall_time, true), try - Schedulers = erlang:system_info(schedulers_online), - %% Let testserver and everyone else finish their work - timer:sleep(500), - %% Empty load - EmptyLoad = get_load(), - {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad}, - MeMySelfAndI = self(), - StartHog = fun() -> - Pid = spawn(?MODULE, hog, [self()]), - receive hog_started -> MeMySelfAndI ! go end, - Pid - end, - P1 = StartHog(), - %% Max on one, the other schedulers empty (hopefully) - %% Be generous the process can jump between schedulers - %% which is ok and we don't want the test to fail for wrong reasons - _L1 = [S1Load|EmptyScheds1] = get_load(), - {true,_} = {S1Load > 50,S1Load}, - {false,_} = {lists:any(fun(Load) -> Load > 50 end, EmptyScheds1),EmptyScheds1}, - {true,_} = {lists:sum(EmptyScheds1) < 60,EmptyScheds1}, - - %% 50% load - HalfHogs = [StartHog() || _ <- lists:seq(1, (Schedulers-1) div 2)], - HalfLoad = lists:sum(get_load()) div Schedulers, - if Schedulers < 2, HalfLoad > 80 -> ok; %% Ok only one scheduler online and one hog - %% We want roughly 50% load - HalfLoad > 40, HalfLoad < 60 -> ok; - true -> exit({halfload, HalfLoad}) - end, - - %% 100% load - LastHogs = [StartHog() || _ <- lists:seq(1, Schedulers div 2)], - FullScheds = get_load(), - {false,_} = {lists:any(fun(Load) -> Load < 80 end, FullScheds),FullScheds}, - FullLoad = lists:sum(FullScheds) div Schedulers, - if FullLoad > 90 -> ok; - true -> exit({fullload, FullLoad}) - end, - - [exit(Pid, kill) || Pid <- [P1|HalfHogs++LastHogs]], - AfterLoad = get_load(), - {false,_} = {lists:any(fun(Load) -> Load > 5 end, AfterLoad),AfterLoad}, - true = erlang:system_flag(scheduler_wall_time, false) + Schedulers = erlang:system_info(schedulers_online), + DirtyCPUSchedulers = erlang:system_info(dirty_cpu_schedulers_online), + DirtyIOSchedulers = erlang:system_info(dirty_io_schedulers), + TotLoadSchedulers = case Type of + scheduler_wall_time_all -> + Schedulers + DirtyCPUSchedulers + DirtyIOSchedulers; + scheduler_wall_time -> + Schedulers + DirtyCPUSchedulers + end, + + %% Let testserver and everyone else finish their work + timer:sleep(1500), + %% Empty load + EmptyLoad = get_load(Type), + {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad}, + MeMySelfAndI = self(), + StartHog = fun() -> + Pid = spawn_link(?MODULE, hog, [self()]), + receive hog_started -> MeMySelfAndI ! go end, + Pid + end, + StartDirtyHog = fun(Func) -> + F = fun () -> + erts_debug:Func(alive_waitexiting, + MeMySelfAndI) + end, + Pid = spawn_link(F), + receive {alive, Pid} -> ok end, + Pid + end, + P1 = StartHog(), + %% Max on one, the other schedulers empty (hopefully) + %% Be generous the process can jump between schedulers + %% which is ok and we don't want the test to fail for wrong reasons + _L1 = [S1Load|EmptyScheds1] = get_load(Type), + {true,_} = {S1Load > 50,S1Load}, + {false,_} = {lists:any(fun(Load) -> Load > 50 end, EmptyScheds1),EmptyScheds1}, + {true,_} = {lists:sum(EmptyScheds1) < 60,EmptyScheds1}, + + %% 50% load + HalfHogs = [StartHog() || _ <- lists:seq(1, (Schedulers-1) div 2)], + HalfDirtyCPUHogs = [StartDirtyHog(dirty_cpu) + || _ <- lists:seq(1, lists:max([1,DirtyCPUSchedulers div 2]))], + HalfDirtyIOHogs = [StartDirtyHog(dirty_io) + || _ <- lists:seq(1, lists:max([1,DirtyIOSchedulers div 2]))], + HalfLoad = lists:sum(get_load(Type)) div TotLoadSchedulers, + if Schedulers < 2, HalfLoad > 80 -> ok; %% Ok only one scheduler online and one hog + %% We want roughly 50% load + HalfLoad > 40, HalfLoad < 60 -> ok; + true -> exit({halfload, HalfLoad}) + end, + + %% 100% load + LastHogs = [StartHog() || _ <- lists:seq(1, Schedulers div 2)], + LastDirtyCPUHogs = [StartDirtyHog(dirty_cpu) + || _ <- lists:seq(1, DirtyCPUSchedulers div 2)], + LastDirtyIOHogs = [StartDirtyHog(dirty_io) + || _ <- lists:seq(1, DirtyIOSchedulers div 2)], + FullScheds = get_load(Type), + {false,_} = {lists:any(fun(Load) -> Load < 80 end, FullScheds),FullScheds}, + FullLoad = lists:sum(FullScheds) div TotLoadSchedulers, + if FullLoad > 90 -> ok; + true -> exit({fullload, FullLoad}) + end, + + KillHog = fun (HP) -> + HPM = erlang:monitor(process, HP), + unlink(HP), + exit(HP, kill), + receive + {'DOWN', HPM, process, HP, killed} -> + ok + end + end, + [KillHog(Pid) || Pid <- [P1|HalfHogs++HalfDirtyCPUHogs++HalfDirtyIOHogs + ++LastHogs++LastDirtyCPUHogs++LastDirtyIOHogs]], + receive after 2000 -> ok end, %% Give dirty schedulers time to complete... + AfterLoad = get_load(Type), + io:format("AfterLoad=~p~n", [AfterLoad]), + {false,_} = {lists:any(fun(Load) -> Load > 25 end, AfterLoad),AfterLoad}, + true = erlang:system_flag(scheduler_wall_time, false) after - erlang:system_flag(scheduler_wall_time, false) + erlang:system_flag(scheduler_wall_time, false) end. -get_load() -> - Start = erlang:statistics(scheduler_wall_time), - timer:sleep(500), - End = erlang:statistics(scheduler_wall_time), +get_load(Type) -> + Start = erlang:statistics(Type), + timer:sleep(1500), + End = erlang:statistics(Type), lists:reverse(lists:sort(load_percentage(lists:sort(Start),lists:sort(End)))). load_percentage([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) -> [100*(WN-WP) div (TN-TP)|load_percentage(Ss, Ps)]; load_percentage([], []) -> []. +count(0) -> + ok; +count(N) -> + count(N-1). + +msb_swt_hog(true) -> + count(1000000), + erts_debug:dirty_cpu(wait, 10), + erts_debug:dirty_io(wait, 10), + msb_swt_hog(true); +msb_swt_hog(false) -> + count(1000000), + msb_swt_hog(false). + +msb_scheduler_wall_time(_Config) -> + erlang:system_flag(scheduler_wall_time, true), + Dirty = erlang:system_info(dirty_cpu_schedulers) /= 0, + Hogs = lists:map(fun (_) -> + spawn_opt(fun () -> + msb_swt_hog(Dirty) + end, [{priority,low}, link, monitor]) + end, lists:seq(1,10)), + erlang:system_flag(multi_scheduling, block), + try + SWT1 = lists:sort(statistics(scheduler_wall_time_all)), + %% io:format("SWT1 = ~p~n", [SWT1]), + receive after 4000 -> ok end, + SWT2 = lists:sort(statistics(scheduler_wall_time_all)), + %% io:format("SWT2 = ~p~n", [SWT2]), + SWT = lists:zip(SWT1, SWT2), + io:format("SU = ~p~n", [lists:map(fun({{I, A0, T0}, {I, A1, T1}}) -> + {I, (A1 - A0)/(T1 - T0)} end, + SWT)]), + {A, T} = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}}, {Ai,Ti}) -> + {Ai + (A1 - A0), Ti + (T1 - T0)} + end, + {0, 0}, + SWT), + TSU = A/T, + WSU = ((TSU * (erlang:system_info(schedulers) + + erlang:system_info(dirty_cpu_schedulers) + + erlang:system_info(dirty_io_schedulers))) + / 1), + %% Weighted scheduler utilization should be + %% very close to 1.0, i.e., we execute the + %% same time as one thread executing all + %% the time... + io:format("WSU = ~p~n", [WSU]), + true = 0.9 < WSU andalso WSU < 1.1, + ok + after + erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(scheduler_wall_time, false), + lists:foreach(fun ({HP, _HM}) -> + unlink(HP), + exit(HP, kill) + end, Hogs), + lists:foreach(fun ({HP, HM}) -> + receive + {'DOWN', HM, process, HP, _} -> + ok + end + end, Hogs), + ok + end. -garbage_collection(doc) -> - "Tests that statistics(garbage_collection) is callable. " - "It is not clear how to test anything more."; +%% Tests that statistics(garbage_collection) is callable. +%% It is not clear how to test anything more. garbage_collection(Config) when is_list(Config) -> - ?line Bin = list_to_binary(lists:duplicate(19999, 42)), - ?line case statistics(garbage_collection) of - {Gcs0,R,0} when is_integer(Gcs0), is_integer(R) -> - ?line io:format("Reclaimed: ~p", [R]), - ?line Gcs = garbage_collection_1(Gcs0, Bin), - ?line io:format("Reclaimed: ~p", - [element(2, statistics(garbage_collection))]), - {comment,integer_to_list(Gcs-Gcs0)++" GCs"} - end. + Bin = list_to_binary(lists:duplicate(19999, 42)), + case statistics(garbage_collection) of + {Gcs0,R,0} when is_integer(Gcs0), is_integer(R) -> + io:format("Reclaimed: ~p", [R]), + Gcs = garbage_collection_1(Gcs0, Bin), + io:format("Reclaimed: ~p", + [element(2, statistics(garbage_collection))]), + {comment,integer_to_list(Gcs-Gcs0)++" GCs"} + end. garbage_collection_1(Gcs0, Bin) -> case statistics(garbage_collection) of - {Gcs,Reclaimed,0} when Gcs >= Gcs0 -> - if - Reclaimed > 16#7ffffff -> - Gcs; - true -> - _ = binary_to_list(Bin), - erlang:garbage_collect(), - garbage_collection_1(Gcs, Bin) - end + {Gcs,Reclaimed,0} when Gcs >= Gcs0 -> + if + Reclaimed > 16#7ffffff -> + Gcs; + true -> + _ = binary_to_list(Bin), + erlang:garbage_collect(), + garbage_collection_1(Gcs, Bin) + end end. -io(doc) -> - "Tests that statistics(io) is callable. " - "This could be improved to test something more."; +%% Tests that statistics(io) is callable. +%% This could be improved to test something more. io(Config) when is_list(Config) -> - ?line case statistics(io) of - {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> ok - end. + case statistics(io) of + {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> ok + end. -badarg(doc) -> - "Tests that some illegal arguments to statistics fails."; +%% Tests that some illegal arguments to statistics fails. badarg(Config) when is_list(Config) -> - ?line case catch statistics(1) of - {'EXIT', {badarg, _}} -> ok - end, - ?line case catch statistics(bad_atom) of - {'EXIT', {badarg, _}} -> ok - end. + case catch statistics(1) of + {'EXIT', {badarg, _}} -> ok + end, + case catch statistics(bad_atom) of + {'EXIT', {badarg, _}} -> ok + end. + +tok_loop() -> + tok_loop(). + +run_queues_lengths_active_tasks(_Config) -> + TokLoops = lists:map(fun (_) -> + spawn_opt(fun () -> + tok_loop() + end, + [link, {priority, low}]) + end, + lists:seq(1,10)), + + + + TRQLs0 = statistics(total_run_queue_lengths), + TRQLAs0 = statistics(total_run_queue_lengths_all), + TATs0 = statistics(total_active_tasks), + TATAs0 = statistics(total_active_tasks_all), + true = is_integer(TRQLs0), + true = is_integer(TATs0), + true = TRQLs0 >= 0, + true = TRQLAs0 >= 0, + true = TATs0 >= 11, + true = TATAs0 >= 11, + + NoScheds = erlang:system_info(schedulers), + {DefRqs, + AllRqs} = case erlang:system_info(dirty_cpu_schedulers) of + 0 -> {NoScheds, NoScheds}; + _ -> {NoScheds+1, NoScheds+2} + end, + RQLs0 = statistics(run_queue_lengths), + RQLAs0 = statistics(run_queue_lengths_all), + ATs0 = statistics(active_tasks), + ATAs0 = statistics(active_tasks_all), + DefRqs = length(RQLs0), + AllRqs = length(RQLAs0), + DefRqs = length(ATs0), + AllRqs = length(ATAs0), + true = lists:sum(RQLs0) >= 0, + true = lists:sum(RQLAs0) >= 0, + true = lists:sum(ATs0) >= 11, + true = lists:sum(ATAs0) >= 11, + + SO = erlang:system_flag(schedulers_online, 1), + + %% Give newly suspended schedulers some time to + %% migrate away work from their run queues... + receive after 1000 -> ok end, + + TRQLs1 = statistics(total_run_queue_lengths), + TATs1 = statistics(total_active_tasks), + true = TRQLs1 >= 10, + true = TATs1 >= 11, + NoScheds = erlang:system_info(schedulers), + + RQLs1 = statistics(run_queue_lengths), + ATs1 = statistics(active_tasks), + DefRqs = length(RQLs1), + DefRqs = length(ATs1), + TRQLs2 = lists:sum(RQLs1), + TATs2 = lists:sum(ATs1), + true = TRQLs2 >= 10, + true = TATs2 >= 11, + [TRQLs2|_] = RQLs1, + [TATs2|_] = ATs1, + + erlang:system_flag(schedulers_online, SO), + + lists:foreach(fun (P) -> + unlink(P), + exit(P, bang) + end, + TokLoops), + + ok. + +%% Tests that statistics(microstate_statistics) works. +msacc(Config) -> + + %% Test if crypto nif is available + Niff = try crypto:strong_rand_bytes(1), ok catch _:_ -> nok end, + TmpFile = filename:join(proplists:get_value(priv_dir,Config),"file.tmp"), + + false = erlang:system_flag(microstate_accounting, true), + + msacc_test(TmpFile), + + true = erlang:system_flag(microstate_accounting, false), + + MsaccStats = erlang:statistics(microstate_accounting), + + case os:type() of + {win32, _} -> + %% Some windows have a very poor accuracy on their + %% timing primitives, so we just make sure that + %% some state besides sleep has been triggered. + Sum = lists:sum( + lists:map(fun({sleep, _V}) -> 0; + ({_, V}) -> V + end, maps:to_list(msacc_sum_states())) + ), + if Sum > 0 -> + ok; + true -> + ct:fail({no_states_triggered, MsaccStats}) + end; + _ -> + + %% Make sure that all states were triggered at least once + maps:map(fun(nif, 0) -> + case Niff of + ok -> + ct:fail({zero_state,nif}); + nok -> + ok + end; + (aux, 0) -> + %% aux will be zero if we do not have smp support + %% or no async threads + case erlang:system_info(thread_pool_size) > 0 of + false -> + ok; + true -> + ct:log("msacc: ~p",[MsaccStats]), + ct:fail({zero_state,aux}) + end; + (Key, 0) -> + ct:log("msacc: ~p",[MsaccStats]), + ct:fail({zero_state,Key}); + (_,_) -> ok + end, msacc_sum_states()) + end, + + erlang:system_flag(microstate_accounting, reset), + + msacc_test(TmpFile), + + %% Make sure all counters are zero after stopping and resetting + maps:map(fun(_Key, 0) -> ok; + (Key,_) -> + ct:log("msacc: ~p",[erlang:statistics(microstate_accounting)]), + ct:fail({non_zero_state,Key}) + end,msacc_sum_states()). + +%% This test tries to make sure to trigger all of the different available states +msacc_test(TmpFile) -> + + %% We write some data + [file:write_file(TmpFile,<<0:(1024*1024*8)>>,[raw]) || _ <- lists:seq(1,100)], + + %% Do some ETS operations + Tid = ets:new(table, []), + ets:insert(Tid, {1, hello}), + ets:delete(Tid), + + %% Check some IO + {ok, L} = gen_tcp:listen(0, [{active, true},{reuseaddr,true}]), + {ok, Port} = inet:port(L), + Pid = spawn(fun() -> + {ok, S} = gen_tcp:accept(L), + (fun F() -> receive M -> F() end end)() + end), + {ok, C} = gen_tcp:connect("localhost", Port, []), + [begin gen_tcp:send(C,"hello"),timer:sleep(1) end || _ <- lists:seq(1,100)], + + %% Collect some garbage + [erlang:garbage_collect() || _ <- lists:seq(1,100)], + + %% Send some messages + [begin self() ! {hello},receive _ -> ok end end || _ <- lists:seq(1,100)], + + %% Setup some timers + Refs = [erlang:send_after(10000,self(),ok) || _ <- lists:seq(1,100)], + + %% Do some nif work + catch [crypto:strong_rand_bytes(128) || _ <- lists:seq(1,100)], + + %% Cancel some timers + [erlang:cancel_timer(R) || R <- Refs], + + %% Wait for a while + timer:sleep(100). + +msacc_sum_states() -> + Stats = erlang:statistics(microstate_accounting), + [#{ counters := C }|_] = Stats, + InitialCounters = maps:map(fun(_,_) -> 0 end,C), + lists:foldl(fun(#{ counters := Counters }, Cnt) -> + maps:fold(fun(Key, Value, Acc) -> + NewValue = Value+maps:get(Key,Acc), + maps:update(Key, NewValue, Acc) + end, Cnt, Counters) + end,InitialCounters,Stats). diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index ceb4afb5cf..fdf4aab24d 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -30,55 +31,26 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). - -%-compile(export_all). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2]). +-include_lib("common_test/include/ct.hrl"). --export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1, memory/1, - ets_limit/1]). +-export([all/0, suite/0]). --define(DEFAULT_TIMEOUT, ?t:minutes(2)). +-export([process_count/1, system_version/1, misc_smoke_tests/1, + heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1, + atom_count/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [process_count, system_version, misc_smoke_tests, - heap_size, wordsize, memory, ets_limit]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. + heap_size, wordsize, memory, ets_limit, atom_limit, atom_count]. %%% %%% The test cases ------------------------------------------------------------- %%% -process_count(doc) -> []; -process_count(suite) -> []; process_count(Config) when is_list(Config) -> case catch erlang:system_info(modified_timing_level) of Level when is_integer(Level) -> @@ -91,37 +63,37 @@ process_count(Config) when is_list(Config) -> end. process_count_test() -> - ?line OldPrio = process_flag(priority, max), - ?line check_procs(10), - ?line check_procs(11234), - ?line check_procs(57), - ?line check_procs(1030), - ?line check_procs(687), - ?line check_procs(7923), - ?line check_procs(5302), - ?line check_procs(12456), - ?line check_procs(14), - ?line check_procs(1125), - ?line check_procs(236), - ?line check_procs(125), - ?line check_procs(2346), - ?line process_flag(priority, OldPrio), - ?line ok. + OldPrio = process_flag(priority, max), + check_procs(10), + check_procs(11234), + check_procs(57), + check_procs(1030), + check_procs(687), + check_procs(7923), + check_procs(5302), + check_procs(12456), + check_procs(14), + check_procs(1125), + check_procs(236), + check_procs(125), + check_procs(2346), + process_flag(priority, OldPrio), + ok. check_procs(N) -> - ?line CP = length(processes()), - ?line Procs = start_procs(N), - ?line check_pc(CP+N), - ?line stop_procs(Procs), - ?line check_pc(CP). + CP = length(processes()), + Procs = start_procs(N), + check_pc(CP+N), + stop_procs(Procs), + check_pc(CP). check_pc(E) -> - ?line P = length(processes()), - ?line SI = erlang:system_info(process_count), - ?line ?t:format("E=~p; P=~p; SI=~p~n", [E, P, SI]), - ?line E = P, - ?line P = SI. + P = length(processes()), + SI = erlang:system_info(process_count), + io:format("E=~p; P=~p; SI=~p~n", [E, P, SI]), + E = P, + P = SI. start_procs(N) -> lists:map(fun (_) -> @@ -142,54 +114,44 @@ stop_procs(PMs) -> end, PMs). -system_version(doc) -> []; -system_version(suite) -> []; system_version(Config) when is_list(Config) -> - ?line {comment, erlang:system_info(system_version)}. + {comment, erlang:system_info(system_version)}. -misc_smoke_tests(doc) -> []; -misc_smoke_tests(suite) -> []; misc_smoke_tests(Config) when is_list(Config) -> - ?line true = is_binary(erlang:system_info(info)), - ?line true = is_binary(erlang:system_info(procs)), - ?line true = is_binary(erlang:system_info(loaded)), - ?line true = is_binary(erlang:system_info(dist)), - ?line ok = try erlang:system_info({cpu_topology,erts_get_cpu_topology_error_case}), fail catch error:badarg -> ok end, - ?line ok. + true = is_binary(erlang:system_info(info)), + true = is_binary(erlang:system_info(procs)), + true = is_binary(erlang:system_info(loaded)), + true = is_binary(erlang:system_info(dist)), + ok = try erlang:system_info({cpu_topology,erts_get_cpu_topology_error_case}), fail catch error:badarg -> ok end, + true = lists:member(erlang:system_info(tolerant_timeofday), [enabled, disabled]), + ok. -heap_size(doc) -> []; -heap_size(suite) -> []; heap_size(Config) when is_list(Config) -> - ?line {min_bin_vheap_size, VHmin} = erlang:system_info(min_bin_vheap_size), - ?line {min_heap_size, Hmin} = erlang:system_info(min_heap_size), - ?line GCinf = erlang:system_info(garbage_collection), - ?line VHmin = proplists:get_value(min_bin_vheap_size, GCinf), - ?line Hmin = proplists:get_value(min_heap_size, GCinf), + {min_bin_vheap_size, VHmin} = erlang:system_info(min_bin_vheap_size), + {min_heap_size, Hmin} = erlang:system_info(min_heap_size), + GCinf = erlang:system_info(garbage_collection), + VHmin = proplists:get_value(min_bin_vheap_size, GCinf), + Hmin = proplists:get_value(min_heap_size, GCinf), ok. -wordsize(suite) -> - []; -wordsize(doc) -> - ["Tests the various wordsize variants"]; +%% 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, + A = erlang:system_info(wordsize), + true = is_integer(A), + A = erlang:system_info({wordsize,internal}), + B = erlang:system_info({wordsize,external}), + 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. -memory(doc) -> ["Verify that erlang:memory/0 and memory results in crashdump produce are similar"]; +%% Verify that erlang:memory/0 and memory results in crashdump produce are similar memory(Config) when is_list(Config) -> %% %% Verify that erlang:memory/0 and memory results in @@ -212,7 +174,7 @@ memory(Config) when is_list(Config) -> %% erts_debug:set_internal_state(available_internal_state, true), - %% Use a large heap size on the controling process in + %% Use a large heap size on the controlling process in %% order to avoid changes in its heap size during %% comparisons. MinHeapSize = process_flag(min_heap_size, 1024*1024), @@ -244,8 +206,7 @@ memory_test(_Config) -> end) end, 1000 div erlang:system_info(schedulers_online)) - end, - []), + end, []), cmp_memory(MWs, "spawn procs"), Ps = lists:flatten(DPs), @@ -253,23 +214,49 @@ memory_test(_Config) -> mem_workers_call(MWs, fun () -> lists:foreach(fun (P) -> link(P) end, Ps) - end, - []), + end, []), cmp_memory(MWs, "link procs"), mem_workers_call(MWs, fun () -> lists:foreach(fun (P) -> unlink(P) end, Ps) - end, - []), + end, []), cmp_memory(MWs, "unlink procs"), + mem_workers_call(MWs, + fun () -> + lists:foreach( + fun (P) -> + Tmr = erlang:start_timer(1 bsl 34, + P, + hello), + Tmrs = case get('BIF_TMRS') of + undefined -> []; + Rs -> Rs + end, + true = is_reference(Tmr), + put('BIF_TMRS', [Tmr|Tmrs]) + end, Ps) + end, []), + cmp_memory(MWs, "start BIF timer procs"), + + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (Tmr) -> + true = is_reference(Tmr), + true = is_integer(erlang:cancel_timer(Tmr)) + end, get('BIF_TMRS')), + put('BIF_TMRS', undefined), + garbage_collect() + end, []), + erts_debug:set_internal_state(wait, deallocations), + cmp_memory(MWs, "cancel BIF timer procs"), + DMs = mem_workers_call(MWs, fun () -> lists:map(fun (P) -> monitor(process, P) end, Ps) - end, - []), + end, []), cmp_memory(MWs, "monitor procs"), Ms = lists:flatten(DMs), mem_workers_call(MWs, @@ -277,8 +264,7 @@ memory_test(_Config) -> lists:foreach(fun (M) -> demonitor(M) end, Ms) - end, - []), + end, []), cmp_memory(MWs, "demonitor procs"), mem_workers_call(MWs, @@ -286,8 +272,7 @@ memory_test(_Config) -> lists:foreach(fun (P) -> P ! {a, "message", make_ref()} end, Ps) - end, - []), + end, []), cmp_memory(MWs, "message procs"), mem_workers_call(MWs, @@ -310,8 +295,7 @@ memory_test(_Config) -> fun () -> put(binary_data, mapn(fun (_) -> list_to_binary(lists:duplicate(256,$?)) end, 100)) - end, - []), + end, []), cmp_memory(MWs, "store binary data"), @@ -319,17 +303,15 @@ memory_test(_Config) -> fun () -> put(binary_data, false), garbage_collect() - end, - []), + end, []), cmp_memory(MWs, "release binary data"), mem_workers_call(MWs, fun () -> - list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), - list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), - list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))) - end, - []), + _ = list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), + _ = list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), + _ = list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))) + end, []), cmp_memory(MWs, "new atoms"), @@ -340,16 +322,14 @@ memory_test(_Config) -> ets:insert(T, {banan, lists:seq(1,1024)}), ets:insert(T, {appelsin, make_ref()}), put(ets_id, T) - end, - []), + end, []), cmp_memory(MWs, "store ets data"), mem_workers_call(MWs, fun () -> ets:delete(get(ets_id)), put(ets_id, false) - end, - []), + end, []), cmp_memory(MWs, "remove ets data"), lists:foreach(fun (MW) -> @@ -359,8 +339,7 @@ memory_test(_Config) -> receive {'DOWN', Mon, _, _, _} -> ok end - end, - MWs), + end, MWs), ok. mem_worker() -> @@ -375,22 +354,14 @@ mem_worker() -> mem_workers_call(MWs, Fun, Args) -> lists:foreach(fun (MW) -> - MW ! {call, self(), Fun, Args} - end, - MWs), + MW ! {call, self(), Fun, Args} + end, MWs), lists:map(fun (MW) -> - receive - {reply, MW, Res} -> - Res - end - end, - MWs). - -mem_workers_cast(MWs, Fun, Args) -> - lists:foreach(fun (MW) -> - MW ! {cast, self(), Fun, Args} - end, - MWs). + receive + {reply, MW, Res} -> + Res + end + end, MWs). spawn_mem_workers() -> spawn_mem_workers(erlang:system_info(schedulers_online)). @@ -403,7 +374,6 @@ spawn_mem_workers(N) -> link]) | spawn_mem_workers(N-1)]. - mem_get(X, Mem) -> case lists:keyfind(X, 1, Mem) of {X, Val} -> Val; @@ -471,25 +441,25 @@ cmp_memory(MWs, Str) -> "crash dump memory = ~p~n", [Str, EM, EDM]), - ?line check_sane_memory(EM), - ?line check_sane_memory(EDM), + check_sane_memory(EM), + check_sane_memory(EDM), %% We expect these to always give us exactly the same result - ?line cmp_memory(atom, EM, EDM, 1), - ?line cmp_memory(atom_used, EM, EDM, 1), - ?line cmp_memory(binary, EM, EDM, 1), - ?line cmp_memory(code, EM, EDM, 1), - ?line cmp_memory(ets, EM, EDM, 1), + cmp_memory(atom, EM, EDM, 1), + cmp_memory(atom_used, EM, EDM, 1), + cmp_memory(binary, EM, EDM, 1), + cmp_memory(code, EM, EDM, 1), + cmp_memory(ets, EM, EDM, 1), %% Total, processes, processes_used, and system will seldom %% give us exactly the same result since the two readings %% aren't taken atomically. - ?line cmp_memory(total, EM, EDM, 1.05), - ?line cmp_memory(processes, EM, EDM, 1.05), - ?line cmp_memory(processes_used, EM, EDM, 1.05), - ?line cmp_memory(system, EM, EDM, 1.05), + cmp_memory(total, EM, EDM, 1.05), + cmp_memory(processes, EM, EDM, 1.05), + cmp_memory(processes_used, EM, EDM, 1.05), + cmp_memory(system, EM, EDM, 1.05), ok. @@ -498,9 +468,18 @@ mapn(_Fun, 0) -> mapn(Fun, N) -> [Fun(N) | mapn(Fun, N-1)]. -ets_limit(doc) -> - "Verify system_info(ets_limit) reflects max ETS table settings."; -ets_limit(suite) -> []; + +get_node_name(Config) -> + list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))). + + +%% Verify system_info(ets_limit) reflects max ETS table settings. ets_limit(Config0) when is_list(Config0) -> Config = [{testcase,ets_limit}|Config0], true = is_integer(get_ets_limit(Config)), @@ -514,7 +493,7 @@ get_ets_limit(Config, EtsMax) -> 0 -> []; _ -> [{"ERL_MAX_ETS_TABLES", integer_to_list(EtsMax)}] end, - {ok, Node} = start_node(Config, Envs), + {ok, Node} = start_node_ets(Config, Envs), Me = self(), Ref = make_ref(), spawn_link(Node, @@ -530,19 +509,50 @@ get_ets_limit(Config, EtsMax) -> stop_node(Node), Res. -start_node(Config, Envs) when is_list(Config) -> +start_node_ets(Config, Envs) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), - {A, B, C} = now(), - Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), - ?t:start_node(Name, peer, [{args, "-pa "++Pa}, {env, Envs}]). + test_server:start_node(get_node_name(Config), peer, + [{args, "-pa "++Pa}, {env, Envs}]). + +start_node_atm(Config, AtomsMax) when is_list(Config) -> + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(get_node_name(Config), peer, + [{args, "-pa "++ Pa ++ AtomsMax}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). + + +%% Verify system_info(atom_limit) reflects max atoms settings +%% (using " +t"). +atom_limit(Config0) when is_list(Config0) -> + Config = [{testcase,atom_limit}|Config0], + 2186042 = get_atom_limit(Config, " +t 2186042 "), + ok. + +get_atom_limit(Config, AtomsMax) -> + {ok, Node} = start_node_atm(Config, AtomsMax), + Me = self(), + Ref = make_ref(), + spawn_link(Node, + fun() -> + Res = erlang:system_info(atom_limit), + unlink(Me), + Me ! {Ref, Res} + end), + receive + {Ref, Res} -> + Res + end, + stop_node(Node), + Res. + +%% Verify that system_info(atom_count) works. +atom_count(Config) when is_list(Config) -> + Limit = erlang:system_info(atom_limit), + Count1 = erlang:system_info(atom_count), + list_to_atom(integer_to_list(erlang:unique_integer())), + Count2 = erlang:system_info(atom_count), + true = Limit >= Count2, + true = Count2 > Count1, + ok. diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl index a387c08ef9..c9be54f668 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% Copyright Ericsson AB 2007-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,61 +23,29 @@ -module(system_profile_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, system_profile_on_and_off/1, - runnable_procs/1, - runnable_ports/1, + runnable_procs/1, runnable_ports/1, dont_profile_profiler/1, - scheduler/1 - ]). - --export([init_per_testcase/2, end_per_testcase/2]). + scheduler/1, sane_location/1]). -export([profiler_process/1, ring_loop/1, port_echo_start/0, list_load/0, run_load/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --define(default_timeout, ?t:minutes(1)). - -init_per_testcase(_Case, Config) -> - Dog=?t:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [system_profile_on_and_off, runnable_procs, - runnable_ports, scheduler, dont_profile_profiler]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - + runnable_ports, scheduler, dont_profile_profiler, + sane_location]. %% No specification clause needed for an init function in a conf case!!! %% Test switching system_profiling on and off. -system_profile_on_and_off(suite) -> - []; -system_profile_on_and_off(doc) -> - ["Tests switching system_profiling on and off."]; system_profile_on_and_off(Config) when is_list(Config) -> Pid = start_profiler_process(), @@ -105,20 +74,29 @@ system_profile_on_and_off(Config) when is_list(Config) -> exit(Pid,kill), ok. -%% Test runnable_procs - -runnable_procs(suite) -> - []; -runnable_procs(doc) -> - ["Tests system_profiling with runnable_procs."]; +%% Tests system_profiling with runnable_procs. runnable_procs(Config) when is_list(Config) -> + lists:foreach(fun (TsType) -> + Arg = case TsType of + no_timestamp -> + {timestamp, []}; + _ -> + {TsType, [TsType]} + end, + do_runnable_procs(Arg), + receive after 1000 -> ok end + end, + [no_timestamp, timestamp, monotonic_timestamp, + strict_monotonic_timestamp]). + +do_runnable_procs({TsType, TsTypeFlag}) -> Pid = start_profiler_process(), % start a ring of processes % FIXME: Set #laps and #nodes in config file Nodes = 10, Laps = 10, Master = ring(Nodes), - undefined = erlang:system_profile(Pid, [runnable_procs]), + undefined = erlang:system_profile(Pid, [runnable_procs]++TsTypeFlag), % loop a message ok = ring_message(Master, message, Laps), Events = get_profiler_events(), @@ -126,20 +104,31 @@ runnable_procs(Config) when is_list(Config) -> erlang:system_profile(undefined, []), put(master, Master), put(laps, Laps), - true = has_runnable_event(Events), + true = has_runnable_event(TsType, Events), Pids = sort_events_by_pid(Events), - ok = check_events(Pids), + ok = check_events(TsType, Pids), erase(), exit(Pid,kill), ok. -runnable_ports(suite) -> - []; -runnable_ports(doc) -> - ["Tests system_profiling with runnable_port."]; +%% Tests system_profiling with runnable_port. runnable_ports(Config) when is_list(Config) -> + lists:foreach(fun (TsType) -> + Arg = case TsType of + no_timestamp -> + {timestamp, []}; + _ -> + {TsType, [TsType]} + end, + do_runnable_ports(Arg, Config), + receive after 1000 -> ok end + end, + [no_timestamp, timestamp, monotonic_timestamp, + strict_monotonic_timestamp]). + +do_runnable_ports({TsType, TsTypeFlag}, Config) -> Pid = start_profiler_process(), - undefined = erlang:system_profile(Pid, [runnable_ports]), + undefined = erlang:system_profile(Pid, [runnable_ports]++TsTypeFlag), EchoPid = echo(Config), % FIXME: Set config to number_of_echos Laps = 10, @@ -148,32 +137,35 @@ runnable_ports(Config) when is_list(Config) -> Events = get_profiler_events(), kill_em_all = kill_echo(EchoPid), erlang:system_profile(undefined, []), - true = has_runnable_event(Events), + true = has_runnable_event(TsType, Events), Pids = sort_events_by_pid(Events), - ok = check_events(Pids), + ok = check_events(TsType, Pids), erase(), exit(Pid,kill), ok. -scheduler(suite) -> - []; -scheduler(doc) -> - ["Tests system_profiling with scheduler."]; +%% Tests system_profiling with scheduler. scheduler(Config) when is_list(Config) -> - case {erlang:system_info(smp_support), erlang:system_info(schedulers_online)} of - {false,_} -> {skipped, "No need for scheduler test when smp support is disabled."}; - {_, 1} -> {skipped, "No need for scheduler test when only one scheduler online."}; + case erlang:system_info(schedulers_online) of + 1 -> {skipped, "No need for scheduler test when only one scheduler online."}; _ -> Nodes = 10, - ok = check_block_system(Nodes), - ok = check_multi_scheduling_block(Nodes) + lists:foreach(fun (TsType) -> + Arg = case TsType of + no_timestamp -> + {timestamp, []}; + _ -> + {TsType, [TsType]} + end, + ok = check_block_system(Arg, Nodes), + ok = check_multi_scheduling_block(Arg, Nodes), + receive after 1000 -> ok end + end, + [no_timestamp, timestamp, monotonic_timestamp, + strict_monotonic_timestamp]) end. -% the profiler pid should not be profiled -dont_profile_profiler(suite) -> - []; -dont_profile_profiler(doc) -> - ["Ensure system profiler process is not profiled."]; +%% Ensure system profiler process is not profiled. dont_profile_profiler(Config) when is_list(Config) -> Pid = start_profiler_process(), @@ -191,12 +183,39 @@ dont_profile_profiler(Config) when is_list(Config) -> exit(Pid,kill), ok. +%% Check sane location (of exits) +sane_location(Config) when is_list(Config) -> + Check = spawn_link(fun() -> flush_sane_location() end), + erlang:system_profile(Check, [runnable_procs]), + Me = self(), + Pids = [spawn_link(fun() -> wat(Me) end) || _ <- lists:seq(1,100)], + [receive {Pid,ok} -> ok end || Pid <- Pids], + Check ! {Me, done}, + receive {Check,ok} -> ok end, + ok. + +wat(Pid) -> + Pid ! {self(), ok}. + +flush_sane_location() -> + receive + {profile,_,_,{M,F,A},_} when is_atom(M), is_atom(F), + is_integer(A) -> + flush_sane_location(); + {profile,_,_,0,_} -> + flush_sane_location(); + {Pid,done} when is_pid(Pid) -> + Pid ! {self(), ok}; + M -> + ct:fail({badness,M}) + end. + %%% Check scheduler profiling -check_multi_scheduling_block(Nodes) -> +check_multi_scheduling_block({TsType, TsTypeFlag}, Nodes) -> Pid = start_profiler_process(), - undefined = erlang:system_profile(Pid, [scheduler]), + undefined = erlang:system_profile(Pid, [scheduler]++TsTypeFlag), {ok, Supervisor} = start_load(Nodes), wait(600), erlang:system_flag(multi_scheduling, block), @@ -204,23 +223,23 @@ check_multi_scheduling_block(Nodes) -> erlang:system_flag(multi_scheduling, unblock), {Pid, [scheduler]} = erlang:system_profile(undefined, []), Events = get_profiler_events(), - true = has_scheduler_event(Events), + true = has_scheduler_event(TsType, Events), stop_load(Supervisor), exit(Pid,kill), erase(), ok. -check_block_system(Nodes) -> +check_block_system({TsType, TsTypeFlag}, Nodes) -> Dummy = spawn(?MODULE, profiler_process, [[]]), Pid = start_profiler_process(), - undefined = erlang:system_profile(Pid, [scheduler]), + undefined = erlang:system_profile(Pid, [scheduler]++TsTypeFlag), {ok, Supervisor} = start_load(Nodes), wait(300), undefined = erlang:system_monitor(Dummy, [busy_port]), {Dummy, [busy_port]} = erlang:system_monitor(undefined, []), {Pid, [scheduler]} = erlang:system_profile(undefined, []), Events = get_profiler_events(), - true = has_scheduler_event(Events), + true = has_scheduler_event(TsType, Events), stop_load(Supervisor), exit(Pid,kill), exit(Dummy,kill), @@ -229,40 +248,49 @@ check_block_system(Nodes) -> %%% Check events -check_events([]) -> ok; -check_events([Pid | Pids]) -> +check_events(_TsType, []) -> ok; +check_events(TsType, [Pid | Pids]) -> Master = get(master), Laps = get(laps), CheckPids = get(pids), {Events, N} = get_pid_events(Pid), ok = check_event_flow(Events), - ok = check_event_ts(Events), + ok = check_event_ts(TsType, Events), IsMember = lists:member(Pid, CheckPids), case Pid of Master -> io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2+2, N, Pid]), N = Laps*2 + 2, - check_events(Pids); + check_events(TsType, Pids); Pid when IsMember == true -> io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2, N, Pid]), N = Laps*2, - check_events(Pids); + check_events(TsType, Pids); Pid -> - check_events(Pids) + check_events(TsType, Pids) end. %% timestamp consistency check for descending timestamps -check_event_ts(Events) -> - check_event_ts(Events, undefined). -check_event_ts([], _) -> ok; -check_event_ts([Event | Events], undefined) -> - check_event_ts(Events, Event); -check_event_ts([{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) -> - Time = timer:now_diff(TS1, TS0), +check_event_ts(TsType, Events) -> + check_event_ts(TsType, Events, undefined). +check_event_ts(_TsType, [], _) -> ok; +check_event_ts(TsType, [Event | Events], undefined) -> + check_event_ts(TsType, Events, Event); +check_event_ts(TsType, [{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) -> + Time = case TsType of + timestamp -> + timer:now_diff(TS1, TS0); + monotonic_timestamp -> + TS1 - TS0; + strict_monotonic_timestamp -> + {MT1, _} = TS1, + {MT0, _} = TS0, + MT1 - MT0 + end, if Time < 0.0 -> timestamp_error; - true -> check_event_ts(Events, Event) + true -> check_event_ts(TsType, Events, Event) end. %% consistency check for active vs. inactive activity (runnable) @@ -372,7 +400,7 @@ ring_loop(RelayTo) -> %% API echo(Config) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erl_ddll:load_driver(Path, echo_drv), Pid = spawn_link(?MODULE, port_echo_start, []), Pid ! {self(), get_ports}, @@ -427,6 +455,44 @@ port_echo_loop(Port) -> %% Helpers %%% +check_ts(no_timestamp, Ts) -> + try + no_timestamp = Ts + catch + _ : _ -> + ct:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(timestamp, Ts) -> + try + {Ms,S,Us} = Ts, + true = is_integer(Ms), + true = is_integer(S), + true = is_integer(Us) + catch + _ : _ -> + ct:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(monotonic_timestamp, Ts) -> + try + true = is_integer(Ts) + catch + _ : _ -> + ct:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(strict_monotonic_timestamp, Ts) -> + try + {MT, UMI} = Ts, + true = is_integer(MT), + true = is_integer(UMI) + catch + _ : _ -> + ct:fail({unexpected_timestamp, Ts}) + end, + ok. + start_load(N) -> Pid = spawn_link(?MODULE, run_load, [N, []]), {ok, Pid}. @@ -447,33 +513,38 @@ run_load(N, Pids) -> run_load(N - 1, [Pid | Pids]). list_load() -> - ok = case math:sin(random:uniform(32451)) of + ok = case math:sin(rand:uniform(32451)) of A when is_float(A) -> ok; _ -> ok end, list_load(). - -has_scheduler_event(Events) -> +has_scheduler_event(TsType, Events) -> lists:any( fun (Pred) -> case Pred of - {profile, scheduler, _ID, _Activity, _NR, _TS} -> true; + {profile, scheduler, _ID, _Activity, _NR, TS} -> + check_ts(TsType, TS), + true; _ -> false end end, Events). -has_runnable_event(Events) -> +has_runnable_event(TsType, Events) -> lists:any( fun (Pred) -> case Pred of - {profile, _Pid, _Activity, _MFA, _TS} -> true; + {profile, _Pid, _Activity, _MFA, TS} -> + check_ts(TsType, TS), + true; _ -> false end end, Events). -has_profiler_pid_event([], _) -> false; -has_profiler_pid_event([{profile, Pid, _Activity, _MFA, _TS}|Events], Pid) -> true; +has_profiler_pid_event([], _) -> + false; +has_profiler_pid_event([{profile, Pid, _Activity, _MFA, _TS}|_Events], Pid) -> + true; has_profiler_pid_event([_|Events], Pid) -> has_profiler_pid_event(Events, Pid). diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index a0a8a9c42c..e01efac86b 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -1,23 +1,25 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(time_SUITE). +-compile({nowarn_deprecated_function, {erlang,now,0}}). %% "Time is on my side." -- The Rolling Stones @@ -34,11 +36,19 @@ bad_univ_to_local/1, bad_local_to_univ/1, univ_to_seconds/1, seconds_to_univ/1, consistency/1, - now_unique/1, now_update/1, timestamp/1]). + now_unique/1, now_update/1, timestamp/1, + time_warp_modes/1, + monotonic_time_monotonicity/1, + monotonic_time_monotonicity_parallel/1, + time_unit_conversion/1, + signed_time_unit_conversion/1, + erlang_timestamp/1]). + +-export([init_per_testcase/2, end_per_testcase/2]). -export([local_to_univ_utc/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([linear_time/1]). @@ -56,6 +66,12 @@ -define(dst_timezone, 2). +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + [{testcase, Func}|Config]. + +end_per_testcase(_Func, _Config) -> + ok. + suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> @@ -63,7 +79,13 @@ all() -> bad_univ_to_local, bad_local_to_univ, univ_to_seconds, seconds_to_univ, consistency, - {group, now}, timestamp]. + {group, now}, timestamp, + time_warp_modes, + monotonic_time_monotonicity, + monotonic_time_monotonicity_parallel, + time_unit_conversion, + signed_time_unit_conversion, + erlang_timestamp]. groups() -> [{now, [], [now_unique, now_update]}]. @@ -81,59 +103,56 @@ end_per_group(_GroupName, Config) -> Config. -local_to_univ_utc(suite) -> - []; -local_to_univ_utc(doc) -> - ["Test that DST = true on timezones without DST is ignored"]; +%% Test that DST = true on timezones without DST is ignored local_to_univ_utc(Config) when is_list(Config) -> case os:type() of {unix,_} -> %% TZ variable has a meaning - ?line {ok, Node} = + {ok, Node} = test_server:start_node(local_univ_utc,peer, [{args, "-env TZ UTC"}]), - ?line {{2008,8,1},{0,0,0}} = + {{2008,8,1},{0,0,0}} = rpc:call(Node, erlang,localtime_to_universaltime, [{{2008, 8, 1}, {0, 0, 0}}, false]), - ?line {{2008,8,1},{0,0,0}} = + {{2008,8,1},{0,0,0}} = rpc:call(Node, erlang,localtime_to_universaltime, [{{2008, 8, 1}, {0, 0, 0}}, true]), - ?line [{{2008,8,1},{0,0,0}}] = + [{{2008,8,1},{0,0,0}}] = rpc:call(Node, calendar,local_time_to_universal_time_dst, [{{2008, 8, 1}, {0, 0, 0}}]), - ?line test_server:stop_node(Node), + test_server:stop_node(Node), ok; _ -> {skip,"Only valid on Unix"} end. -%% Tests conversion from univeral to local time. +%% Tests conversion from universal to local time. univ_to_local(Config) when is_list(Config) -> - ?line test_univ_to_local(test_data()). + test_univ_to_local(test_data()). test_univ_to_local([{Utc, Local}|Rest]) -> - ?line io:format("Testing ~p => ~p~n", [Local, Utc]), - ?line Local = erlang:universaltime_to_localtime(Utc), - ?line test_univ_to_local(Rest); + io:format("Testing ~p => ~p~n", [Local, Utc]), + Local = erlang:universaltime_to_localtime(Utc), + test_univ_to_local(Rest); test_univ_to_local([]) -> ok. %% Tests conversion from local to universal time. local_to_univ(Config) when is_list(Config) -> - ?line test_local_to_univ(test_data()). + test_local_to_univ(test_data()). test_local_to_univ([{Utc, Local}|Rest]) -> - ?line io:format("Testing ~p => ~p~n", [Utc, Local]), - ?line Utc = erlang:localtime_to_universaltime(Local), - ?line test_local_to_univ(Rest); + io:format("Testing ~p => ~p~n", [Utc, Local]), + Utc = erlang:localtime_to_universaltime(Local), + test_local_to_univ(Rest); test_local_to_univ([]) -> ok. @@ -141,11 +160,11 @@ test_local_to_univ([]) -> %% generate a badarg. bad_univ_to_local(Config) when is_list(Config) -> - ?line bad_test_univ_to_local(bad_dates()). + bad_test_univ_to_local(bad_dates()). bad_test_univ_to_local([Utc|Rest]) -> - ?line io:format("Testing ~p~n", [Utc]), - ?line case catch erlang:universaltime_to_localtime(Utc) of + io:format("Testing ~p~n", [Utc]), + case catch erlang:universaltime_to_localtime(Utc) of {'EXIT', {badarg, _}} -> bad_test_univ_to_local(Rest) end; bad_test_univ_to_local([]) -> @@ -155,11 +174,11 @@ bad_test_univ_to_local([]) -> %% generate a badarg. bad_local_to_univ(Config) when is_list(Config) -> - ?line bad_test_local_to_univ(bad_dates()). + bad_test_local_to_univ(bad_dates()). bad_test_local_to_univ([Local|Rest]) -> - ?line io:format("Testing ~p~n", [Local]), - ?line case catch erlang:localtime_to_universaltime(Local) of + io:format("Testing ~p~n", [Local]), + case catch erlang:localtime_to_universaltime(Local) of {'EXIT', {badarg, _}} -> bad_test_local_to_univ(Rest) end; bad_test_local_to_univ([]) -> @@ -190,28 +209,22 @@ test_seconds_to_univ([]) -> %% Test that the the different time functions return -%% consistent results. (See the test case for assumptions -%% and limitations.) -consistency(Config) when is_list(Config) -> - %% Test the following equations: - %% date() & time() == erlang:localtime() - %% erlang:universaltime() + timezone == erlang:localtime() +%% consistent results. +consistency(_Config) -> + %% Test that: + %% * date() & time() gives the same time as erlang:localtime() %% - %% Assumptions: - %% Middle-European time zone, EU rules for daylight-saving time. - %% - %% Limitations: - %% Localtime and universaltime must be in the same month. - %% Daylight-saving calculations are incorrect from the last - %% Sunday of March and October to the end of the month. + %% * the difference between erlang:universaltime() and + %% erlang:localtime() is reasonable (with assuming any + %% particular timezone) - ?line ok = compare_date_time_and_localtime(16), - ?line ok = compare_local_and_universal(16). + ok = compare_date_time_and_localtime(16), + compare_local_and_universal(16). compare_date_time_and_localtime(Times) when Times > 0 -> - ?line {Year, Mon, Day} = date(), - ?line {Hour, Min, Sec} = time(), - ?line case erlang:localtime() of + {Year, Mon, Day} = date(), + {Hour, Min, Sec} = time(), + case erlang:localtime() of {{Year, Mon, Day}, {Hour, Min, Sec}} -> ok; _ -> compare_date_time_and_localtime(Times-1) end; @@ -219,22 +232,18 @@ compare_date_time_and_localtime(0) -> error. compare_local_and_universal(Times) when Times > 0 -> - case compare(erlang:universaltime(), erlang:localtime()) of - true -> ok; - false -> compare_local_and_universal(Times-1) - end; -compare_local_and_universal(0) -> - error. + Utc = erlang:universaltime(), + Local = erlang:localtime(), + io:format("local = ~p, utc = ~p", [Local,Utc]), -compare(Utc0, Local) -> - io:format("local = ~p, utc = ~p", [Local, Utc0]), - Utc = linear_time(Utc0)+effective_timezone(Utc0)*3600, - case linear_time(Local) of - Utc -> true; - Other -> - io:format("Failed: local = ~p, utc = ~p~n", - [Other, Utc]), - false + AcceptableDiff = 14*3600, + case linear_time(Utc) - linear_time(Local) of + Diff when abs(Diff) < AcceptableDiff -> + ok; + Diff -> + io:format("More than ~p seconds difference betwen " + "local and universal time", [Diff]), + ct:fail(huge_diff) end. %% This function converts a date and time to a linear time. @@ -261,44 +270,46 @@ days_in_february(Year) -> _ -> 28 end. -%% This functions returns either the normal timezone or the -%% the DST timezone, depending on the given UTC time. -%% -%% XXX This function uses an approximation of the EU rule for -%% daylight saving time. This function will fail in the -%% following intervals: After the last Sunday in March upto -%% the end of March, and after the last Sunday in October -%% upto the end of October. - -effective_timezone(Time) -> - case os:type() of - {unix,_} -> - case os:cmd("date '+%Z'") of - "SAST"++_ -> - 2; - _ -> - effective_timezone1(Time) - end; - _ -> - effective_timezone1(Time) - end. - -effective_timezone1({{_Year,Mon,_Day}, _}) when Mon < 4 -> - ?timezone; -effective_timezone1({{_Year,Mon,_Day}, _}) when Mon > 10 -> - ?timezone; -effective_timezone1(_) -> - ?dst_timezone. - %% Test (the bif) os:timestamp/0, which is something quite like, but not %% similar to erlang:now... -timestamp(suite) -> - []; -timestamp(doc) -> - ["Test that os:timestamp works."]; +%% Test that os:timestamp works. timestamp(Config) when is_list(Config) -> - repeating_timestamp_check(100000). + try + repeating_timestamp_check(100000) + catch + throw : {fail, Failure} -> + %% + %% Our time warping test machines currently warps + %% time every 6:th second. If we get a warp during + %% 10 seconds, assume this is a time warping test + %% and ignore the failure. + %% + case had_time_warp(10) of + true -> + {skip, "Seems to be time warp test run..."}; + false -> + ct:fail(Failure) + end + end. + +os_system_time_offset() -> + erlang:convert_time_unit(os:system_time() - erlang:monotonic_time(), + native, microsecond). + +had_time_warp(Secs) -> + had_time_warp(os_system_time_offset(), Secs). + +had_time_warp(_OrigOffs, 0) -> + false; +had_time_warp(OrigOffs, N) -> + receive after 1000 -> ok end, + case OrigOffs - os_system_time_offset() of + Diff when Diff > 500000; Diff < -500000 -> + true; + _Diff -> + had_time_warp(OrigOffs, N-1) + end. repeating_timestamp_check(0) -> ok; @@ -312,9 +323,7 @@ repeating_timestamp_check(N) -> C < 1000000 -> ok; true -> - test_server:fail( - lists:flatten( - io_lib:format("Strange return from os:timestamp/0 ~w~n",[TS]))) + ct:fail("Strange return from os:timestamp/0 ~w~n",[TS]) end, %% I assume the now and timestamp should not differ more than 1 hour, %% which is safe assuming the system has not had a large time-warp @@ -324,15 +333,15 @@ repeating_timestamp_check(N) -> NSecs = NA*1000000+NB+round(NC/1000000), case Secs - NSecs of TooLarge when TooLarge > 3600 -> - test_server:fail( - lists:flatten( + throw({fail, + lists:flatten( io_lib:format("os:timestamp/0 is ~w s more than erlang:now/0", - [TooLarge]))); + [TooLarge]))}); TooSmall when TooSmall < -3600 -> - test_server:fail( + throw({fail, lists:flatten( io_lib:format("os:timestamp/0 is ~w s less than erlang:now/0", - [-TooSmall]))); + [-TooSmall]))}); _ -> ok end, @@ -347,22 +356,22 @@ repeating_timestamp_check(N) -> %% times (in microseconds). now_unique(Config) when is_list(Config) -> - ?line now_unique(1000, now(), []), - ?line fast_now_unique(100000, now()). + now_unique(1000, now(), []), + fast_now_unique(100000, now()). now_unique(N, Previous, Result) when N > 0 -> - ?line case now() of + case now() of Previous -> - test_server:fail("now/0 returned the same value twice"); + ct:fail("now/0 returned the same value twice"); New -> now_unique(N-1, New, [New|Result]) end; now_unique(0, _, [Then|Rest]) -> - ?line now_calc_increment(Rest, microsecs(Then), []). + now_calc_increment(Rest, microsecs(Then), []). now_calc_increment([Then|Rest], Previous, _Result) -> - ?line This = microsecs(Then), - ?line now_calc_increment(Rest, This, [Previous-This]); + This = microsecs(Then), + now_calc_increment(Rest, This, [Previous-This]); now_calc_increment([], _, Differences) -> {comment, "Median increment: " ++ integer_to_list(median(Differences))}. @@ -370,15 +379,15 @@ fast_now_unique(0, _) -> ok; fast_now_unique(N, Then) -> case now() of Then -> - ?line ?t:fail("now/0 returned the same value twice"); + ct:fail("now/0 returned the same value twice"); Now -> fast_now_unique(N-1, Now) end. median(Unsorted_List) -> - ?line Length = length(Unsorted_List), - ?line List = lists:sort(Unsorted_List), - ?line case Length rem 2 of + Length = length(Unsorted_List), + List = lists:sort(Unsorted_List), + case Length rem 2 of 0 -> % Even length. [A, B] = lists:nthtail((Length div 2)-1, List), (A+B)/2; @@ -394,31 +403,460 @@ microsecs({Mega_Secs, Secs, Microsecs}) -> %% calls to erlang:localtime(). now_update(Config) when is_list(Config) -> - case ?t:is_debug() of - false -> ?line now_update1(10); + case test_server:is_debug() of + false -> now_update1(10); true -> {skip,"Unreliable in DEBUG build"} end. now_update1(N) when N > 0 -> - ?line T1_linear = linear_time(erlang:localtime()), - ?line T1_now = microsecs(now()), + T1_linear = linear_time(erlang:localtime()), + T1_now = microsecs(now()), - ?line receive after 1008 -> ok end, + receive after 1008 -> ok end, - ?line T2_linear = linear_time(erlang:localtime()), - ?line T2_now = microsecs(now()), + T2_linear = linear_time(erlang:localtime()), + T2_now = microsecs(now()), - ?line Linear_Diff = (T2_linear-T1_linear)*1000000, - ?line Now_Diff = T2_now-T1_now, - test_server:format("Localtime diff = ~p; now() diff = ~p", - [Linear_Diff, Now_Diff]), - ?line case abs(Linear_Diff - Now_Diff) of + Linear_Diff = (T2_linear-T1_linear)*1000000, + Now_Diff = T2_now-T1_now, + io:format("Localtime diff = ~p; now() diff = ~p", [Linear_Diff, Now_Diff]), + case abs(Linear_Diff - Now_Diff) of Abs_Delta when Abs_Delta =< 40000 -> ok; _ -> now_update1(N-1) end; now_update1(0) -> - ?line test_server:fail(). + ct:fail("now_update zero"). + +time_warp_modes(Config) when is_list(Config) -> + %% All time warp modes always supported in + %% combination with no time correction... + check_time_warp_mode(Config, false, no_time_warp), + check_time_warp_mode(Config, false, single_time_warp), + check_time_warp_mode(Config, false, multi_time_warp), + + erts_debug:set_internal_state(available_internal_state, true), + try + case erts_debug:get_internal_state({check_time_config, + true, no_time_warp}) of + false -> ok; + true -> check_time_warp_mode(Config, true, no_time_warp) + end, + case erts_debug:get_internal_state({check_time_config, + true, single_time_warp}) of + false -> ok; + true -> check_time_warp_mode(Config, true, single_time_warp) + end, + case erts_debug:get_internal_state({check_time_config, + true, multi_time_warp}) of + false -> ok; + true -> check_time_warp_mode(Config, true, multi_time_warp) + end + after + erts_debug:set_internal_state(available_internal_state, false) + end. + +check_time_warp_mode(Config, TimeCorrection, TimeWarpMode) -> + io:format("~n~n~n***** Testing TimeCorrection=~p TimeWarpMode=~p *****~n", + [TimeCorrection, TimeWarpMode]), + Mon = erlang:monitor(time_offset, clock_service), + _ = erlang:time_offset(), + Start = erlang:monotonic_time(1000), + MonotonicityTimeout = 2000, + {ok, Node} = start_node(Config, + "+c " ++ atom_to_list(TimeCorrection) + ++ " +C " ++ atom_to_list(TimeWarpMode)), + StartTime = rpc:call(Node, erlang, system_info, [start_time]), + Me = self(), + MonotincityTestStarted = make_ref(), + MonotincityTestDone = make_ref(), + spawn_link(Node, + fun () -> + Me ! MonotincityTestStarted, + cmp_times(erlang:start_timer(MonotonicityTimeout, + self(), + timeout), + erlang:monotonic_time()), + Me ! MonotincityTestDone + end), + receive MonotincityTestStarted -> ok end, + check_time_offset(Node, TimeWarpMode), + TimeWarpMode = rpc:call(Node, erlang, system_info, [time_warp_mode]), + TimeCorrection = rpc:call(Node, erlang, system_info, [time_correction]), + receive MonotincityTestDone -> ok end, + MonotonicTime = rpc:call(Node, erlang, monotonic_time, []), + MonotonicTimeUnit = rpc:call(Node, + erlang, + convert_time_unit, + [1, second, native]), + UpMilliSeconds = erlang:convert_time_unit(MonotonicTime - StartTime, + MonotonicTimeUnit, + millisecond), + io:format("UpMilliSeconds=~p~n", [UpMilliSeconds]), + End = erlang:monotonic_time(millisecond), + stop_node(Node), + try + true = (UpMilliSeconds > (98*MonotonicityTimeout) div 100), + true = (UpMilliSeconds < (102*(End-Start)) div 100) + catch + error:_ -> + io:format("Uptime inconsistency", []), + case {TimeCorrection, erlang:system_info(time_correction)} of + {true, true} -> + ct:fail(uptime_inconsistency); + {true, false} -> + _ = erlang:time_offset(), + receive + {'CHANGE', Mon, time_offset, clock_service, _} -> + ignore + after 1000 -> + ct:fail(uptime_inconsistency) + end; + _ -> + ignore + end + end, + erlang:demonitor(Mon, [flush]), + ok. + +check_time_offset(Node, no_time_warp) -> + final = rpc:call(Node, erlang, system_info, [time_offset]), + final = rpc:call(Node, erlang, system_flag, [time_offset, finalize]), + final = rpc:call(Node, erlang, system_info, [time_offset]); +check_time_offset(Node, single_time_warp) -> + preliminary = rpc:call(Node, erlang, system_info, [time_offset]), + preliminary = rpc:call(Node, erlang, system_flag, [time_offset, finalize]), + final = rpc:call(Node, erlang, system_info, [time_offset]), + final = rpc:call(Node, erlang, system_flag, [time_offset, finalize]); +check_time_offset(Node, multi_time_warp) -> + volatile = rpc:call(Node, erlang, system_info, [time_offset]), + volatile = rpc:call(Node, erlang, system_flag, [time_offset, finalize]), + volatile = rpc:call(Node, erlang, system_info, [time_offset]). + +monotonic_time_monotonicity(Config) when is_list(Config) -> + Done = erlang:start_timer(10000,self(),timeout), + cmp_times(Done, erlang:monotonic_time()). + +cmp_times(Done, X0) -> + X1 = erlang:monotonic_time(), + X2 = erlang:monotonic_time(), + X3 = erlang:monotonic_time(), + X4 = erlang:monotonic_time(), + X5 = erlang:monotonic_time(), + true = (X0 =< X1), + true = (X1 =< X2), + true = (X2 =< X3), + true = (X3 =< X4), + true = (X4 =< X5), + receive + {timeout, Done, timeout} -> + ok + after 0 -> + cmp_times(Done, X5) + end. + +-define(NR_OF_MONOTONIC_CALLS, 100000). + +monotonic_time_monotonicity_parallel(Config) when is_list(Config) -> + Me = self(), + Result = make_ref(), + Go = make_ref(), + UpAndRunning = make_ref(), + NoOnlnScheds = erlang:system_info(schedulers_online), + OffsetUI = erlang:unique_integer([monotonic]), + OffsetMT = erlang:monotonic_time(), + MinHSz = ?NR_OF_MONOTONIC_CALLS*(2 + + 3 + + erts_debug:flat_size(OffsetUI) + + erts_debug:flat_size(OffsetMT)), + Ps = lists:map( + fun (Sched) -> + spawn_opt( + fun () -> + Me ! {self(), UpAndRunning}, + receive Go -> ok end, + Res = fetch_monotonic(?NR_OF_MONOTONIC_CALLS, []), + Me ! {self(), Result, Sched, Res} + end, + [{scheduler, Sched}, + {priority, max}, + {min_heap_size, MinHSz}]) + end, + lists:seq(1, NoOnlnScheds)), + lists:foreach(fun (P) -> receive {P, UpAndRunning} -> ok end end, Ps), + lists:foreach(fun (P) -> P ! Go end, Ps), + TMs = recv_monotonics(Result, OffsetMT, OffsetUI, NoOnlnScheds, []), + true = check_monotonic_result(TMs, OffsetMT, OffsetUI, true). + +check_monotonic_result([{_Sched, _PrevUI, _MT, _PostUI}], + _OffsetMT, _OffsetUI, Res) -> + Res; +check_monotonic_result([{_ASched, _APrevUI, AMT, APostUI} = A, + {_BSched, BPrevUI, BMT, _BPostUI} = B | _] = L, + OffsetMT, OffsetUI, Res) -> + NewRes = case (AMT =< BMT) orelse (BPrevUI < APostUI) of + true -> + Res; + false -> + io:format("INCONSISTENCY: ~p ~p~n", [A, B]), + false + end, + check_monotonic_result(tl(L), OffsetMT, OffsetUI, NewRes). + +recv_monotonics(_Result, _OffsetMT, _OffsetUI, 0, Acc) -> + lists:keysort(2, Acc); +recv_monotonics(Result, OffsetMT, OffsetUI, N, Acc) -> + receive + {_, Result, Sched, Res} -> + CRes = convert_monotonic(Sched, OffsetMT, OffsetUI, Res, []), + recv_monotonics(Result, OffsetMT, OffsetUI, N-1, CRes ++ Acc) + end. + +convert_monotonic(_Sched, _OffsetMT, _OffsetUI, [{_MT, _UI}], Acc) -> + Acc; +convert_monotonic(Sched, OffsetMT, OffsetUI, + [{MT, UI}, {_PrevMT, PrevUI} | _] = L, Acc) -> + convert_monotonic(Sched, OffsetMT, OffsetUI, tl(L), + [{Sched, PrevUI-OffsetUI, MT-OffsetMT, UI-OffsetUI} + | Acc]). + +fetch_monotonic(0, Acc) -> + Acc; +fetch_monotonic(N, Acc) -> + MT = erlang:monotonic_time(), + UI = erlang:unique_integer([monotonic]), + fetch_monotonic(N-1, [{MT, UI} | Acc]). + +-define(CHK_RES_CONVS_TIMEOUT, 400). + +time_unit_conversion(Config) when is_list(Config) -> + Mon = erlang:monitor(time_offset, clock_service), + start_check_res_convs(Mon, 1000000000000), + start_check_res_convs(Mon, 2333333333333), + start_check_res_convs(Mon, 5732678356789), + erlang:demonitor(Mon, [flush]). + +start_check_res_convs(Mon, Res) -> + io:format("Checking ~p time_unit~n", [Res]), + check_res_convs(Mon, + erlang:start_timer(?CHK_RES_CONVS_TIMEOUT, + self(), + timeout), + Res). + + +check_res_convs(Mon, Done, Res) -> + receive + {timeout, Done, timeout} -> + case Res div 10 of + 0 -> + ok; + NewRes -> + start_check_res_convs(Mon, NewRes) + end + after 0 -> + do_check_res_convs(Mon, Done, Res) + end. + +do_check_res_convs(Mon, Done, Res) -> + TStart = erlang:monotonic_time(), + T = erlang:monotonic_time(Res), + TEnd = erlang:monotonic_time(), + TMin = erlang:convert_time_unit(TStart, native, Res), + TMax = erlang:convert_time_unit(TEnd, native, Res), + %io:format("~p =< ~p =< ~p~n", [TMin, T, TEnd]), + true = (TMin =< T), + true = (TMax >= T), + check_time_offset_res_conv(Mon, Res), + check_res_convs(Mon, Done, Res). + + +check_time_offset_res_conv(Mon, Res) -> + TORes = erlang:time_offset(Res), + TO = erlang:time_offset(), + case erlang:convert_time_unit(TO, native, Res) of + TORes -> + ok; + TORes2 -> + case check_time_offset_change(Mon, TO, 1000) of + {TO, false} -> + ct:fail({time_unit_conversion_inconsistency, + TO, TORes, TORes2}); + {_NewTO, true} -> + io:format("time_offset changed", []), + check_time_offset_res_conv(Mon, Res) + end + end. + +signed_time_unit_conversion(Config) when is_list(Config) -> + chk_strc(1000000000, 1000000), + chk_strc(1000000000, 1000), + chk_strc(1000000000, 1), + chk_strc(1000000, 1000), + chk_strc(1000000, 1), + chk_strc(1000, 1), + chk_strc(4711, 17), + chk_strc(1 bsl 10, 1), + chk_strc(1 bsl 16, 10), + chk_strc(1 bsl 17, 1 bsl 8), + chk_strc((1 bsl 17) + 1, (1 bsl 8) - 1), + chk_strc(1 bsl 17, 11), + ok. + +chk_strc(Res0, Res1) -> + case (Res0 /= Res1) andalso (Res0 =< 1000000) andalso (Res1 =< 1000000) of + true -> + {FromRes, ToRes} = case Res0 > Res1 of + true -> {Res0, Res1}; + false -> {Res1, Res0} + end, + MinFromValuesPerToValue = FromRes div ToRes, + MaxFromValuesPerToValue = ((FromRes-1) div ToRes)+1, + io:format("~p -> ~p [~p, ~p]~n", + [FromRes, ToRes, + MinFromValuesPerToValue, MaxFromValuesPerToValue]), + chk_values_per_value(FromRes, ToRes, + -10*FromRes, 10*FromRes, + MinFromValuesPerToValue, + MaxFromValuesPerToValue, + undefined, MinFromValuesPerToValue); + _ -> + ok + end, + chk_random_values(Res0, Res1), + chk_random_values(Res1, Res0), + ok. + +chk_random_values(FR, TR) -> + io:format("rand values ~p -> ~p~n", [FR, TR]), + rand:seed(exsplus, {268438039,268440479,268439161}), + Values = lists:map(fun (_) -> rand:uniform(1 bsl 65) - (1 bsl 64) end, + lists:seq(1, 100000)), + CheckFun = fun (V) -> + CV = erlang:convert_time_unit(V, FR, TR), + case {(FR*CV) div TR =< V, + (FR*(CV+1)) div TR >= V} of + {true, true} -> + ok; + Failure -> + ct:fail({Failure, CV, V, FR, TR}) + end + end, + lists:foreach(CheckFun, Values). + + +chk_values_per_value(_FromRes, _ToRes, + EndValue, EndValue, + MinFromValuesPerToValue, MaxFromValuesPerToValue, + _ToValue, FromValueCount) -> +% io:format("~p [~p]~n", [EndValue, FromValueCount]), + case ((MinFromValuesPerToValue =< FromValueCount) + andalso (FromValueCount =< MaxFromValuesPerToValue)) of + false -> + ct:fail({MinFromValuesPerToValue, + FromValueCount, + MaxFromValuesPerToValue}); + true -> + ok + end; +chk_values_per_value(FromRes, ToRes, Value, EndValue, + MinFromValuesPerToValue, MaxFromValuesPerToValue, + ToValue, FromValueCount) -> + case erlang:convert_time_unit(Value, FromRes, ToRes) of + ToValue -> + chk_values_per_value(FromRes, ToRes, + Value+1, EndValue, + MinFromValuesPerToValue, + MaxFromValuesPerToValue, + ToValue, FromValueCount+1); + NewToValue -> + case ((MinFromValuesPerToValue =< FromValueCount) + andalso (FromValueCount =< MaxFromValuesPerToValue)) of + false -> + ct:fail({MinFromValuesPerToValue, + FromValueCount, + MaxFromValuesPerToValue}); + true -> + % io:format("~p -> ~p [~p]~n", + % [Value, NewToValue, FromValueCount]), + chk_values_per_value(FromRes, ToRes, + Value+1, EndValue, + MinFromValuesPerToValue, + MaxFromValuesPerToValue, + NewToValue, 1) + end + end. + +erlang_timestamp(Config) when is_list(Config) -> + Mon = erlang:monitor(time_offset, clock_service), + {TO, _} = check_time_offset_change(Mon, + erlang:time_offset(), + 0), + Done = erlang:start_timer(10000,self(),timeout), + ok = check_erlang_timestamp(Done, Mon, TO). + +check_erlang_timestamp(Done, Mon, TO) -> + receive + {timeout, Done, timeout} -> + erlang:demonitor(Mon, [flush]), + ok + after 0 -> + do_check_erlang_timestamp(Done, Mon, TO) + end. + +do_check_erlang_timestamp(Done, Mon, TO) -> + MinMon = erlang:monotonic_time(), + {MegaSec, Sec, MicroSec} = erlang:timestamp(), + MaxMon = erlang:monotonic_time(), + TsMin = erlang:convert_time_unit(MinMon+TO, + native, + microsecond), + TsMax = erlang:convert_time_unit(MaxMon+TO, + native, + microsecond), + TsTime = (MegaSec*1000000+Sec)*1000000+MicroSec, + case (TsMin =< TsTime) andalso (TsTime =< TsMax) of + true -> + NewTO = case erlang:time_offset() of + TO -> + TO; + _ -> + check_time_offset_change(Mon, TO, 0) + end, + check_erlang_timestamp(Done, Mon, NewTO); + false -> + io:format("TsMin=~p TsTime=~p TsMax=~p~n", [TsMin, TsTime, TsMax]), + io:format("Detected inconsistency; " + "checking for time_offset change...", []), + case check_time_offset_change(Mon, TO, 1000) of + {TO, false} -> + ct:fail(timestamp_inconsistency); + {NewTO, true} -> + io:format("time_offset changed", []), + check_erlang_timestamp(Done, Mon, NewTO) + end + end. + +check_time_offset_change(Mon, TO, Wait) -> + process_changed_time_offset(Mon, TO, false, Wait). + +process_changed_time_offset(Mon, TO, Changed, Wait) -> + receive + {'CHANGE', Mon, time_offset, clock_service, NewTO} -> + process_changed_time_offset(Mon, NewTO, true, Wait) + after Wait -> + case erlang:time_offset() of + TO -> + {TO, Changed}; + _OtherTO -> + receive + {'CHANGE', Mon, time_offset, clock_service, NewTO} -> + process_changed_time_offset(Mon, NewTO, true, Wait) + end + end + end. + + %% Returns the test data: a list of {Utc, Local} tuples. @@ -435,13 +873,13 @@ test_data() -> _ -> {?timezone,?dst_timezone} end, - ?line test_data(nondst_dates(), TZ) ++ + test_data(nondst_dates(), TZ) ++ test_data(dst_dates(), DSTTZ) ++ crossover_test_data(crossover_dates(), TZ). %% test_data1() -> -%% ?line test_data(nondst_dates(), ?timezone) ++ +%% test_data(nondst_dates(), ?timezone) ++ %% test_data(dst_dates(), ?dst_timezone) ++ %% crossover_test_data(crossover_dates(), ?timezone). @@ -449,16 +887,16 @@ crossover_test_data([{Year, Month, Day}|Rest], TimeZone) when TimeZone > 0 -> Hour = 23, Min = 35, Sec = 55, - ?line Utc = {{Year, Month, Day}, {Hour, Min, Sec}}, - ?line Local = {{Year, Month, Day+1}, {Hour+TimeZone-24, Min, Sec}}, - ?line [{Utc, Local}|crossover_test_data(Rest, TimeZone)]; + Utc = {{Year, Month, Day}, {Hour, Min, Sec}}, + Local = {{Year, Month, Day+1}, {Hour+TimeZone-24, Min, Sec}}, + [{Utc, Local}|crossover_test_data(Rest, TimeZone)]; crossover_test_data([{Year, Month, Day}|Rest], TimeZone) when TimeZone < 0 -> Hour = 0, Min = 23, Sec = 12, - ?line Utc = {{Year, Month, Day}, {Hour, Min, Sec}}, - ?line Local = {{Year, Month, Day-1}, {Hour+TimeZone+24, Min, Sec}}, - ?line [{Utc, Local}|crossover_test_data(Rest, TimeZone)]; + Utc = {{Year, Month, Day}, {Hour, Min, Sec}}, + Local = {{Year, Month, Day-1}, {Hour+TimeZone+24, Min, Sec}}, + [{Utc, Local}|crossover_test_data(Rest, TimeZone)]; crossover_test_data([], _) -> []. @@ -466,9 +904,9 @@ test_data([Date|Rest], TimeZone) -> Hour = 12, Min = 45, Sec = 7, - ?line Utc = {Date, {Hour, Min, Sec}}, - ?line Local = {Date, {Hour+TimeZone, Min, Sec}}, - ?line [{Utc, Local}|test_data(Rest, TimeZone)]; + Utc = {Date, {Hour, Min, Sec}}, + Local = {Date, {Hour+TimeZone, Min, Sec}}, + [{Utc, Local}|test_data(Rest, TimeZone)]; test_data([], _) -> []. @@ -554,4 +992,22 @@ bad_dates() -> {{1996, 4, 30}, {12, 0, -1}}, % Sec {{1996, 4, 30}, {12, 0, 60}}]. - + +start_node(Config, Args) -> + TestCase = proplists:get_value(testcase, Config), + PA = filename:dirname(code:which(?MODULE)), + ESTime = erlang:monotonic_time(1) + erlang:time_offset(1), + Unique = erlang:unique_integer([positive]), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(TestCase) + ++ "-" + ++ integer_to_list(ESTime) + ++ "-" + ++ integer_to_list(Unique)), + test_server:start_node(Name, + slave, + [{args, "-pa " ++ PA ++ " " ++ Args}]). + +stop_node(Node) -> + test_server:stop_node(Node). diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl index c28224729d..fc11a04a31 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -1,78 +1,80 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(timer_bif_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1, init_per_testcase/2,end_per_testcase/2]). -export([start_timer_1/1, send_after_1/1, send_after_2/1, send_after_3/1, cancel_timer_1/1, start_timer_big/1, send_after_big/1, start_timer_e/1, send_after_e/1, cancel_timer_e/1, - read_timer_trivial/1, read_timer/1, - cleanup/1, evil_timers/1, registered_process/1]). + read_timer_trivial/1, read_timer/1, read_timer_async/1, + cleanup/1, evil_timers/1, registered_process/1, same_time_yielding/1, + same_time_yielding_with_cancel/1, same_time_yielding_with_cancel_other/1, +% same_time_yielding_with_cancel_other_accessor/1, + auto_cancel_yielding/1]). + +-include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server.hrl"). +-define(SHORT_TIMEOUT, 5000). %% Bif timers as short as this may be pre-allocated +-define(TIMEOUT_YIELD_LIMIT, 100). +-define(AUTO_CANCEL_YIELD_LIMIT, 100). init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:seconds(30)), case catch erts_debug:get_internal_state(available_internal_state) of true -> ok; _ -> erts_debug:set_internal_state(available_internal_state, true) end, - [{watchdog, Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) -> + erts_debug:set_internal_state(available_internal_state, true), Config. end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> [start_timer_1, send_after_1, send_after_2, cancel_timer_1, start_timer_e, send_after_e, cancel_timer_e, start_timer_big, send_after_big, - read_timer_trivial, read_timer, cleanup, evil_timers, - registered_process]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. + read_timer_trivial, read_timer, read_timer_async, + cleanup, evil_timers, registered_process, + same_time_yielding, same_time_yielding_with_cancel, + same_time_yielding_with_cancel_other, +% same_time_yielding_with_cancel_other_accessor, + auto_cancel_yielding]. -start_timer_1(doc) -> ["Basic start_timer/3 functionality"]; +%% Basic start_timer/3 functionality start_timer_1(Config) when is_list(Config) -> Ref1 = erlang:start_timer(1000, self(), plopp), - ok = get(1100, {timeout, Ref1, plopp}), + ok = get(1400, {timeout, Ref1, plopp}), false = erlang:read_timer(Ref1), false = erlang:cancel_timer(Ref1), @@ -81,62 +83,62 @@ start_timer_1(Config) when is_list(Config) -> Ref2 = erlang:start_timer(1000, self(), plapp), Left2 = erlang:cancel_timer(Ref2), UpperLimit = 1000, - true = (Left2 > 900) and (Left2 =< UpperLimit), + true = (Left2 > 600) and (Left2 =< UpperLimit), empty = get_msg(), false = erlang:cancel_timer(Ref2), Ref3 = erlang:start_timer(1000, self(), plopp), - no_message = get(900, {timeout, Ref3, plopp}), + no_message = get(600, {timeout, Ref3, plopp}), ok. -send_after_1(doc) -> ["Basic send_after/3 functionality"]; +%% Basic send_after/3 functionality send_after_1(Config) when is_list(Config) -> - ?line Ref3 = erlang:send_after(1000, self(), plipp), - ?line ok = get(1500, plipp), - ?line false = erlang:read_timer(Ref3), + Ref3 = erlang:send_after(1000, self(), plipp), + ok = get(1500, plipp), + false = erlang:read_timer(Ref3), ok. -start_timer_big(doc) -> ["Big timeouts for start_timer/3"]; +%% Big timeouts for start_timer/3 start_timer_big(Config) when is_list(Config) -> - ?line Big = 1 bsl 31, - ?line R = erlang:start_timer(Big, self(), hej), - ?line timer:sleep(200), - ?line Left = erlang:cancel_timer(R), - ?line case Big - Left of - Diff when Diff >= 200, Diff < 10000 -> - ok; - _Diff -> - test_server:fail({big, Big, Left}) - end, + Big = 1 bsl 31, + R = erlang:start_timer(Big, self(), hej), + timer:sleep(200), + Left = erlang:cancel_timer(R), + case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + ct:fail({big, Big, Left}) + end, ok. -send_after_big(doc) -> ["Big timeouts for send_after/3"]; +%% Big timeouts for send_after/3 send_after_big(Config) when is_list(Config) -> - ?line Big = 1 bsl 31, - ?line R = erlang:send_after(Big, self(), hej), - ?line timer:sleep(200), - ?line Left = erlang:cancel_timer(R), - ?line case Big - Left of - Diff when Diff >= 200, Diff < 10000 -> - ok; - _Diff -> - test_server:fail({big, Big, Left}) - end, + Big = 1 bsl 31, + R = erlang:send_after(Big, self(), hej), + timer:sleep(200), + Left = erlang:cancel_timer(R), + case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + ct:fail({big, Big, Left}) + end, ok. -send_after_2(doc) -> ["send_after/3: messages in the right order, kind version"]; +%% send_after/3: messages in the right order, kind version send_after_2(Config) when is_list(Config) -> - ?line _ = erlang:send_after(5000, self(), last), - ?line _ = erlang:send_after(0, self(), a0), - ?line _ = erlang:send_after(200, self(), a2), - ?line _ = erlang:send_after(100, self(), a1), - ?line _ = erlang:send_after(500, self(), a5), - ?line _ = erlang:send_after(300, self(), a3), - ?line _ = erlang:send_after(400, self(), a4), - ?line [a0,a1,a2,a3,a4,a5,last] = collect(last), + _ = erlang:send_after(5000, self(), last), + _ = erlang:send_after(0, self(), a0), + _ = erlang:send_after(200, self(), a2), + _ = erlang:send_after(100, self(), a1), + _ = erlang:send_after(500, self(), a5), + _ = erlang:send_after(300, self(), a3), + _ = erlang:send_after(400, self(), a4), + [a0,a1,a2,a3,a4,a5,last] = collect(last), ok. -send_after_3(doc) -> ["send_after/3: messages in the right order, worse than send_after_2"]; +%% send_after/3: messages in the right order, worse than send_after_2 send_after_3(Config) when is_list(Config) -> _ = erlang:send_after(100, self(), b1), _ = erlang:send_after(101, self(), b2), @@ -144,141 +146,173 @@ send_after_3(Config) when is_list(Config) -> _ = erlang:send_after(103, self(), last), [b1, b2, b3, last] = collect(last), -% This behaviour is not guaranteed: -% ?line _ = erlang:send_after(100, self(), c1), -% ?line _ = erlang:send_after(100, self(), c2), -% ?line _ = erlang:send_after(100, self(), c3), -% ?line _ = erlang:send_after(100, self(), last), -% ?line [c1, c2, c3, last] = collect(last), + % This behaviour is not guaranteed: + % _ = erlang:send_after(100, self(), c1), + % _ = erlang:send_after(100, self(), c2), + % _ = erlang:send_after(100, self(), c3), + % _ = erlang:send_after(100, self(), last), + % [c1, c2, c3, last] = collect(last), ok. -cancel_timer_1(doc) -> ["Check trivial cancel_timer/1 behaviour"]; +%% Check trivial cancel_timer/1 behaviour cancel_timer_1(Config) when is_list(Config) -> - ?line false = erlang:cancel_timer(make_ref()), + false = erlang:cancel_timer(make_ref()), ok. -start_timer_e(doc) -> ["Error cases for start_timer/3"]; +%% Error cases for start_timer/3 start_timer_e(Config) when is_list(Config) -> - ?line {'EXIT', _} = (catch erlang:start_timer(-4, self(), hej)), - ?line {'EXIT', _} = (catch erlang:start_timer(4728472847827482, - self(), hej)), + {'EXIT', _} = (catch erlang:start_timer(-4, self(), hej)), + {'EXIT', _} = (catch erlang:start_timer(1 bsl 64, + self(), hej)), - ?line {'EXIT', _} = (catch erlang:start_timer(4.5, self(), hej)), - ?line {'EXIT', _} = (catch erlang:start_timer(a, self(), hej)), + {'EXIT', _} = (catch erlang:start_timer(4.5, self(), hej)), + {'EXIT', _} = (catch erlang:start_timer(a, self(), hej)), - ?line Node = start_slave(), - ?line Pid = spawn(Node, timer, sleep, [10000]), - ?line {'EXIT', _} = (catch erlang:start_timer(1000, Pid, hej)), - ?line stop_slave(Node), + Node = start_slave(), + Pid = spawn(Node, timer, sleep, [10000]), + {'EXIT', _} = (catch erlang:start_timer(1000, Pid, hej)), + stop_slave(Node), ok. -send_after_e(doc) -> ["Error cases for send_after/3"]; -send_after_e(suite) -> []; +%% Error cases for send_after/3 send_after_e(Config) when is_list(Config) -> - ?line {'EXIT', _} = (catch erlang:send_after(-4, self(), hej)), - ?line {'EXIT', _} = (catch erlang:send_after(4728472847827482, - self(), hej)), + {'EXIT', _} = (catch erlang:send_after(-4, self(), hej)), + {'EXIT', _} = (catch erlang:send_after(1 bsl 64, + self(), hej)), - ?line {'EXIT', _} = (catch erlang:send_after(4.5, self(), hej)), - ?line {'EXIT', _} = (catch erlang:send_after(a, self(), hej)), + {'EXIT', _} = (catch erlang:send_after(4.5, self(), hej)), + {'EXIT', _} = (catch erlang:send_after(a, self(), hej)), - ?line Node = start_slave(), - ?line Pid = spawn(Node, timer, sleep, [10000]), - ?line {'EXIT', _} = (catch erlang:send_after(1000, Pid, hej)), - ?line stop_slave(Node), + Node = start_slave(), + Pid = spawn(Node, timer, sleep, [10000]), + {'EXIT', _} = (catch erlang:send_after(1000, Pid, hej)), + stop_slave(Node), ok. -cancel_timer_e(doc) -> ["Error cases for cancel_timer/1"]; -cancel_timer_e(suite) -> []; +%% Error cases for cancel_timer/1 cancel_timer_e(Config) when is_list(Config) -> - ?line {'EXIT', _} = (catch erlang:cancel_timer(1)), - ?line {'EXIT', _} = (catch erlang:cancel_timer(self())), - ?line {'EXIT', _} = (catch erlang:cancel_timer(a)), + {'EXIT', _} = (catch erlang:cancel_timer(1)), + {'EXIT', _} = (catch erlang:cancel_timer(self())), + {'EXIT', _} = (catch erlang:cancel_timer(a)), ok. -read_timer_trivial(doc) -> ["Trivial and error test cases for read_timer/1."]; -read_timer_trivial(suite) -> []; +%% Trivial and error test cases for read_timer/1. read_timer_trivial(Config) when is_list(Config) -> - ?line false = erlang:read_timer(make_ref()), - ?line {'EXIT', _} = (catch erlang:read_timer(42)), - ?line {'EXIT', _} = (catch erlang:read_timer(423497834744444444457667444444)), - ?line {'EXIT', _} = (catch erlang:read_timer(self())), - ?line {'EXIT', _} = (catch erlang:read_timer(ab)), + false = erlang:read_timer(make_ref()), + {'EXIT', _} = (catch erlang:read_timer(42)), + {'EXIT', _} = (catch erlang:read_timer(423497834744444444457667444444)), + {'EXIT', _} = (catch erlang:read_timer(self())), + {'EXIT', _} = (catch erlang:read_timer(ab)), ok. -read_timer(doc) -> ["Test that read_timer/1 seems to return the correct values."]; -read_timer(suite) -> []; +%% Test that read_timer/1 seems to return the correct values. read_timer(Config) when is_list(Config) -> - ?line Big = 1 bsl 31, - ?line R = erlang:send_after(Big, self(), hej_hopp), - - ?line receive after 200 -> ok end, % Delay and clear reductions. - ?line Left = erlang:read_timer(R), - ?line Left = erlang:cancel_timer(R), - ?line false = erlang:read_timer(R), - - ?line case Big - Left of - Diff when Diff >= 200, Diff < 10000 -> - ok; - _Diff -> - test_server:fail({big, Big, Left}) - end, + process_flag(scheduler, 1), + Big = 1 bsl 31, + R = erlang:send_after(Big, self(), hej_hopp), + + receive after 200 -> ok end, % Delay and clear reductions. + Left = erlang:read_timer(R), + Left2 = erlang:cancel_timer(R), + case Left == Left2 of + true -> ok; + false -> Left = Left2 + 1 + end, + false = erlang:read_timer(R), + + case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + ct:fail({big, Big, Left}) + end, + process_flag(scheduler, 0), + ok. + +%% Test that read_timer/1 seems to return the correct values. +read_timer_async(Config) when is_list(Config) -> + process_flag(scheduler, 1), + Big = 1 bsl 33, + R = erlang:send_after(Big, self(), hej_hopp), + + %% Access from another scheduler + process_flag(scheduler, erlang:system_info(schedulers_online)), + + receive after 200 -> ok end, % Delay and clear reductions. + ok = erlang:read_timer(R, [{async, true}]), + ok = erlang:cancel_timer(R, [{async, true}, {info, true}]), + ok = erlang:read_timer(R, [{async, true}]), + + {read_timer, R, Left} = receive_one(), + {cancel_timer, R, Left2} = receive_one(), + case Left == Left2 of + true -> ok; + false -> Left = Left2 + 1 + end, + {read_timer, R, false} = receive_one(), + + case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + ct:fail({big, Big, Left}) + end, + process_flag(scheduler, 0), ok. -cleanup(doc) -> []; -cleanup(suite) -> []; cleanup(Config) when is_list(Config) -> - ?line Mem = mem(), + Mem = mem(), %% Timer on dead process - ?line P1 = spawn(fun () -> ok end), - ?line wait_until(fun () -> process_is_cleaned_up(P1) end), - ?line T1 = erlang:start_timer(10000, P1, "hej"), - ?line T2 = erlang:send_after(10000, P1, "hej"), - ?line Mem = mem(), - ?line false = erlang:read_timer(T1), - ?line false = erlang:read_timer(T2), - ?line Mem = mem(), + P1 = spawn(fun () -> ok end), + wait_until(fun () -> process_is_cleaned_up(P1) end), + T1 = erlang:start_timer(?SHORT_TIMEOUT*2, P1, "hej"), + T2 = erlang:send_after(?SHORT_TIMEOUT*2, P1, "hej"), + receive after 1000 -> ok end, + Mem = mem(), + false = erlang:read_timer(T1), + false = erlang:read_timer(T2), + Mem = mem(), %% Process dies before timeout - ?line P2 = spawn(fun () -> receive after 500 -> ok end end), - ?line T3 = erlang:start_timer(10000, P2, "hej"), - ?line T4 = erlang:send_after(10000, P2, "hej"), - ?line true = Mem < mem(), - ?line true = is_integer(erlang:read_timer(T3)), - ?line true = is_integer(erlang:read_timer(T4)), - ?line wait_until(fun () -> process_is_cleaned_up(P2) end), - ?line false = erlang:read_timer(T3), - ?line false = erlang:read_timer(T4), - ?line Mem = mem(), + P2 = spawn(fun () -> receive after (?SHORT_TIMEOUT div 10) -> ok end end), + T3 = erlang:start_timer(?SHORT_TIMEOUT*2, P2, "hej"), + T4 = erlang:send_after(?SHORT_TIMEOUT*2, P2, "hej"), + true = mem_larger_than(Mem), + true = is_integer(erlang:read_timer(T3)), + true = is_integer(erlang:read_timer(T4)), + wait_until(fun () -> process_is_cleaned_up(P2) end), + receive after 1000 -> ok end, + false = erlang:read_timer(T3), + false = erlang:read_timer(T4), + Mem = mem(), %% Cancel timer - ?line P3 = spawn(fun () -> receive after 20000 -> ok end end), - ?line T5 = erlang:start_timer(10000, P3, "hej"), - ?line T6 = erlang:send_after(10000, P3, "hej"), - ?line true = Mem < mem(), - ?line true = is_integer(erlang:cancel_timer(T5)), - ?line true = is_integer(erlang:cancel_timer(T6)), - ?line false = erlang:read_timer(T5), - ?line false = erlang:read_timer(T6), - ?line exit(P3, kill), - ?line Mem = mem(), + P3 = spawn(fun () -> receive after ?SHORT_TIMEOUT*4 -> ok end end), + T5 = erlang:start_timer(?SHORT_TIMEOUT*2, P3, "hej"), + T6 = erlang:send_after(?SHORT_TIMEOUT*2, P3, "hej"), + true = mem_larger_than(Mem), + true = is_integer(erlang:cancel_timer(T5)), + true = is_integer(erlang:cancel_timer(T6)), + false = erlang:read_timer(T5), + false = erlang:read_timer(T6), + exit(P3, kill), + wait_until(fun () -> process_is_cleaned_up(P3) end), + Mem = mem(), %% Timeout - ?line Ref = make_ref(), - ?line T7 = erlang:start_timer(500, self(), Ref), - ?line T8 = erlang:send_after(500, self(), Ref), - ?line true = Mem < mem(), - ?line true = is_integer(erlang:read_timer(T7)), - ?line true = is_integer(erlang:read_timer(T8)), - ?line receive {timeout, T7, Ref} -> ok end, - ?line receive Ref -> ok end, - ?line Mem = mem(), - ?line ok. - - -evil_timers(doc) -> []; -evil_timers(suite) -> []; + Ref = make_ref(), + T7 = erlang:start_timer(?SHORT_TIMEOUT+1, self(), Ref), + T8 = erlang:send_after(?SHORT_TIMEOUT+1, self(), Ref), + true = mem_larger_than(Mem), + true = is_integer(erlang:read_timer(T7)), + true = is_integer(erlang:read_timer(T8)), + receive {timeout, T7, Ref} -> ok end, + receive Ref -> ok end, + Mem = mem(), + ok. + + evil_timers(Config) when is_list(Config) -> %% Create a composite term consisting of at least: %% * externals (remote pids, ports, and refs) @@ -290,38 +324,38 @@ evil_timers(Config) when is_list(Config) -> %% * lists %% since data of these types have to be adjusted if moved %% in memory - ?line Self = self(), - ?line R1 = make_ref(), - ?line Node = start_slave(), - ?line spawn_link(Node, - fun () -> - Self ! {R1, - [lists:sublist(erlang:ports(), 3), - [make_ref(), make_ref(), make_ref()], - lists:sublist(processes(), 3), - [fun () -> gurka end, - fun (A) -> A + 1 end, - fun (A, B) -> A + B end]]} - end), - ?line ExtList = receive {R1, L} -> L end, - ?line stop_slave(Node), - ?line BinList = [<<"bla">>, - <<"blipp">>, - <<"blupp">>, - list_to_binary(lists:duplicate(1000000,$a)), - list_to_binary(lists:duplicate(1000000,$b)), - list_to_binary(lists:duplicate(1000000,$c))], - ?line FunList = [fun () -> gurka end, - fun (A) -> A + 1 end, - fun (A, B) -> A + B end], - ?line PidList = lists:sublist(processes(), 3), - ?line PortList = lists:sublist(erlang:ports(), 3), - ?line RefList = [make_ref(), make_ref(), make_ref()], - ?line BigList = [111111111111, 22222222222222, 333333333333333333], - ?line Msg = {BinList,[FunList,{RefList,ExtList,PidList,PortList,BigList}]}, - %% ?line ?t:format("Msg=~p~n",[Msg]), - - ?line Prio = process_flag(priority, max), + Self = self(), + R1 = make_ref(), + Node = start_slave(), + spawn_link(Node, + fun () -> + Self ! {R1, + [lists:sublist(erlang:ports(), 3), + [make_ref(), make_ref(), make_ref()], + lists:sublist(processes(), 3), + [fun () -> gurka end, + fun (A) -> A + 1 end, + fun (A, B) -> A + B end]]} + end), + ExtList = receive {R1, L} -> L end, + stop_slave(Node), + BinList = [<<"bla">>, + <<"blipp">>, + <<"blupp">>, + list_to_binary(lists:duplicate(1000000,$a)), + list_to_binary(lists:duplicate(1000000,$b)), + list_to_binary(lists:duplicate(1000000,$c))], + FunList = [fun () -> gurka end, + fun (A) -> A + 1 end, + fun (A, B) -> A + B end], + PidList = lists:sublist(processes(), 3), + PortList = lists:sublist(erlang:ports(), 3), + RefList = [make_ref(), make_ref(), make_ref()], + BigList = [111111111111, 22222222222222, 333333333333333333], + Msg = {BinList,[FunList,{RefList,ExtList,PidList,PortList,BigList}]}, + %% io:format("Msg=~p~n",[Msg]), + + Prio = process_flag(priority, max), %% %% In the smp case there are four major cases we want to test: %% @@ -334,8 +368,8 @@ evil_timers(Config) when is_list(Config) -> %% be allocated in the previously allocated message buffer along %% with Msg, i.e. the previously allocated message buffer will be %% reallocated and potentially moved. - ?line TimeOutMsgs0 = evil_setup_timers(200, Self, Msg), - ?line RecvTimeOutMsgs0 = evil_recv_timeouts(200), + TimeOutMsgs0 = evil_setup_timers(200, Self, Msg), + RecvTimeOutMsgs0 = evil_recv_timeouts(200), %% 2. A timer started with erlang:start_timer(Time, Receiver, Msg), %% where Msg is an immediate term, expires, and the receivers main %% lock *can not* be acquired immediately (typically when the @@ -343,8 +377,8 @@ evil_timers(Config) when is_list(Config) -> %% %% The wrap tuple will in this case be allocated in a new %% message buffer. - ?line TimeOutMsgs1 = evil_setup_timers(200, Self, immediate), - ?line RecvTimeOutMsgs1 = evil_recv_timeouts(200), + TimeOutMsgs1 = evil_setup_timers(200, Self, immediate), + RecvTimeOutMsgs1 = evil_recv_timeouts(200), %% 3. A timer started with erlang:start_timer(Time, Receiver, Msg), %% where Msg is a composite term, expires, and the receivers main %% lock *can* be acquired immediately (typically when the receiver @@ -353,13 +387,13 @@ evil_timers(Config) when is_list(Config) -> %% The wrap tuple will in this case be allocated on the receivers %% heap, and Msg is passed in the previously allocated message %% buffer. - ?line R2 = make_ref(), - ?line spawn_link(fun () -> - Self ! {R2, evil_setup_timers(200, Self, Msg)} - end), - ?line receive after 1000 -> ok end, - ?line TimeOutMsgs2 = receive {R2, TOM2} -> TOM2 end, - ?line RecvTimeOutMsgs2 = evil_recv_timeouts(200), + R2 = make_ref(), + spawn_link(fun () -> + Self ! {R2, evil_setup_timers(200, Self, Msg)} + end), + receive after 1000 -> ok end, + TimeOutMsgs2 = receive {R2, TOM2} -> TOM2 end, + RecvTimeOutMsgs2 = evil_recv_timeouts(200), %% 4. A timer started with erlang:start_timer(Time, Receiver, Msg), %% where Msg is an immediate term, expires, and the Receivers main %% lock *can* be acquired immediately (typically when the receiver @@ -367,129 +401,280 @@ evil_timers(Config) when is_list(Config) -> %% %% The wrap tuple will in this case be allocated on the receivers %% heap. - ?line R3 = make_ref(), - ?line spawn_link(fun () -> - Self ! {R3, evil_setup_timers(200,Self,immediate)} - end), - ?line receive after 1000 -> ok end, - ?line TimeOutMsgs3 = receive {R3, TOM3} -> TOM3 end, - ?line RecvTimeOutMsgs3 = evil_recv_timeouts(200), + R3 = make_ref(), + spawn_link(fun () -> + Self ! {R3, evil_setup_timers(200,Self,immediate)} + end), + receive after 1000 -> ok end, + TimeOutMsgs3 = receive {R3, TOM3} -> TOM3 end, + RecvTimeOutMsgs3 = evil_recv_timeouts(200), %% Garge collection will hopefully crash the emulator if something %% is wrong... - ?line garbage_collect(), - ?line garbage_collect(), - ?line garbage_collect(), + garbage_collect(), + garbage_collect(), + garbage_collect(), %% Make sure we got the timeouts we expected %% %% Note timeouts are *not* guaranteed to be delivered in order - ?line ok = match(lists:sort(RecvTimeOutMsgs0), lists:sort(TimeOutMsgs0)), - ?line ok = match(lists:sort(RecvTimeOutMsgs1), lists:sort(TimeOutMsgs1)), - ?line ok = match(lists:sort(RecvTimeOutMsgs2), lists:sort(TimeOutMsgs2)), - ?line ok = match(lists:sort(RecvTimeOutMsgs3), lists:sort(TimeOutMsgs3)), + ok = match(lists:sort(RecvTimeOutMsgs0), lists:sort(TimeOutMsgs0)), + ok = match(lists:sort(RecvTimeOutMsgs1), lists:sort(TimeOutMsgs1)), + ok = match(lists:sort(RecvTimeOutMsgs2), lists:sort(TimeOutMsgs2)), + ok = match(lists:sort(RecvTimeOutMsgs3), lists:sort(TimeOutMsgs3)), - ?line process_flag(priority, Prio), - ?line ok. + process_flag(priority, Prio), + ok. evil_setup_timers(N, Receiver, Msg) -> - ?line evil_setup_timers(0, N, Receiver, Msg, []). + evil_setup_timers(0, N, Receiver, Msg, []). evil_setup_timers(N, N, _Receiver, _Msg, TOs) -> - ?line TOs; + TOs; evil_setup_timers(N, Max, Receiver, Msg, TOs) -> - ?line TRef = erlang:start_timer(N, Receiver, Msg), - ?line evil_setup_timers(N+1, Max, Receiver, Msg, [{timeout,TRef,Msg}|TOs]). + TRef = erlang:start_timer(N, Receiver, Msg), + evil_setup_timers(N+1, Max, Receiver, Msg, [{timeout,TRef,Msg}|TOs]). evil_recv_timeouts(M) -> - ?line evil_recv_timeouts([], 0, M). + evil_recv_timeouts([], 0, M). evil_recv_timeouts(TOs, N, N) -> - ?line TOs; + TOs; evil_recv_timeouts(TOs, N, M) -> - ?line receive - {timeout, _, _} = TO -> - ?line evil_recv_timeouts([TO|TOs], N+1, M) - after 0 -> - ?line evil_recv_timeouts(TOs, N, M) - end. - -registered_process(doc) -> []; -registered_process(suite) -> []; + receive + {timeout, _, _} = TO -> + evil_recv_timeouts([TO|TOs], N+1, M) + after 0 -> + evil_recv_timeouts(TOs, N, M) + end. + registered_process(Config) when is_list(Config) -> - ?line Mem = mem(), + Mem = mem(), %% Cancel - ?line T1 = erlang:start_timer(500, ?MODULE, "hej"), - ?line T2 = erlang:send_after(500, ?MODULE, "hej"), - ?line undefined = whereis(?MODULE), - ?line true = Mem < mem(), - ?line true = is_integer(erlang:cancel_timer(T1)), - ?line true = is_integer(erlang:cancel_timer(T2)), - ?line false = erlang:read_timer(T1), - ?line false = erlang:read_timer(T2), - ?line Mem = mem(), + T1 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, "hej"), + T2 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, "hej"), + undefined = whereis(?MODULE), + true = mem_larger_than(Mem), + true = is_integer(erlang:cancel_timer(T1)), + true = is_integer(erlang:cancel_timer(T2)), + false = erlang:read_timer(T1), + false = erlang:read_timer(T2), + Mem = mem(), %% Timeout register after start - ?line Ref1 = make_ref(), - ?line T3 = erlang:start_timer(500, ?MODULE, Ref1), - ?line T4 = erlang:send_after(500, ?MODULE, Ref1), - ?line undefined = whereis(?MODULE), - ?line true = Mem < mem(), - ?line true = is_integer(erlang:read_timer(T3)), - ?line true = is_integer(erlang:read_timer(T4)), - ?line true = register(?MODULE, self()), - ?line receive {timeout, T3, Ref1} -> ok end, - ?line receive Ref1 -> ok end, - ?line Mem = mem(), + Ref1 = make_ref(), + T3 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref1), + T4 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref1), + undefined = whereis(?MODULE), + true = mem_larger_than(Mem), + true = is_integer(erlang:read_timer(T3)), + true = is_integer(erlang:read_timer(T4)), + true = register(?MODULE, self()), + receive {timeout, T3, Ref1} -> ok end, + receive Ref1 -> ok end, + Mem = mem(), %% Timeout register before start - ?line Ref2 = make_ref(), - ?line T5 = erlang:start_timer(500, ?MODULE, Ref2), - ?line T6 = erlang:send_after(500, ?MODULE, Ref2), - ?line true = Mem < mem(), - ?line true = is_integer(erlang:read_timer(T5)), - ?line true = is_integer(erlang:read_timer(T6)), - ?line receive {timeout, T5, Ref2} -> ok end, - ?line receive Ref2 -> ok end, - ?line Mem = mem(), - ?line true = unregister(?MODULE), - ?line ok. + Ref2 = make_ref(), + T5 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref2), + T6 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref2), + true = mem_larger_than(Mem), + true = is_integer(erlang:read_timer(T5)), + true = is_integer(erlang:read_timer(T6)), + receive {timeout, T5, Ref2} -> ok end, + receive Ref2 -> ok end, + Mem = mem(), + true = unregister(?MODULE), + ok. -mem() -> - AA = erlang:system_info(allocated_areas), - {value,{bif_timer,Mem}} = lists:keysearch(bif_timer, 1, AA), - Mem. +same_time_yielding(Config) when is_list(Config) -> + Mem = mem(), + Ref = make_ref(), + SchdlrsOnln = erlang:system_info(schedulers_online), + Tmo = erlang:monotonic_time(millisecond) + 3000, + Tmrs = lists:map(fun (I) -> + process_flag(scheduler, (I rem SchdlrsOnln) + 1), + erlang:start_timer(Tmo, self(), Ref, [{abs, true}]) + end, + lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)), + true = mem_larger_than(Mem), + receive_all_timeouts(length(Tmrs), Ref), + Done = erlang:monotonic_time(millisecond), + true = Done >= Tmo, + MsAfterTmo = Done - Tmo, + io:format("Done ~p ms after Tmo\n", [MsAfterTmo]), + case erlang:system_info(build_type) of + opt -> + true = MsAfterTmo < 200; + _ -> + true = MsAfterTmo < 1000 + end, + Mem = mem(), + ok. + +%% Read out all timeouts in receive queue order. This is efficient +%% even if there are very many messages. + +receive_all_timeouts(0, _Ref) -> + ok; +receive_all_timeouts(N, Ref) -> + receive + {timeout, _Tmr, Ref} -> + receive_all_timeouts(N-1, Ref) + end. + +same_time_yielding_with_cancel(Config) when is_list(Config) -> + same_time_yielding_with_cancel_test(false, false). + +same_time_yielding_with_cancel_other(Config) when is_list(Config) -> + same_time_yielding_with_cancel_test(true, false). + +%same_time_yielding_with_cancel_other_accessor(Config) when is_list(Config) -> +% same_time_yielding_with_cancel_test(true, true). + +do_cancel_tmrs(Tmo, Tmrs, Tester) -> + BeginCancel = erlang:convert_time_unit(Tmo, + millisecond, + microsecond) - 100, + busy_wait_until(fun () -> + erlang:monotonic_time(microsecond) >= BeginCancel + end), + lists:foreach(fun (Tmr) -> + erlang:cancel_timer(Tmr, + [{async, true}, + {info, true}]) + end, Tmrs), + case Tester == self() of + true -> ok; + false -> forward_msgs(Tester) + end. + +same_time_yielding_with_cancel_test(Other, Accessor) -> + Mem = mem(), + SchdlrsOnln = erlang:system_info(schedulers_online), + Tmo = erlang:monotonic_time(millisecond) + 3000, + Tester = self(), + Cancelor = case Other of + false -> + Tester; + true -> + spawn(fun () -> + receive + {timers, Tmrs} -> + do_cancel_tmrs(Tmo, Tmrs, Tester) + end + end) + end, + Opts = case Accessor of + false -> [{abs, true}]; + true -> [{accessor, Cancelor}, {abs, true}] + end, + Tmrs = lists:map(fun (I) -> + process_flag(scheduler, (I rem SchdlrsOnln) + 1), + erlang:start_timer(Tmo, self(), hej, Opts) + end, + lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)), + true = mem_larger_than(Mem), + case Other of + false -> + do_cancel_tmrs(Tmo, Tmrs, Tester); + true -> + Cancelor ! {timers, Tmrs} + end, + {Tmos, Cncls} = lists:foldl(fun (Tmr, {T, C}) -> + receive + {timeout, Tmr, hej} -> + receive + {cancel_timer, Tmr, Info} -> + false = Info, + {T+1, C} + end; + {cancel_timer, Tmr, false} -> + receive + {timeout, Tmr, hej} -> + {T+1, C} + end; + {cancel_timer, Tmr, TimeLeft} -> + true = is_integer(TimeLeft), + {T, C+1} + end + end, + {0, 0}, + Tmrs), + io:format("Timeouts: ~p Cancels: ~p~n", [Tmos, Cncls]), + Mem = mem(), + case Other of + true -> exit(Cancelor, bang); + false -> ok + end, + {comment, + "Timeouts: " ++ integer_to_list(Tmos) ++ " Cancels: " + ++ integer_to_list(Cncls)}. + +auto_cancel_yielding(Config) when is_list(Config) -> + Mem = mem(), + SchdlrsOnln = erlang:system_info(schedulers_online), + P = spawn(fun () -> + lists:foreach( + fun (I) -> + process_flag(scheduler, (I rem SchdlrsOnln)+1), + erlang:start_timer((1 bsl 28)+I*10, self(), hej) + end, + lists:seq(1, + ((?AUTO_CANCEL_YIELD_LIMIT*3+1) + *SchdlrsOnln))), + receive after infinity -> ok end + end), + true = mem_larger_than(Mem), + exit(P, bang), + wait_until(fun () -> process_is_cleaned_up(P) end), + Mem = mem(), + ok. process_is_cleaned_up(P) when is_pid(P) -> undefined == erts_debug:get_internal_state({process_status, P}). wait_until(Pred) when is_function(Pred) -> case catch Pred() of - true -> ok; - _ -> receive after 50 -> ok end, wait_until(Pred) + true -> ok; + _ -> receive after 50 -> ok end, wait_until(Pred) + end. + +busy_wait_until(Pred) when is_function(Pred) -> + case catch Pred() of + true -> ok; + _ -> busy_wait_until(Pred) end. +forward_msgs(To) -> + receive + Msg -> + To ! Msg + end, + forward_msgs(To). + get(Time, Msg) -> receive - Msg -> - ok + Msg -> + ok after Time - -> - no_message + -> + no_message end. get_msg() -> receive - Msg -> - {ok, Msg} + Msg -> + {ok, Msg} after 0 -> - empty + empty end. start_slave() -> - ?line {A, B, C} = now(), - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line Name = atom_to_list(?MODULE) ++ "-" ++ integer_to_list(A+B+C), - {ok, Node} = ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]), + Pa = filename:dirname(code:which(?MODULE)), + Name = atom_to_list(?MODULE) + ++ "-" ++ integer_to_list(erlang:system_time(second)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive])), + {ok, Node} = test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]), Node. stop_slave(Node) -> @@ -500,18 +685,18 @@ collect(Last) -> receive_one() -> receive - Msg -> - Msg + Msg -> + Msg end. collect(Last, Msgs0) -> Msg = receive_one(), Msgs = Msgs0 ++ [Msg], case Msg of - Last -> - Msgs; - _ -> - collect(Last, Msgs) + Last -> + Msgs; + _ -> + collect(Last, Msgs) end. match(X, X) -> @@ -549,5 +734,58 @@ type(X) when is_port(X) -> {port, node(X)}; type(X) when is_binary(X) -> binary; type(X) when is_atom(X) -> atom; type(_) -> unknown. - + +mem_larger_than(no_fix_alloc) -> + true; +mem_larger_than(Mem) -> + mem() > Mem. + +mem() -> + erts_debug:set_internal_state(wait, timer_cancellations), + erts_debug:set_internal_state(wait, deallocations), + case mem_get() of + {-1, -1} -> no_fix_alloc; + {A, U} -> io:format("mem = ~p ~p~n", [A, U]), U + end. + +mem_get() -> + % Bif timer memory + Ref = make_ref(), + erlang:system_info({memory_internal, Ref, [fix_alloc]}), + mem_recv(erlang:system_info(schedulers), Ref, {0, 0}). + +mem_recv(0, _Ref, AU) -> + AU; +mem_recv(N, Ref, AU) -> + receive + {Ref, _, IL} -> + mem_recv(N-1, Ref, mem_parse_ilists(IL, AU)) + end. + + +mem_parse_ilists([], AU) -> + AU; +mem_parse_ilists([I|Is], AU) -> + mem_parse_ilists(Is, mem_parse_ilist(I, AU)). + +mem_parse_ilist({fix_alloc, false}, _) -> + {-1, -1}; +mem_parse_ilist({fix_alloc, _, IDL}, {A, U}) -> + case lists:keyfind(fix_types, 1, IDL) of + {fix_types, TL} -> + {ThisA, ThisU} = mem_get_btm_aus(TL, 0, 0), + {ThisA + A, ThisU + U}; + {fix_types, Mask, TL} -> + {ThisA, ThisU} = mem_get_btm_aus(TL, 0, 0), + {(ThisA + A) band Mask , (ThisU + U) band Mask} + end. + +mem_get_btm_aus([], A, U) -> + {A, U}; +mem_get_btm_aus([{BtmType, BtmA, BtmU} | Types], + A, U) when BtmType == bif_timer; + BtmType == accessor_bif_timer -> + mem_get_btm_aus(Types, BtmA+A, BtmU+U); +mem_get_btm_aus([_|Types], A, U) -> + mem_get_btm_aus(Types, A, U). diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 2251575e5a..a81aa64057 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,476 +24,838 @@ %%% Tests the trace BIF. %%% --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, receive_trace/1, self_send/1, +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2, + link_receive_call_correlation/0, + receive_trace/1, link_receive_call_correlation/1, self_send/1, timeout_trace/1, send_trace/1, - procs_trace/1, dist_procs_trace/1, + procs_trace/1, dist_procs_trace/1, procs_new_trace/1, suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1, suspend_system_limit/1, suspend_opts/1, suspend_waiting/1, - new_clear/1, existing_clear/1, + new_clear/1, existing_clear/1, tracer_die/1, set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1, + set_on_link/1, set_on_first_link/1, system_monitor_args/1, more_system_monitor_args/1, system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, system_monitor_long_schedule/1, - bad_flag/1, trace_delivered/1]). + bad_flag/1, trace_delivered/1, trap_exit_self_receive/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%% Internal exports -export([process/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> - [cpu_timestamp, receive_trace, self_send, timeout_trace, + [cpu_timestamp, receive_trace, link_receive_call_correlation, + self_send, timeout_trace, send_trace, procs_trace, dist_procs_trace, suspend, mutual_suspend, suspend_exit, suspender_exit, suspend_system_limit, suspend_opts, suspend_waiting, - new_clear, existing_clear, set_on_spawn, - set_on_first_spawn, system_monitor_args, + new_clear, existing_clear, tracer_die, set_on_spawn, + set_on_first_spawn, set_on_link, set_on_first_link, + system_monitor_args, more_system_monitor_args, system_monitor_long_gc_1, system_monitor_long_gc_2, system_monitor_large_heap_1, - system_monitor_long_schedule, - system_monitor_large_heap_2, bad_flag, trace_delivered]. - -groups() -> - []. + system_monitor_long_schedule, + system_monitor_large_heap_2, bad_flag, trace_delivered, + trap_exit_self_receive]. -init_per_suite(Config) -> - Config. +init_per_testcase(_Case, Config) -> + [{receiver,spawn(fun receiver/0)}|Config]. -end_per_suite(_Config) -> +end_per_testcase(_Case, Config) -> + Receiver = proplists:get_value(receiver, Config), + unlink(Receiver), + exit(Receiver, die), ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - - %% No longer testing anything, just reporting whether cpu_timestamp %% is enabled or not. cpu_timestamp(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - %% Test whether cpu_timestamp is implemented on this platform. - ?line Works = try erlang:trace(all, true, [cpu_timestamp]) of - _ -> - ?line erlang:trace(all, false, [cpu_timestamp]), - true - catch - error:badarg -> false - end, - - ?line test_server:timetrap_cancel(Dog), + Works = try erlang:trace(all, true, [cpu_timestamp]) of + _ -> + erlang:trace(all, false, [cpu_timestamp]), + true + catch + error:badarg -> false + end, {comment,case Works of - false -> "cpu_timestamp is NOT implemented/does not work"; - true -> "cpu_timestamp works" - end}. + false -> "cpu_timestamp is NOT implemented/does not work"; + true -> "cpu_timestamp works" + end}. %% Tests that trace(Pid, How, ['receive']) works. receive_trace(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Receiver = fun_spawn(fun receiver/0), - ?line process_flag(trap_exit, true), + Receiver = proplists:get_value(receiver, Config), %% Trace the process; make sure that we receive the trace messages. - ?line 1 = erlang:trace(Receiver, true, ['receive']), - ?line Hello = {hello, world}, - ?line Receiver ! Hello, - ?line {trace, Receiver, 'receive', Hello} = receive_first(), - ?line Hello2 = {hello, again, world}, - ?line Receiver ! Hello2, - ?line {trace, Receiver, 'receive', Hello2} = receive_first(), - ?line receive_nothing(), + 1 = erlang:trace(Receiver, true, ['receive']), + Hello = {hello, world}, + Receiver ! Hello, + {trace, Receiver, 'receive', Hello} = receive_first_trace(), + Hello2 = {hello, again, world}, + Receiver ! Hello2, + {trace, Receiver, 'receive', Hello2} = receive_first_trace(), + receive_nothing(), + + %% Test 'receive' with matchspec + F1 = fun ({Pat, IsMatching}) -> + set_trace_pattern('receive', Pat, []), + Receiver ! Hello, + case IsMatching of + true -> + {trace, Receiver, 'receive', Hello} = receive_first_trace(); + false -> + ok + end, + receive_nothing() + end, + From = self(), + Node = node(), + lists:foreach(F1, [{no, true}, + {[{[Node, undefined,"Unexpected"],[],[]}], false}, + {[{[Node, From,'_'],[],[]}], true}, + {[{[Node, '$1','_'],[{'=/=','$1',From}],[]}], false}, + {[{['$1', '_','_'],[{'=:=','$1',Node}],[]}], true}, + {false, false}, + {true, true}]), + + %% Remote messages + OtherName = atom_to_list(?MODULE)++"_receive_trace", + {ok, OtherNode} = start_node(OtherName), + RemoteProc = spawn_link(OtherNode, ?MODULE, process, [self()]), + io:format("RemoteProc = ~p ~n", [RemoteProc]), + + RemoteProc ! {send_please, Receiver, Hello}, + {trace, Receiver, 'receive', Hello} = receive_first_trace(), + RemoteProc ! {send_please, Receiver, 99}, + {trace, Receiver, 'receive', 99} = receive_first_trace(), + + %% Remote with matchspec + F2 = fun (To, {Pat, IsMatching}) -> + set_trace_pattern('receive', Pat, []), + RemoteProc ! {send_please, To, Hello}, + case IsMatching of + true -> + {trace, Receiver, 'receive', Hello} = receive_first_trace(); + false -> + ok + end, + receive_nothing() + end, + F2(Receiver, {no, true}), + F2(Receiver, {[{[OtherNode, undefined,"Unexpected"],[],[]}], false}), + F2(Receiver, {[{[OtherNode, RemoteProc,'_'],[],[]}, + {[OtherNode, undefined,'_'],[],[]}], true}), + F2(Receiver, {[{[OtherNode, '$1','_'], + [{'orelse',{'=:=','$1',undefined},{'=/=',{node,'$1'},{node}}}], + []}], true}), + F2(Receiver, {[{['$1', '_','_'], [{'=:=','$1',OtherNode}], []}], true}), + F2(Receiver, {false, false}), + F2(Receiver, {true, true}), + + %% Remote to named with matchspec + Name = trace_SUITE_receiver, + register(Name, Receiver), + NN = {Name, node()}, + F2(NN, {no, true}), + F2(NN, {[{[OtherNode, undefined,"Unexpected"],[],[]}], false}), + F2(NN, {[{[OtherNode, RemoteProc,'_'],[],[]}, + {[OtherNode, undefined,'_'],[],[]}], true}), + F2(NN, {[{[OtherNode, '$1','_'], + [{'orelse',{'=:=','$1',undefined},{'=/=',{node,'$1'},{node}}}], + []}], true}), + F2(NN, {[{['$1', '_','_'], [{'==','$1',OtherNode}], []}], true}), + F2(NN, {false, false}), + F2(NN, {true, true}), + + unlink(RemoteProc), + true = stop_node(OtherNode), + + %% Timeout + Receiver ! {set_timeout, 10}, + {trace, Receiver, 'receive', {set_timeout, 10}} = receive_first_trace(), + {trace, Receiver, 'receive', timeout} = receive_first_trace(), + erlang:trace_pattern('receive', [{[clock_service,undefined,timeout], [], []}], []), + Receiver ! {set_timeout, 7}, + {trace, Receiver, 'receive', timeout} = receive_first_trace(), + erlang:trace_pattern('receive', true, []), %% Another process should not be able to trace Receiver. - ?line Intruder = fun_spawn(fun() -> erlang:trace(Receiver, true, ['receive']) end), - ?line {'EXIT', Intruder, {badarg, _}} = receive_first(), + process_flag(trap_exit, true), + Intruder = fun_spawn(fun() -> erlang:trace(Receiver, true, ['receive']) end), + {'EXIT', Intruder, {badarg, _}} = receive_first(), %% Untrace the process; we should not receive anything. - ?line 1 = erlang:trace(Receiver, false, ['receive']), - ?line Receiver ! {hello, there}, - ?line Receiver ! any_garbage, - ?line receive_nothing(), + 1 = erlang:trace(Receiver, false, ['receive']), + Receiver ! {hello, there}, + Receiver ! any_garbage, + receive_nothing(), + + %% Verify restrictions in matchspec for 'receive' + F3 = fun (Pat) -> {'EXIT', {badarg,_}} = (catch erlang:trace_pattern('receive', Pat, [])) end, + WC = ['_','_','_'], + F3([{WC,[],[{message, {process_dump}}]}]), + F3([{WC,[{is_seq_trace}],[]}]), + F3([{WC,[],[{set_seq_token,label,4711}]}]), + F3([{WC,[],[{get_seq_token}]}]), + F3([{WC,[],[{enable_trace,call}]}]), + F3([{WC,[],[{enable_trace,self(),call}]}]), + F3([{WC,[],[{disable_trace,call}]}]), + F3([{WC,[],[{disable_trace,self(),call}]}]), + F3([{WC,[],[{trace,[call],[]}]}]), + F3([{WC,[],[{trace,self(),[],[call]}]}]), + F3([{WC,[],[{caller}]}]), + F3([{WC,[],[{silent,true}]}]), - %% Done. - ?line test_server:timetrap_cancel(Dog), ok. -self_send(doc) -> ["Test that traces are generated for messages sent ", - "and received to/from self()."]; +%% Tests that receive of a message always happens before a call with +%% that message and that links/unlinks are ordered together with the +%% 'receive'. +link_receive_call_correlation() -> + [{timetrap, {minutes, 5}}]. +link_receive_call_correlation(Config) when is_list(Config) -> + Receiver = fun_spawn(fun F() -> + receive + stop -> ok; + M -> receive_msg(M), F() + end + end), + process_flag(trap_exit, true), + + %% Trace the process; make sure that we receive the trace messages. + 1 = erlang:trace(Receiver, true, ['receive', procs, call, timestamp, scheduler_id]), + 1 = erlang:trace_pattern({?MODULE, receive_msg, '_'}, [], [local]), + + Num = 100000, + + (fun F(0) -> []; + F(N) -> + if N rem 2 == 0 -> + link(Receiver); + true -> + unlink(Receiver) + end, + [Receiver ! N | F(N-1)] + end)(Num), + + Receiver ! stop, + MonRef = erlang:monitor(process, Receiver), + receive {'DOWN', MonRef, _, _, _} -> ok end, + Ref = erlang:trace_delivered(Receiver), + receive {trace_delivered, _, Ref} -> ok end, + + Msgs = (fun F() -> receive M -> [M | F()] after 1 -> [] end end)(), + + case check_consistent(Receiver, Num, Num, Num, Msgs) of + ok -> + ok; + {error, Reason} -> + ct:log("~p", [Msgs]), + ct:fail({error, Reason}) + end. + +-define(schedid, , _). + +check_consistent(_Pid, Recv, Call, _LU, [Msg | _]) when Recv > Call -> + {error, Msg}; +check_consistent(Pid, Recv, Call, LU, [Msg | Msgs]) -> + + case Msg of + {trace, Pid, 'receive', Recv ?schedid} -> + check_consistent(Pid,Recv - 1, Call, LU, Msgs); + {trace_ts, Pid, 'receive', Recv ?schedid, _} -> + check_consistent(Pid,Recv - 1, Call, LU, Msgs); + + {trace, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid} -> + check_consistent(Pid,Recv, Call - 1, LU, Msgs); + {trace_ts, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid, _} -> + check_consistent(Pid,Recv, Call - 1, LU, Msgs); + + %% We check that for each receive we have gotten a + %% getting_linked or getting_unlinked message. Also + %% if we receive a getting_linked, then the next + %% message we expect to receive is an even number + %% and odd number for getting_unlinked. + {trace, Pid, getting_linked, _Self ?schedid} + when Recv rem 2 == 0, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + {trace_ts, Pid, getting_linked, _Self ?schedid, _} + when Recv rem 2 == 0, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + + {trace, Pid, getting_unlinked, _Self ?schedid} + when Recv rem 2 == 1, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + {trace_ts, Pid, getting_unlinked, _Self ?schedid, _} + when Recv rem 2 == 1, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + + {trace,Pid,'receive',Ignore ?schedid} + when Ignore == stop; Ignore == timeout -> + check_consistent(Pid, Recv, Call, LU, Msgs); + {trace_ts,Pid,'receive',Ignore ?schedid,_} + when Ignore == stop; Ignore == timeout -> + check_consistent(Pid, Recv, Call, LU, Msgs); + + {trace, Pid, exit, normal ?schedid} -> + check_consistent(Pid, Recv, Call, LU, Msgs); + {trace_ts, Pid, exit, normal ?schedid, _} -> + check_consistent(Pid, Recv, Call, LU, Msgs); + {'EXIT', Pid, normal} -> + check_consistent(Pid, Recv, Call, LU, Msgs); + Msg -> + {error, Msg} + end; +check_consistent(_, 0, 0, 0, []) -> + ok; +check_consistent(_, Recv, Call, LU, []) -> + {error,{Recv, Call, LU}}. + +receive_msg(M) -> + M. + +%% Test that traces are generated for messages sent +%% and received to/from self(). self_send(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Fun = - fun(Self, Parent) -> receive - go_ahead -> - self() ! from_myself, - Self(Self, Parent); - from_myself -> - Parent ! done - end - end, - ?line Self = self(), - ?line SelfSender = fun_spawn(Fun, [Fun, Self]), - ?line erlang:trace(SelfSender, true, ['receive', 'send']), - ?line SelfSender ! go_ahead, - ?line receive {trace, SelfSender, 'receive', go_ahead} -> ok end, - ?line receive {trace, SelfSender, 'receive', from_myself} -> ok end, - ?line receive - {trace,SelfSender,send,from_myself,SelfSender} -> ok - end, - ?line receive {trace,SelfSender,send,done,Self} -> ok end, - ?line receive done -> ok end, - - ?line test_server:timetrap_cancel(Dog), + Fun = + fun(Self, Parent) -> receive + go_ahead -> + self() ! from_myself, + Self(Self, Parent); + from_myself -> + Parent ! done + end + end, + Self = self(), + SelfSender = fun_spawn(Fun, [Fun, Self]), + erlang:trace(SelfSender, true, ['receive', 'send']), + SelfSender ! go_ahead, + receive {trace, SelfSender, 'receive', go_ahead} -> ok end, + receive {trace, SelfSender, 'receive', from_myself} -> ok end, + receive + {trace,SelfSender,send,from_myself,SelfSender} -> ok + end, + receive {trace,SelfSender,send,done,Self} -> ok end, + receive done -> ok end, ok. %% Test that we can receive timeout traces. timeout_trace(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - - ?line Process = fun_spawn(fun process/0), - ?line 1 = erlang:trace(Process, true, ['receive']), - ?line Process ! timeout_please, - ?line {trace, Process, 'receive', timeout_please} = receive_first(), - ?line {trace, Process, 'receive', timeout} = receive_first(), - ?line receive_nothing(), - - ?line test_server:timetrap_cancel(Dog), + Process = fun_spawn(fun process/0), + 1 = erlang:trace(Process, true, ['receive']), + Process ! timeout_please, + {trace, Process, 'receive', timeout_please} = receive_first_trace(), + {trace, Process, 'receive', timeout} = receive_first_trace(), + receive_nothing(), ok. %% Tests that trace(Pid, How, [send]) works. send_trace(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line process_flag(trap_exit, true), - ?line Sender = fun_spawn(fun sender/0), - ?line Receiver = fun_spawn(fun receiver/0), + process_flag(trap_exit, true), + Sender = fun_spawn(fun sender/0), + Receiver = proplists:get_value(receiver, Config), %% Check that a message sent to another process is traced. - ?line 1 = erlang:trace(Sender, true, [send]), - ?line Sender ! {send_please, Receiver, to_receiver}, - ?line {trace, Sender, send, to_receiver, Receiver} = receive_first(), - ?line receive_nothing(), + 1 = erlang:trace(Sender, true, [send]), + F1 = fun (Pat) -> + set_trace_pattern(send, Pat, []), + Sender ! {send_please, Receiver, to_receiver}, + {trace, Sender, send, to_receiver, Receiver} = receive_first_trace(), + receive_nothing() + end, + lists:foreach(F1, [no, + [{[Receiver,to_receiver],[],[]}], + [{['_','_'],[],[]}], + [{['$1','_'],[{is_pid,'$1'}],[]}], + [{['_','$1'],[{is_atom,'$1'}],[]}], + true]), + + %% Test {message, Msg} + F1m = fun ({Pat, Msg}) -> + set_trace_pattern(send, Pat, []), + Sender ! {send_please, Receiver, to_receiver}, + {trace, Sender, send, to_receiver, Receiver, Msg} = receive_first_trace(), + receive_nothing() + end, + lists:foreach(F1m, [{[{['_','_'],[],[{message, 4711}]}], 4711}, + {[{['_','_'],[],[{message, "4711"}]}], "4711"} + ]), + + %% Test {message, {process_dump}} + set_trace_pattern(send, [{['_','_'],[],[{message, {process_dump}}]}], []), + Sender ! {send_please, Receiver, to_receiver}, + {trace, Sender, send, to_receiver, Receiver, ProcDump} = receive_first_trace(), + true = is_binary(ProcDump), + receive_nothing(), + + %% Same test with false match spec + F2 = fun (Pat) -> + set_trace_pattern(send, Pat, []), + Sender ! {send_please, Receiver, to_receiver}, + receive_nothing() + end, + lists:foreach(F2, [[{[Sender,to_receiver],[],[]}], + [{[Receiver,nomatch],[],[]}], + [{['$1','_'],[{is_atom,'$1'}],[]}], + [{['_','$1'],[{is_pid,'$1'}],[]}], + false, + [{['_','_'],[],[{message,false}]}], + [{['_','_'],[],[{silent,true}]}]]), + erlang:trace_pattern(send, true, []), + erlang:trace(Sender, false, [silent]), + + %% Check that a message sent to another registered process is traced. + register(?MODULE,Receiver), + F3 = fun (Pat) -> + set_trace_pattern(send, Pat, []), + Sender ! {send_please, ?MODULE, to_receiver}, + {trace, Sender, send, to_receiver, ?MODULE} = receive_first_trace(), + receive_nothing() + end, + lists:foreach(F3, [no, + [{[?MODULE,to_receiver],[],[]}], + [{['_','_'],[],[]}], + [{['$1','_'],[{is_atom,'$1'}],[]}], + [{['_','$1'],[{is_atom,'$1'}],[]}], + true]), + %% Again with false match spec + F4 = fun (Pat) -> + set_trace_pattern(send, Pat, []), + Sender ! {send_please, ?MODULE, to_receiver}, + receive_nothing() + end, + lists:foreach(F4, [[{[nomatch,to_receiver],[],[]}], + [{[?MODULE,nomatch],[],[]}], + [{['$1','_'],[{is_pid,'$1'}],[]}], + [{['_','$1'],[{is_pid,'$1'}],[]}], + [{['_','_'],[],[{message,false}]}], + [{['_','_'],[],[{silent,true}]}] + ]), + unregister(?MODULE), + erlang:trace_pattern(send, true, []), + erlang:trace(Sender, false, [silent]), %% Check that a message sent to this process is traced. - ?line Sender ! {send_please, self(), to_myself}, - ?line receive to_myself -> ok end, - ?line Self = self(), - ?line {trace, Sender, send, to_myself, Self} = receive_first(), - ?line receive_nothing(), + F5 = fun (Pat) -> + set_trace_pattern(send, Pat, []), + Sender ! {send_please, self(), to_myself}, + receive to_myself -> ok end, + Self = self(), + {trace, Sender, send, to_myself, Self} = receive_first_trace(), + receive_nothing() + end, + lists:foreach(F5, [no, + [{[self(),to_myself],[],[]}], + [{['_','_'],[],[]}], + true]), + + %% Check that a message sent to dead process is traced. + {Pid,Ref} = spawn_monitor(fun() -> ok end), + receive {'DOWN',Ref,_,_,_} -> ok end, + F6 = fun (Pat) -> + set_trace_pattern(send, Pat, []), + Sender ! {send_please, Pid, to_dead}, + {trace, Sender, send_to_non_existing_process, to_dead, Pid} = receive_first_trace(), + receive_nothing() + end, + lists:foreach(F6, [no, + [{[Pid,to_dead],[],[]}], + [{['_','_'],[],[]}], + true]), + + %% Check that a message sent to unknown registrated process is traced. + BadargSender = fun_spawn(fun sender/0), + 1 = erlang:trace(BadargSender, true, [send]), + unlink(BadargSender), + BadargSender ! {send_please, not_registered, to_unknown}, + {trace, BadargSender, send, to_unknown, not_registered} = receive_first_trace(), + receive_nothing(), %% Another process should not be able to trace Sender. - ?line Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end), - ?line {'EXIT', Intruder, {badarg, _}} = receive_first(), + Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end), + {'EXIT', Intruder, {badarg, _}} = receive_first(), %% Untrace the sender process and make sure that we receive no more %% trace messages. - ?line 1 = erlang:trace(Sender, false, [send]), - ?line Sender ! {send_please, Receiver, to_receiver}, - ?line Sender ! {send_please, self(), to_myself_again}, - ?line receive to_myself_again -> ok end, - ?line receive_nothing(), + 1 = erlang:trace(Sender, false, [send]), + Sender ! {send_please, Receiver, to_receiver}, + Sender ! {send_please, self(), to_myself_again}, + receive to_myself_again -> ok end, + receive_nothing(), + {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [global])), + {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [local])), + {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [meta])), + {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [{meta,self()}])), + {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [call_count])), + {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [call_time])), + {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, restart, [])), + {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, pause, [])), + {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, [{['_','_'],[],[{caller}]}], [])), + %% Done. - ?line test_server:timetrap_cancel(Dog), ok. +set_trace_pattern(_, no, _) -> 0; +set_trace_pattern(MFA, Pat, Flg) -> + R = erlang:trace_pattern(MFA, Pat, Flg), + {match_spec, Pat} = erlang:trace_info(MFA, match_spec), + R. + %% Test trace(Pid, How, [procs]). procs_trace(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Name = list_to_atom(atom_to_list(?MODULE)++"_procs_trace"), - ?line Self = self(), - ?line process_flag(trap_exit, true), + Name = list_to_atom(atom_to_list(?MODULE)++"_procs_trace"), + Self = self(), + process_flag(trap_exit, true), %% - ?line Proc1 = spawn_link(?MODULE, process, [Self]), - ?line io:format("Proc1 = ~p ~n", [Proc1]), - ?line Proc2 = spawn(?MODULE, process, [Self]), - ?line io:format("Proc2 = ~p ~n", [Proc2]), + Proc1 = spawn_link(?MODULE, process, [Self]), + io:format("Proc1 = ~p ~n", [Proc1]), + Proc2 = spawn(?MODULE, process, [Self]), + io:format("Proc2 = ~p ~n", [Proc2]), %% - ?line 1 = erlang:trace(Proc1, true, [procs]), - ?line MFA = {?MODULE, process, [Self]}, + 1 = erlang:trace(Proc1, true, [procs, set_on_first_spawn]), + MFA = {?MODULE, process, [Self]}, %% %% spawn, link - ?line Proc1 ! {spawn_link_please, Self, MFA}, - ?line Proc3 = receive {spawned, Proc1, P3} -> P3 end, - ?line {trace, Proc1, spawn, Proc3, MFA} = receive_first(), - ?line io:format("Proc3 = ~p ~n", [Proc3]), - ?line {trace, Proc1, link, Proc3} = receive_first(), - ?line receive_nothing(), + Proc1 ! {spawn_link_please, Self, MFA}, + Proc3 = receive {spawned, Proc1, P3} -> P3 end, + receive {trace, Proc3, spawned, Proc1, MFA} -> ok end, + receive {trace, Proc3, getting_linked, Proc1} -> ok end, + {trace, Proc1, spawn, Proc3, MFA} = receive_first_trace(), + io:format("Proc3 = ~p ~n", [Proc3]), + {trace, Proc1, link, Proc3} = receive_first_trace(), + receive_nothing(), %% %% getting_unlinked by exit() - ?line Proc1 ! {trap_exit_please, true}, - ?line Reason3 = make_ref(), - ?line Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, - ?line receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, - ?line {trace, Proc1, getting_unlinked, Proc3} = receive_first(), - ?line Proc1 ! {trap_exit_please, false}, - ?line receive_nothing(), + Proc1 ! {trap_exit_please, true}, + Reason3 = make_ref(), + Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, + receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, + receive {trace, Proc3, exit, Reason3} -> ok end, + {trace, Proc1, getting_unlinked, Proc3} = receive_first_trace(), + Proc1 ! {trap_exit_please, false}, + receive_nothing(), %% %% link - ?line Proc1 ! {link_please, Proc2}, - ?line {trace, Proc1, link, Proc2} = receive_first(), - ?line receive_nothing(), + Proc1 ! {link_please, Proc2}, + {trace, Proc1, link, Proc2} = receive_first_trace(), + receive_nothing(), %% %% unlink - ?line Proc1 ! {unlink_please, Proc2}, - ?line {trace, Proc1, unlink, Proc2} = receive_first(), - ?line receive_nothing(), + Proc1 ! {unlink_please, Proc2}, + {trace, Proc1, unlink, Proc2} = receive_first_trace(), + receive_nothing(), %% %% getting_linked - ?line Proc2 ! {link_please, Proc1}, - ?line {trace, Proc1, getting_linked, Proc2} = receive_first(), - ?line receive_nothing(), + Proc2 ! {link_please, Proc1}, + {trace, Proc1, getting_linked, Proc2} = receive_first_trace(), + receive_nothing(), %% %% getting_unlinked - ?line Proc2 ! {unlink_please, Proc1}, - ?line {trace, Proc1, getting_unlinked, Proc2} = receive_first(), - ?line receive_nothing(), + Proc2 ! {unlink_please, Proc1}, + {trace, Proc1, getting_unlinked, Proc2} = receive_first_trace(), + receive_nothing(), %% %% register - ?line true = register(Name, Proc1), - ?line {trace, Proc1, register, Name} = receive_first(), - ?line receive_nothing(), + true = register(Name, Proc1), + {trace, Proc1, register, Name} = receive_first_trace(), + receive_nothing(), %% %% unregister - ?line true = unregister(Name), - ?line {trace, Proc1, unregister, Name} = receive_first(), - ?line receive_nothing(), + true = unregister(Name), + {trace, Proc1, unregister, Name} = receive_first_trace(), + receive_nothing(), %% %% exit (with registered name, due to link) - ?line Reason4 = make_ref(), - ?line Proc1 ! {spawn_link_please, Self, MFA}, - ?line Proc4 = receive {spawned, Proc1, P4} -> P4 end, - ?line {trace, Proc1, spawn, Proc4, MFA} = receive_first(), - ?line io:format("Proc4 = ~p ~n", [Proc4]), - ?line {trace, Proc1, link, Proc4} = receive_first(), - ?line Proc1 ! {register_please, Name, Proc1}, - ?line {trace, Proc1, register, Name} = receive_first(), - ?line Proc4 ! {exit_please, Reason4}, - ?line receive {'EXIT', Proc1, Reason4} -> ok end, - ?line {trace, Proc1, exit, Reason4} = receive_first(), - ?line {trace, Proc1, unregister, Name} = receive_first(), - ?line receive_nothing(), + Reason4 = make_ref(), + Proc1 ! {spawn_link_please, Self, MFA}, + Proc4 = receive {spawned, Proc1, P4} -> P4 end, + {trace, Proc1, spawn, Proc4, MFA} = receive_first_trace(), + io:format("Proc4 = ~p ~n", [Proc4]), + {trace, Proc1, link, Proc4} = receive_first_trace(), + Proc1 ! {register_please, Name, Proc1}, + {trace, Proc1, register, Name} = receive_first_trace(), + Proc4 ! {exit_please, Reason4}, + receive {'EXIT', Proc1, Reason4} -> ok end, + {trace, Proc1, exit, Reason4} = receive_first_trace(), + {trace, Proc1, unregister, Name} = receive_first_trace(), + receive_nothing(), %% %% exit (not linked to tracing process) - ?line 1 = erlang:trace(Proc2, true, [procs]), - ?line Reason2 = make_ref(), - ?line Proc2 ! {exit_please, Reason2}, - ?line {trace, Proc2, exit, Reason2} = receive_first(), - ?line receive_nothing(), - %% - %% Done. - ?line test_server:timetrap_cancel(Dog), + 1 = erlang:trace(Proc2, true, [procs]), + Reason2 = make_ref(), + Proc2 ! {exit_please, Reason2}, + {trace, Proc2, exit, Reason2} = receive_first_trace(), + receive_nothing(), ok. dist_procs_trace(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(15)), - ?line OtherName = atom_to_list(?MODULE)++"_dist_procs_trace", - ?line {ok, OtherNode} = start_node(OtherName), - ?line Self = self(), - ?line process_flag(trap_exit, true), + ct:timetrap({seconds, 15}), + OtherName = atom_to_list(?MODULE)++"_dist_procs_trace", + {ok, OtherNode} = start_node(OtherName), + Self = self(), + process_flag(trap_exit, true), %% - ?line Proc1 = spawn_link(?MODULE, process, [Self]), - ?line io:format("Proc1 = ~p ~n", [Proc1]), - ?line Proc2 = spawn(OtherNode, ?MODULE, process, [Self]), - ?line io:format("Proc2 = ~p ~n", [Proc2]), + Proc1 = spawn_link(?MODULE, process, [Self]), + io:format("Proc1 = ~p ~n", [Proc1]), + Proc2 = spawn(OtherNode, ?MODULE, process, [Self]), + io:format("Proc2 = ~p ~n", [Proc2]), %% - ?line 1 = erlang:trace(Proc1, true, [procs]), - ?line MFA = {?MODULE, process, [Self]}, + 1 = erlang:trace(Proc1, true, [procs]), + MFA = {?MODULE, process, [Self]}, %% %% getting_unlinked by exit() - ?line Proc1 ! {spawn_link_please, Self, OtherNode, MFA}, - ?line Proc1 ! {trap_exit_please, true}, - ?line Proc3 = receive {spawned, Proc1, P3} -> P3 end, - ?line io:format("Proc3 = ~p ~n", [Proc3]), - ?line {trace, Proc1, getting_linked, Proc3} = receive_first(), - ?line Reason3 = make_ref(), - ?line Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, - ?line receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, - ?line {trace, Proc1, getting_unlinked, Proc3} = receive_first(), - ?line Proc1 ! {trap_exit_please, false}, - ?line receive_nothing(), + Proc1 ! {spawn_link_please, Self, OtherNode, MFA}, + Proc1 ! {trap_exit_please, true}, + Proc3 = receive {spawned, Proc1, P3} -> P3 end, + io:format("Proc3 = ~p ~n", [Proc3]), + {trace, Proc1, getting_linked, Proc3} = receive_first_trace(), + Reason3 = make_ref(), + Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, + receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, + {trace, Proc1, getting_unlinked, Proc3} = receive_first_trace(), + Proc1 ! {trap_exit_please, false}, + receive_nothing(), %% %% link - ?line Proc1 ! {link_please, Proc2}, - ?line {trace, Proc1, link, Proc2} = receive_first(), - ?line receive_nothing(), + Proc1 ! {link_please, Proc2}, + {trace, Proc1, link, Proc2} = receive_first_trace(), + receive_nothing(), %% %% unlink - ?line Proc1 ! {unlink_please, Proc2}, - ?line {trace, Proc1, unlink, Proc2} = receive_first(), - ?line receive_nothing(), + Proc1 ! {unlink_please, Proc2}, + {trace, Proc1, unlink, Proc2} = receive_first_trace(), + receive_nothing(), %% %% getting_linked - ?line Proc2 ! {link_please, Proc1}, - ?line {trace, Proc1, getting_linked, Proc2} = receive_first(), - ?line receive_nothing(), + Proc2 ! {link_please, Proc1}, + {trace, Proc1, getting_linked, Proc2} = receive_first_trace(), + receive_nothing(), %% %% getting_unlinked - ?line Proc2 ! {unlink_please, Proc1}, - ?line {trace, Proc1, getting_unlinked, Proc2} = receive_first(), - ?line receive_nothing(), + Proc2 ! {unlink_please, Proc1}, + {trace, Proc1, getting_unlinked, Proc2} = receive_first_trace(), + receive_nothing(), + %% %% exit (with registered name, due to link) - ?line Name = list_to_atom(OtherName), - ?line Reason2 = make_ref(), - ?line Proc1 ! {link_please, Proc2}, - ?line {trace, Proc1, link, Proc2} = receive_first(), - ?line Proc1 ! {register_please, Name, Proc1}, - ?line {trace, Proc1, register, Name} = receive_first(), - ?line Proc2 ! {exit_please, Reason2}, - ?line receive {'EXIT', Proc1, Reason2} -> ok end, - ?line {trace, Proc1, exit, Reason2} = receive_first(), - ?line {trace, Proc1, unregister, Name} = receive_first(), - ?line receive_nothing(), + Name = list_to_atom(OtherName), + Reason2 = make_ref(), + Proc1 ! {link_please, Proc2}, + {trace, Proc1, link, Proc2} = receive_first_trace(), + Proc1 ! {register_please, Name, Proc1}, + {trace, Proc1, register, Name} = receive_first_trace(), + Proc2 ! {exit_please, Reason2}, + receive {'EXIT', Proc1, Reason2} -> ok end, + {trace, Proc1, exit, Reason2} = receive_first_trace(), + {trace, Proc1, unregister, Name} = receive_first_trace(), + receive_nothing(), %% %% Done. - ?line true = stop_node(OtherNode), - ?line test_server:timetrap_cancel(Dog), + true = stop_node(OtherNode), ok. +%% Test trace(new, How, [procs]). +procs_new_trace(Config) when is_list(Config) -> + Self = self(), + process_flag(trap_exit, true), + %% + Proc1 = spawn_link(?MODULE, process, [Self]), + io:format("Proc1 = ~p ~n", [Proc1]), + %% + 0 = erlang:trace(new, true, [procs]), + + MFA = {?MODULE, process, [Self]}, + %% + %% spawn, link + Proc1 ! {spawn_link_please, Self, MFA}, + Proc3 = receive {spawned, Proc1, P3} -> P3 end, + receive {trace, Proc3, spawned, Proc1, MFA} -> ok end, + receive {trace, Proc3, getting_linked, Proc1} -> ok end, + io:format("Proc3 = ~p ~n", [Proc3]), + receive_nothing(), + %% + %% + %% exit (not linked to tracing process) + Reason1 = make_ref(), + Proc1 ! {exit_please, Reason1}, + receive {'EXIT', Proc1, Reason1} -> ok end, + {trace, Proc3, exit, Reason1} = receive_first_trace(), + receive_nothing(), + ok. %% Tests trace(Pid, How, [set_on_spawn]). set_on_spawn(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Listener = fun_spawn(fun process/0), + Listener = fun_spawn(fun process/0), %% Create and trace a process with the set_on_spawn flag. %% Make sure it is traced. - ?line Father_SOS = fun_spawn(fun process/0), - ?line 1 = erlang:trace(Father_SOS, true, [send, set_on_spawn]), - ?line true = is_send_traced(Father_SOS, Listener, sos_father), + Father_SOS = fun_spawn(fun process/0), + 1 = erlang:trace(Father_SOS, true, [send, set_on_spawn]), + true = is_send_traced(Father_SOS, Listener, sos_father), %% Have the process spawn of two children and test that they %% are traced. - ?line [Child1, Child2] = spawn_children(Father_SOS, 2), - ?line true = is_send_traced(Child1, Listener, child1), - ?line true = is_send_traced(Child2, Listener, child2), + [Child1, Child2] = spawn_children(Father_SOS, 2), + true = is_send_traced(Child1, Listener, child1), + true = is_send_traced(Child2, Listener, child2), %% Second generation. [Child11, Child12] = spawn_children(Child1, 2), - ?line true = is_send_traced(Child11, Listener, child11), - ?line true = is_send_traced(Child12, Listener, child12), - - %% Done. - ?line test_server:timetrap_cancel(Dog), + true = is_send_traced(Child11, Listener, child11), + true = is_send_traced(Child12, Listener, child12), ok. %% Tests trace(Pid, How, [set_on_first_spawn]). set_on_first_spawn(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Listener = fun_spawn(fun process/0), + ct:timetrap({seconds, 10}), + Listener = fun_spawn(fun process/0), %% Create and trace a process with the set_on_first_spawn flag. %% Make sure it is traced. - ?line Parent = fun_spawn(fun process/0), - ?line 1 = erlang:trace(Parent, true, [send, set_on_first_spawn]), - ?line is_send_traced(Parent, Listener, sos_father), + Parent = fun_spawn(fun process/0), + 1 = erlang:trace(Parent, true, [send, set_on_first_spawn]), + is_send_traced(Parent, Listener, sos_father), %% Have the process spawn off three children and test that the %% first is traced. - ?line [Child1, Child2, Child3] = spawn_children(Parent, 3), - ?line true = is_send_traced(Child1, Listener, child1), - ?line false = is_send_traced(Child2, Listener, child2), - ?line false = is_send_traced(Child3, Listener, child3), - ?line receive_nothing(), + [Child1, Child2, Child3] = spawn_children(Parent, 3), + true = is_send_traced(Child1, Listener, child1), + false = is_send_traced(Child2, Listener, child2), + false = is_send_traced(Child3, Listener, child3), + receive_nothing(), + ok. - %% Done. - ?line test_server:timetrap_cancel(Dog), +%% Tests trace(Pid, How, [set_on_link]). + +set_on_link(_Config) -> + Listener = fun_spawn(fun process/0), + + %% Create and trace a process with the set_on_link flag. + %% Make sure it is traced. + Father_SOL = fun_spawn(fun process/0), + 1 = erlang:trace(Father_SOL, true, [send, set_on_link]), + true = is_send_traced(Father_SOL, Listener, sol_father), + + %% Have the process spawn of two children and test that they + %% are traced. + [Child1, Child2] = spawn_children(Father_SOL, 2), + true = is_send_traced(Child1, Listener, child1), + true = is_send_traced(Child2, Listener, child2), + + %% Second generation. + [Child11, Child12] = spawn_children(Child1, 2), + true = is_send_traced(Child11, Listener, child11), + true = is_send_traced(Child12, Listener, child12), + ok. + +%% Tests trace(Pid, How, [set_on_first_spawn]). + +set_on_first_link(_Config) -> + ct:timetrap({seconds, 10}), + Listener = fun_spawn(fun process/0), + + %% Create and trace a process with the set_on_first_spawn flag. + %% Make sure it is traced. + Parent = fun_spawn(fun process/0), + 1 = erlang:trace(Parent, true, [send, set_on_first_link]), + is_send_traced(Parent, Listener, sol_father), + + %% Have the process spawn off three children and test that the + %% first is traced. + [Child1, Child2, Child3] = spawn_children(Parent, 3), + true = is_send_traced(Child1, Listener, child1), + false = is_send_traced(Child2, Listener, child2), + false = is_send_traced(Child3, Listener, child3), + receive_nothing(), ok. -system_monitor_args(doc) -> - ["Tests arguments to erlang:system_monitor/0-2)"]; + +%% Tests arguments to erlang:system_monitor/0,1,2 system_monitor_args(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Self = self(), + Self = self(), %% - ?line OldMonitor = erlang:system_monitor(undefined), - ?line undefined = erlang:system_monitor(Self, [{long_gc,0}]), - ?line MinT = case erlang:system_monitor() of - {Self,[{long_gc,T}]} when is_integer(T), T > 0 -> T; - Other1 -> test_server:fault(Other1) - end, - ?line {Self,[{long_gc,MinT}]} = erlang:system_monitor(), - ?line {Self,[{long_gc,MinT}]} = - erlang:system_monitor({Self,[{large_heap,0}]}), - ?line MinN = case erlang:system_monitor() of - {Self,[{large_heap,N}]} when is_integer(N), N > 0 -> N; - Other2 -> test_server:fault(Other2) - end, - ?line {Self,[{large_heap,MinN}]} = erlang:system_monitor(), - ?line {Self,[{large_heap,MinN}]} = - erlang:system_monitor(Self, [busy_port]), - ?line {Self,[busy_port]} = erlang:system_monitor(), - ?line {Self,[busy_port]} = - erlang:system_monitor({Self,[busy_dist_port]}), - ?line {Self,[busy_dist_port]} = erlang:system_monitor(), - ?line All = lists:sort([busy_port,busy_dist_port, - {long_gc,1},{large_heap,65535}]), - ?line {Self,[busy_dist_port]} = erlang:system_monitor(Self, All), - ?line {Self,A1} = erlang:system_monitor(), - ?line All = lists:sort(A1), - ?line {Self,A1} = erlang:system_monitor(Self, []), - ?line Pid = spawn(fun () -> receive {Self,die} -> exit(die) end end), - ?line Mref = erlang:monitor(process, Pid), - ?line undefined = erlang:system_monitor(Pid, All), - ?line {Pid,A2} = erlang:system_monitor(), - ?line All = lists:sort(A2), - ?line Pid ! {Self,die}, - ?line receive {'DOWN',Mref,_,_,_} -> ok end, - ?line undefined = erlang:system_monitor(OldMonitor), - ?line erlang:yield(), - ?line OldMonitor = erlang:system_monitor(), + OldMonitor = erlang:system_monitor(undefined), + undefined = erlang:system_monitor(Self, [{long_gc,0}]), + MinT = case erlang:system_monitor() of + {Self,[{long_gc,T}]} when is_integer(T), T > 0 -> T; + Other1 -> test_server:fault(Other1) + end, + {Self,[{long_gc,MinT}]} = erlang:system_monitor(), + {Self,[{long_gc,MinT}]} = + erlang:system_monitor({Self,[{large_heap,0}]}), + MinN = case erlang:system_monitor() of + {Self,[{large_heap,N}]} when is_integer(N), N > 0 -> N; + Other2 -> test_server:fault(Other2) + end, + {Self,[{large_heap,MinN}]} = erlang:system_monitor(), + {Self,[{large_heap,MinN}]} = + erlang:system_monitor(Self, [busy_port]), + {Self,[busy_port]} = erlang:system_monitor(), + {Self,[busy_port]} = + erlang:system_monitor({Self,[busy_dist_port]}), + {Self,[busy_dist_port]} = erlang:system_monitor(), + All = lists:sort([busy_port,busy_dist_port, + {long_gc,1},{large_heap,65535}]), + {Self,[busy_dist_port]} = erlang:system_monitor(Self, All), + {Self,A1} = erlang:system_monitor(), + All = lists:sort(A1), + {Self,A1} = erlang:system_monitor(Self, []), + Pid = spawn(fun () -> receive {Self,die} -> exit(die) end end), + Mref = erlang:monitor(process, Pid), + undefined = erlang:system_monitor(Pid, All), + {Pid,A2} = erlang:system_monitor(), + All = lists:sort(A2), + Pid ! {Self,die}, + receive {'DOWN',Mref,_,_,_} -> ok end, + undefined = erlang:system_monitor(OldMonitor), + erlang:yield(), + OldMonitor = erlang:system_monitor(), %% - ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor(atom)), - ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({})), - ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1})), - ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1,2,3})), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor({Self,atom})), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor(atom, atom)), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor({Self,[busy_port|busy_dist_port]})), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor(Self, [{long_gc,-1}])), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor({Self,[{long_gc,atom}]})), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor(Self,[{large_heap,-1}])), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor({Self,[{large_heap,atom}]})), - %% Done. - ?line test_server:timetrap_cancel(Dog), + {'EXIT',{badarg,_}} = (catch erlang:system_monitor(atom)), + {'EXIT',{badarg,_}} = (catch erlang:system_monitor({})), + {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1})), + {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1,2,3})), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,atom})), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor(atom, atom)), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,[busy_port|busy_dist_port]})), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor(Self, [{long_gc,-1}])), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,[{long_gc,atom}]})), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor(Self,[{large_heap,-1}])), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,[{large_heap,atom}]})), ok. -more_system_monitor_args(doc) -> - ["Tests arguments to erlang:system_monitor/0-2)"]; +%% Tests arguments to erlang:system_monitor/0,1,2 more_system_monitor_args(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - - ?line try_l(64000), - ?line try_l(16#7ffffff), - ?line try_l(16#3fffffff), - ?line try_l(16#7fffffff), - ?line try_l(16#ffffffff), - - %% Done. - ?line test_server:timetrap_cancel(Dog), + try_l(64000), + try_l(16#7ffffff), + try_l(16#3fffffff), + try_l(16#7fffffff), + try_l(16#ffffffff), ok. try_l(Val) -> @@ -500,29 +863,29 @@ try_l(Val) -> Arbitrary1 = 77777, Arbitrary2 = 88888, - ?line erlang:system_monitor(undefined), + erlang:system_monitor(undefined), - ?line undefined = erlang:system_monitor(Self, [{long_gc,Val},{large_heap,Arbitrary1}]), + undefined = erlang:system_monitor(Self, [{long_gc,Val},{large_heap,Arbitrary1}]), - ?line {Self,Comb0} = erlang:system_monitor(Self, [{long_gc,Arbitrary2},{large_heap,Val}]), - ?line [{large_heap,Arbitrary1},{long_gc,Val}] = lists:sort(Comb0), + {Self,Comb0} = erlang:system_monitor(Self, [{long_gc,Arbitrary2},{large_heap,Val}]), + [{large_heap,Arbitrary1},{long_gc,Val}] = lists:sort(Comb0), - ?line {Self,Comb1} = erlang:system_monitor(undefined), - ?line [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1). + {Self,Comb1} = erlang:system_monitor(undefined), + [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1). monitor_sys(Parent) -> receive - {monitor,Pid,long_schedule,Data} when is_pid(Pid) -> - io:format("Long schedule of ~w: ~w~n",[Pid,Data]), - Parent ! {Pid,Data}, - monitor_sys(Parent); - {monitor,Port,long_schedule,Data} when is_port(Port) -> - {name,Name} = erlang:port_info(Port,name), - io:format("Long schedule of ~w (~p): ~w~n",[Port,Name,Data]), - Parent ! {Port,Data}, - monitor_sys(Parent); - Other -> - erlang:display(Other) + {monitor,Pid,long_schedule,Data} when is_pid(Pid) -> + io:format("Long schedule of ~w: ~w~n",[Pid,Data]), + Parent ! {Pid,Data}, + monitor_sys(Parent); + {monitor,Port,long_schedule,Data} when is_port(Port) -> + {name,Name} = erlang:port_info(Port,name), + io:format("Long schedule of ~w (~p): ~w~n",[Port,Name,Data]), + Parent ! {Port,Data}, + monitor_sys(Parent); + Other -> + erlang:display(Other) end. start_monitor() -> @@ -532,18 +895,15 @@ start_monitor() -> erlang:yield(), % Need to be rescheduled for the trace to take ok. -system_monitor_long_schedule(suite) -> - []; -system_monitor_long_schedule(doc) -> - ["Tests erlang:system_monitor(Pid, [{long_schedule,Time}])"]; +%% Tests erlang:system_monitor(Pid, [{long_schedule,Time}]) system_monitor_long_schedule(Config) when is_list(Config) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), case (catch load_driver(Path, slow_drv)) of - ok -> - do_system_monitor_long_schedule(); - _Error -> - {skip, "Unable to load slow_drv (windows or no usleep()?)"} + ok -> + do_system_monitor_long_schedule(); + _Error -> + {skip, "Unable to load slow_drv (windows or no usleep()?)"} end. do_system_monitor_long_schedule() -> start_monitor(), @@ -551,18 +911,18 @@ do_system_monitor_long_schedule() -> "ok" = erlang:port_control(Port,0,[]), Self = self(), receive - {Self,L} when is_list(L) -> - ok + {Self,L} when is_list(L) -> + ok after 1000 -> - ?t:fail(no_trace_of_pid) + ct:fail(no_trace_of_pid) end, "ok" = erlang:port_control(Port,1,[]), "ok" = erlang:port_control(Port,2,[]), receive - {Port,LL} when is_list(LL) -> - ok + {Port,LL} when is_list(LL) -> + ok after 1000 -> - ?t:fail(no_trace_of_port) + ct:fail(no_trace_of_port) end, port_close(Port), erlang:system_monitor(undefined), @@ -571,214 +931,200 @@ do_system_monitor_long_schedule() -> -define(LONG_GC_SLEEP, 670). -system_monitor_long_gc_1(suite) -> - []; -system_monitor_long_gc_1(doc) -> - ["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"]; +%% Tests erlang:system_monitor(Pid, [{long_gc,Time}]) system_monitor_long_gc_1(Config) when is_list(Config) -> erts_debug:set_internal_state(available_internal_state, true), try - case erts_debug:get_internal_state(force_heap_frags) of - true -> - {skip,"emulator with FORCE_HEAP_FRAGS defined"}; - false -> - %% Add ?LONG_GC_SLEEP ms to all gc - ?line erts_debug:set_internal_state(test_long_gc_sleep, - ?LONG_GC_SLEEP), - ?line LoadFun = fun () -> - garbage_collect(), - self() - end, - ?line long_gc(LoadFun, false) - end + case erts_debug:get_internal_state(force_heap_frags) of + true -> + {skip,"emulator with FORCE_HEAP_FRAGS defined"}; + false -> + %% Add ?LONG_GC_SLEEP ms to all gc + erts_debug:set_internal_state(test_long_gc_sleep, + ?LONG_GC_SLEEP), + LoadFun = fun () -> + garbage_collect(), + self() + end, + long_gc(LoadFun, false) + end after - erts_debug:set_internal_state(test_long_gc_sleep, 0), - erts_debug:set_internal_state(available_internal_state, false) + erts_debug:set_internal_state(test_long_gc_sleep, 0), + erts_debug:set_internal_state(available_internal_state, false) end. -system_monitor_long_gc_2(suite) -> - []; -system_monitor_long_gc_2(doc) -> - ["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"]; +%% Tests erlang:system_monitor(Pid, [{long_gc,Time}]) system_monitor_long_gc_2(Config) when is_list(Config) -> erts_debug:set_internal_state(available_internal_state, true), try - case erts_debug:get_internal_state(force_heap_frags) of - true -> - {skip,"emulator with FORCE_HEAP_FRAGS defined"}; - false -> - %% Add ?LONG_GC_SLEEP ms to all gc - ?line erts_debug:set_internal_state(test_long_gc_sleep, - ?LONG_GC_SLEEP), - ?line Parent = self(), - ?line LoadFun = - fun () -> - Ref = make_ref(), - Pid = - spawn_link( - fun () -> - garbage_collect(), - Parent ! {Ref, self()} - end), - receive {Ref, Pid} -> Pid end - end, - ?line long_gc(LoadFun, true), - ?line long_gc(LoadFun, true), - ?line long_gc(LoadFun, true) - end + case erts_debug:get_internal_state(force_heap_frags) of + true -> + {skip,"emulator with FORCE_HEAP_FRAGS defined"}; + false -> + %% Add ?LONG_GC_SLEEP ms to all gc + erts_debug:set_internal_state(test_long_gc_sleep, + ?LONG_GC_SLEEP), + Parent = self(), + LoadFun = + fun () -> + Ref = make_ref(), + Pid = + spawn_link( + fun () -> + garbage_collect(), + Parent ! {Ref, self()} + end), + receive {Ref, Pid} -> Pid end + end, + long_gc(LoadFun, true), + long_gc(LoadFun, true), + long_gc(LoadFun, true) + end after - erts_debug:set_internal_state(test_long_gc_sleep, 0), - erts_debug:set_internal_state(available_internal_state, false) + erts_debug:set_internal_state(test_long_gc_sleep, 0), + erts_debug:set_internal_state(available_internal_state, false) end. long_gc(LoadFun, ExpectMonMsg) -> - ?line Self = self(), - ?line Time = 1, - ?line OldMonitor = erlang:system_monitor(Self, [{long_gc,Time}]), - ?line Pid = LoadFun(), - ?line Ref = erlang:trace_delivered(Pid), - ?line receive {trace_delivered, Pid, Ref} -> ok end, - ?line {Self,[{long_gc,Time}]} = erlang:system_monitor(OldMonitor), - ?line case {long_gc_check(Pid, Time, undefined), ExpectMonMsg} of - {ok, true} when Pid =/= Self -> - ok; - {ok, false} -> - ?line ?t:fail(unexpected_system_monitor_message_received); - {undefined, false} -> - ok; - {undefined, true} -> - ?line ?t:fail(no_system_monitor_message_received) - end. + Self = self(), + Time = 1, + OldMonitor = erlang:system_monitor(Self, [{long_gc,Time}]), + Pid = LoadFun(), + Ref = erlang:trace_delivered(Pid), + receive {trace_delivered, Pid, Ref} -> ok end, + {Self,[{long_gc,Time}]} = erlang:system_monitor(OldMonitor), + case {long_gc_check(Pid, Time, undefined), ExpectMonMsg} of + {ok, true} when Pid =/= Self -> + ok; + {ok, false} -> + ct:fail(unexpected_system_monitor_message_received); + {undefined, false} -> + ok; + {undefined, true} -> + ct:fail(no_system_monitor_message_received) + end. long_gc_check(Pid, Time, Result) -> receive - {monitor,Pid,long_gc,L} = Monitor -> - case lists:foldl( - fun (_, error) -> - error; - ({timeout,T}, N) when is_integer(T), - Time =< T, T =< 10*?LONG_GC_SLEEP -> - %% OTP-7622. The time T must be within reasonable limits - %% for the test to pass. - N-1; - ({heap_size,_}, N) -> - N-1; - ({old_heap_size,_}, N) -> - N-1; - ({stack_size,_}, N) -> - N-1; - ({mbuf_size,_}, N) -> - N-1; - ({heap_block_size,_}, N) -> - N-1; - ({old_heap_block_size,_}, N) -> - N-1; - (_, _) -> - error - end, 7, L) of - 0 -> - long_gc_check(Pid, Time, ok); - error -> - {error,Monitor} - end; - {monitor,_,long_gc,_} -> - long_gc_check(Pid, Time, Result); - Other -> - {error,Other} + {monitor,Pid,long_gc,L} = Monitor -> + case lists:foldl( + fun (_, error) -> + error; + ({timeout,T}, N) when is_integer(T), + Time =< T, T =< 10*?LONG_GC_SLEEP -> + %% OTP-7622. The time T must be within reasonable limits + %% for the test to pass. + N-1; + ({heap_size,_}, N) -> + N-1; + ({old_heap_size,_}, N) -> + N-1; + ({stack_size,_}, N) -> + N-1; + ({mbuf_size,_}, N) -> + N-1; + ({heap_block_size,_}, N) -> + N-1; + ({old_heap_block_size,_}, N) -> + N-1; + (_, _) -> + error + end, 7, L) of + 0 -> + long_gc_check(Pid, Time, ok); + error -> + {error,Monitor} + end; + {monitor,_,long_gc,_} -> + long_gc_check(Pid, Time, Result); + Other -> + {error,Other} after 0 -> - Result + Result end. -system_monitor_large_heap_1(suite) -> - []; -system_monitor_large_heap_1(doc) -> - ["Tests erlang:system_monitor(Pid, [{large_heap,Size}])"]; +%% Tests erlang:system_monitor(Pid, [{large_heap,Size}]) system_monitor_large_heap_1(Config) when is_list(Config) -> - ?line LoadFun = - fun (Size) -> - List = seq(1,2*Size), - garbage_collect(), - true = lists:prefix([1], List), - self() - end, - ?line large_heap(LoadFun, false). - -system_monitor_large_heap_2(suite) -> - []; -system_monitor_large_heap_2(doc) -> - ["Tests erlang:system_monitor(Pid, [{large_heap,Size}])"]; + LoadFun = + fun (Size) -> + List = seq(1,2*Size), + garbage_collect(), + true = lists:prefix([1], List), + self() + end, + large_heap(LoadFun, false). + +%% Tests erlang:system_monitor(Pid, [{large_heap,Size}]) system_monitor_large_heap_2(Config) when is_list(Config) -> - ?line Parent = self(), - ?line LoadFun = - fun (Size) -> - Ref = make_ref(), - Pid = - spawn_opt(fun () -> - garbage_collect(), - Parent ! {Ref, self()} - end, - [link, {min_heap_size, 2*Size}]), - receive {Ref, Pid} -> Pid end - end, - ?line large_heap(LoadFun, true). + Parent = self(), + LoadFun = + fun (Size) -> + Ref = make_ref(), + Pid = + spawn_opt(fun () -> + garbage_collect(), + Parent ! {Ref, self()} + end, + [link, {min_heap_size, 2*Size}]), + receive {Ref, Pid} -> Pid end + end, + large_heap(LoadFun, true). large_heap(LoadFun, ExpectMonMsg) -> - ?line Dog = test_server:timetrap(test_server:seconds(20)), - %% - ?line Size = 65535, - ?line Self = self(), - ?line NewMonitor = {Self,[{large_heap,Size}]}, - ?line OldMonitor = erlang:system_monitor(NewMonitor), - ?line Pid = LoadFun(Size), - ?line Ref = erlang:trace_delivered(Pid), - ?line receive {trace_delivered, Pid, Ref} -> ok end, - ?line {Self,[{large_heap,Size}]} = erlang:system_monitor(OldMonitor), - ?line case {large_heap_check(Pid, Size, undefined), ExpectMonMsg} of - {ok, true} when Pid =/= Self -> - ?line ok; - {ok, false} -> - ?line ?t:fail(unexpected_system_monitor_message_received); - {undefined, false} -> - ?line ok; - {undefined, true} -> - ?line ?t:fail(no_system_monitor_message_received) - end, + ct:timetrap({seconds, 20}), %% - ?line test_server:timetrap_cancel(Dog), + Size = 65535, + Self = self(), + NewMonitor = {Self,[{large_heap,Size}]}, + OldMonitor = erlang:system_monitor(NewMonitor), + Pid = LoadFun(Size), + Ref = erlang:trace_delivered(Pid), + receive {trace_delivered, Pid, Ref} -> ok end, + {Self,[{large_heap,Size}]} = erlang:system_monitor(OldMonitor), + case {large_heap_check(Pid, Size, undefined), ExpectMonMsg} of + {ok, true} when Pid =/= Self -> + ok; + {ok, false} -> + ct:fail(unexpected_system_monitor_message_received); + {undefined, false} -> + ok; + {undefined, true} -> + ct:fail(no_system_monitor_message_received) + end, ok. large_heap_check(Pid, Size, Result) -> receive - {monitor,Pid,large_heap,L} = Monitor -> - case lists:foldl( - fun (_, error) -> - error; - ({heap_size,_}, N) -> - N-1; - ({old_heap_size,_}, N) -> - N-1; - ({stack_size,_}, N) -> - N-1; - ({mbuf_size,_}, N) -> - N-1; - ({heap_block_size,_}, N) -> - N-1; - ({old_heap_block_size,_}, N) -> - N-1; - (_, _) -> - error - end, 6, L) of - 0 -> - large_heap_check(Pid, Size, ok); - error -> - {error,Monitor} - end; - {monitor,_,large_heap,_} -> - large_heap_check(Pid, Size, Result); - Other -> - {error,Other} + {monitor,Pid,large_heap,L} = Monitor -> + case lists:foldl( + fun (_, error) -> + error; + ({heap_size,_}, N) -> + N-1; + ({old_heap_size,_}, N) -> + N-1; + ({stack_size,_}, N) -> + N-1; + ({mbuf_size,_}, N) -> + N-1; + ({heap_block_size,_}, N) -> + N-1; + ({old_heap_block_size,_}, N) -> + N-1; + (_, _) -> + error + end, 6, L) of + 0 -> + large_heap_check(Pid, Size, ok); + error -> + {error,Monitor} + end; + {monitor,_,large_heap,_} -> + large_heap_check(Pid, Size, Result); + Other -> + {error,Other} after 0 -> - Result + Result end. seq(N, M) -> @@ -793,11 +1139,11 @@ seq(N, M, R) -> is_send_traced(Pid, Listener, Msg) -> Pid ! {send_please, Listener, Msg}, receive - Any -> - {trace, Pid, send, Msg, Listener} = Any, - true + Any -> + {trace, Pid, send, Msg, Listener} = Any, + true after 1000 -> - false + false end. %% This procedure assumes that the Parent process is send traced. @@ -811,146 +1157,131 @@ spawn_children(Parent, Number, Result) -> Self = self(), Parent ! {spawn_please, Self, fun process/0}, Child = - receive - {trace, Parent, send, {spawned, Pid}, Self} -> Pid - end, receive - {spawned, Child} -> - spawn_children(Parent, Number-1, [Child|Result]) + {trace, Parent, send, {spawned, Pid}, Self} -> Pid + end, + receive + {spawned, Child} -> + spawn_children(Parent, Number-1, [Child|Result]) end. -suspend(doc) -> "Test erlang:suspend/1 and erlang:resume/1."; +%% Test erlang:suspend/1 and erlang:resume/1. suspend(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(2)), - - ?line Worker = fun_spawn(fun worker/0), + ct:timetrap({minutes,2}), + Worker = fun_spawn(fun worker/0), %% Suspend a process and test that it is suspended. - ?line ok = do_suspend(Worker, 10000), - - %% Done. - ?line test_server:timetrap_cancel(Dog), + ok = do_suspend(Worker, 10000), ok. do_suspend(_Pid, 0) -> - ?line ok; + ok; do_suspend(Pid, N) -> %% Suspend a process and test that it is suspended. - ?line true = erlang:suspend_process(Pid), - ?line {status, suspended} = process_info(Pid, status), + true = erlang:suspend_process(Pid), + {status, suspended} = process_info(Pid, status), %% Unsuspend the process and make sure it starts working. - ?line true = erlang:resume_process(Pid), - ?line case process_info(Pid, status) of - {status, runnable} -> ?line ok; - {status, running} -> ?line ok; - {status, garbage_collecting} -> ?line ok; - ST -> ?line ?t:fail(ST) - end, - ?line erlang:yield(), - ?line do_suspend(Pid, N-1). - - - -mutual_suspend(doc) -> - []; -mutual_suspend(suite) -> - []; + true = erlang:resume_process(Pid), + case process_info(Pid, status) of + {status, runnable} -> ok; + {status, running} -> ok; + {status, garbage_collecting} -> ok; + ST -> ct:fail(ST) + end, + erlang:yield(), + do_suspend(Pid, N-1). + + + mutual_suspend(Config) when is_list(Config) -> - ?line TimeoutSecs = 5*60, - ?line Dog = test_server:timetrap(test_server:minutes(TimeoutSecs)), - ?line Parent = self(), - ?line Fun = fun () -> - receive - {go, Pid} -> - do_mutual_suspend(Pid, 100000) - end, - Parent ! {done, self()}, - receive after infinity -> ok end - end, - ?line P1 = spawn_link(Fun), - ?line P2 = spawn_link(Fun), - ?line T1 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops), - ?line T2 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops), - ?line P1 ! {go, P2}, - ?line P2 ! {go, P1}, - ?line Res1 = receive - {done, P1} -> done; - {timeout,T1,_} -> timeout - end, - ?line Res2 = receive - {done, P2} -> done; - {timeout,T2,_} -> timeout - end, - ?line P1S = process_info(P1, status), - ?line P2S = process_info(P2, status), - ?line ?t:format("P1S=~p P2S=~p", [P1S, P2S]), - ?line false = {status, suspended} == P1S, - ?line false = {status, suspended} == P2S, - ?line unlink(P1), exit(P1, bang), - ?line unlink(P2), exit(P2, bang), - ?line done = Res1, - ?line done = Res2, - %% Done. - ?line test_server:timetrap_cancel(Dog), - ?line ok. - + TimeoutSecs = 5*60, + ct:timetrap({seconds, TimeoutSecs}), + Parent = self(), + Fun = fun () -> + receive + {go, Pid} -> + do_mutual_suspend(Pid, 100000) + end, + Parent ! {done, self()}, + receive after infinity -> ok end + end, + P1 = spawn_link(Fun), + P2 = spawn_link(Fun), + T1 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops), + T2 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops), + P1 ! {go, P2}, + P2 ! {go, P1}, + Res1 = receive + {done, P1} -> done; + {timeout,T1,_} -> timeout + end, + Res2 = receive + {done, P2} -> done; + {timeout,T2,_} -> timeout + end, + P1S = process_info(P1, status), + P2S = process_info(P2, status), + io:format("P1S=~p P2S=~p", [P1S, P2S]), + false = {status, suspended} == P1S, + false = {status, suspended} == P2S, + unlink(P1), exit(P1, bang), + unlink(P2), exit(P2, bang), + done = Res1, + done = Res2, + ok. + do_mutual_suspend(_Pid, 0) -> - ?line ok; + ok; do_mutual_suspend(Pid, N) -> %% Suspend a process and test that it is suspended. - ?line true = erlang:suspend_process(Pid), - ?line {status, suspended} = process_info(Pid, status), + true = erlang:suspend_process(Pid), + {status, suspended} = process_info(Pid, status), %% Unsuspend the process. - ?line true = erlang:resume_process(Pid), - ?line do_mutual_suspend(Pid, N-1). + true = erlang:resume_process(Pid), + do_mutual_suspend(Pid, N-1). -suspend_exit(doc) -> - []; -suspend_exit(suite) -> - []; suspend_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(2)), - ?line random:seed(4711,17,4711), - ?line do_suspend_exit(5000), - ?line test_server:timetrap_cancel(Dog), - ?line ok. + ct:timetrap({minutes, 2}), + rand:seed(exsplus, {4711,17,4711}), + do_suspend_exit(5000), + ok. do_suspend_exit(0) -> - ?line ok; + ok; do_suspend_exit(N) -> - ?line Work = random:uniform(50), - ?line Parent = self(), - ?line {Suspendee, Mon2} - = spawn_monitor(fun () -> - suspend_exit_work(Work), - exit(normal) - end), - ?line {Suspender, Mon1} - = spawn_monitor( - fun () -> - suspend_exit_work(Work div 2), - Parent ! {doing_suspend, self()}, - case catch erlang:suspend_process(Suspendee) of - {'EXIT', _} -> - ok; - true -> - ?line erlang:resume_process(Suspendee) - end - end), - ?line receive - {doing_suspend, Suspender} -> - case N rem 2 of - 0 -> exit(Suspender, bang); - 1 -> ok - end - end, - ?line receive {'DOWN', Mon1, process, Suspender, _} -> ok end, - ?line receive {'DOWN', Mon2, process, Suspendee, _} -> ok end, - ?line do_suspend_exit(N-1). - - - - + Work = rand:uniform(50), + Parent = self(), + {Suspendee, Mon2} + = spawn_monitor(fun () -> + suspend_exit_work(Work), + exit(normal) + end), + {Suspender, Mon1} + = spawn_monitor( + fun () -> + suspend_exit_work(Work div 2), + Parent ! {doing_suspend, self()}, + case catch erlang:suspend_process(Suspendee) of + {'EXIT', _} -> + ok; + true -> + erlang:resume_process(Suspendee) + end + end), + receive + {doing_suspend, Suspender} -> + case N rem 2 of + 0 -> exit(Suspender, bang); + 1 -> ok + end + end, + receive {'DOWN', Mon1, process, Suspender, _} -> ok end, + receive {'DOWN', Mon2, process, Suspendee, _} -> ok end, + do_suspend_exit(N-1). + + + + suspend_exit_work(0) -> ok; suspend_exit_work(N) -> @@ -962,320 +1293,305 @@ suspend_exit_work(N) -> chk_suspended(P, Bool, Line) -> {Bool, Line} = {({status, suspended} == process_info(P, status)), Line}. -suspender_exit(doc) -> - []; -suspender_exit(suite) -> - []; suspender_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(3)), - ?line P1 = spawn_link(fun () -> receive after infinity -> ok end end), - ?line {'EXIT', _} = (catch erlang:resume_process(P1)), - ?line {P2, M2} = spawn_monitor( - fun () -> - ?CHK_SUSPENDED(P1, false), - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - erlang:suspend_process(P1), - erlang:suspend_process(P1), - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - erlang:resume_process(P1), - erlang:resume_process(P1), - erlang:resume_process(P1), - ?CHK_SUSPENDED(P1, true), - erlang:resume_process(P1), - ?CHK_SUSPENDED(P1, false), - erlang:suspend_process(P1), - erlang:suspend_process(P1), - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - exit(bang) - end), - ?line receive - {'DOWN', M2,process,P2,R2} -> - ?line bang = R2, - ?line ?CHK_SUSPENDED(P1, false) - end, - ?line Parent = self(), - ?line {P3, M3} = spawn_monitor( - fun () -> - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - Parent ! self(), - receive after infinity -> ok end - end), - ?line {P4, M4} = spawn_monitor( - fun () -> - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - Parent ! self(), - receive after infinity -> ok end - end), - ?line {P5, M5} = spawn_monitor( - fun () -> - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - Parent ! self(), - receive after infinity -> ok end - end), - ?line {P6, M6} = spawn_monitor( - fun () -> - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - Parent ! self(), - receive after infinity -> ok end - end), - ?line {P7, M7} = spawn_monitor( - fun () -> - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - Parent ! self(), - receive after infinity -> ok end - end), - ?line receive P3 -> ok end, - ?line receive P4 -> ok end, - ?line receive P5 -> ok end, - ?line receive P6 -> ok end, - ?line receive P7 -> ok end, - ?line ?CHK_SUSPENDED(P1, true), - ?line exit(P3, bang), - ?line receive - {'DOWN',M3,process,P3,R3} -> - ?line bang = R3, - ?line ?CHK_SUSPENDED(P1, true) - end, - ?line exit(P4, bang), - ?line receive - {'DOWN',M4,process,P4,R4} -> - ?line bang = R4, - ?line ?CHK_SUSPENDED(P1, true) - end, - ?line exit(P5, bang), - ?line receive - {'DOWN',M5,process,P5,R5} -> - ?line bang = R5, - ?line ?CHK_SUSPENDED(P1, true) - end, - ?line exit(P6, bang), - ?line receive - {'DOWN',M6,process,P6,R6} -> - ?line bang = R6, - ?line ?CHK_SUSPENDED(P1, true) - end, - ?line exit(P7, bang), - ?line receive - {'DOWN',M7,process,P7,R7} -> - ?line bang = R7, - ?line ?CHK_SUSPENDED(P1, false) - end, - ?line unlink(P1), - ?line exit(P1, bong), - ?line test_server:timetrap_cancel(Dog), - ?line ok. - -suspend_system_limit(doc) -> - []; -suspend_system_limit(suite) -> - []; + ct:timetrap({minutes, 3}), + P1 = spawn_link(fun () -> receive after infinity -> ok end end), + {'EXIT', _} = (catch erlang:resume_process(P1)), + {P2, M2} = spawn_monitor( + fun () -> + ?CHK_SUSPENDED(P1, false), + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + erlang:resume_process(P1), + erlang:resume_process(P1), + erlang:resume_process(P1), + ?CHK_SUSPENDED(P1, true), + erlang:resume_process(P1), + ?CHK_SUSPENDED(P1, false), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + exit(bang) + end), + receive + {'DOWN', M2,process,P2,R2} -> + bang = R2, + ?CHK_SUSPENDED(P1, false) + end, + Parent = self(), + {P3, M3} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + {P4, M4} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + {P5, M5} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + {P6, M6} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + {P7, M7} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + receive P3 -> ok end, + receive P4 -> ok end, + receive P5 -> ok end, + receive P6 -> ok end, + receive P7 -> ok end, + ?CHK_SUSPENDED(P1, true), + exit(P3, bang), + receive + {'DOWN',M3,process,P3,R3} -> + bang = R3, + ?CHK_SUSPENDED(P1, true) + end, + exit(P4, bang), + receive + {'DOWN',M4,process,P4,R4} -> + bang = R4, + ?CHK_SUSPENDED(P1, true) + end, + exit(P5, bang), + receive + {'DOWN',M5,process,P5,R5} -> + bang = R5, + ?CHK_SUSPENDED(P1, true) + end, + exit(P6, bang), + receive + {'DOWN',M6,process,P6,R6} -> + bang = R6, + ?CHK_SUSPENDED(P1, true) + end, + exit(P7, bang), + receive + {'DOWN',M7,process,P7,R7} -> + bang = R7, + ?CHK_SUSPENDED(P1, false) + end, + unlink(P1), + exit(P1, bong), + ok. + suspend_system_limit(Config) when is_list(Config) -> case os:getenv("ERL_EXTREME_TESTING") of - "true" -> - ?line Dog = test_server:timetrap(test_server:minutes(3*60)), - ?line P = spawn_link(fun () -> receive after infinity -> ok end end), - ?line suspend_until_system_limit(P), - ?line unlink(P), - ?line exit(P, bye), - ?line test_server:timetrap_cancel(Dog), - ?line ok; - _ -> - {skip, "Takes too long time for normal testing"} + "true" -> + ct:timetrap({minutes, 3*60}), + P = spawn_link(fun () -> receive after infinity -> ok end end), + suspend_until_system_limit(P), + unlink(P), + exit(P, bye), + ok; + _ -> + {skip, "Takes too long time for normal testing"} end. suspend_until_system_limit(P) -> - ?line suspend_until_system_limit(P, 0, 0). + suspend_until_system_limit(P, 0, 0). suspend_until_system_limit(P, N, M) -> NewM = case M of - 1 -> - ?line ?CHK_SUSPENDED(P, true), 2; - 1000000 -> - erlang:display(N), 1; - _ -> - M+1 - end, - ?line case catch erlang:suspend_process(P) of - true -> - suspend_until_system_limit(P, N+1, NewM); - {'EXIT', R} when R == system_limit; - element(1, R) == system_limit -> - ?line ?t:format("system limit at ~p~n", [N]), - ?line resume_from_system_limit(P, N, 0); - Error -> - ?line ?t:fail(Error) - end. + 1 -> + ?CHK_SUSPENDED(P, true), 2; + 1000000 -> + erlang:display(N), 1; + _ -> + M+1 + end, + case catch erlang:suspend_process(P) of + true -> + suspend_until_system_limit(P, N+1, NewM); + {'EXIT', R} when R == system_limit; + element(1, R) == system_limit -> + io:format("system limit at ~p~n", [N]), + resume_from_system_limit(P, N, 0); + Error -> + ct:fail(Error) + end. resume_from_system_limit(P, 0, _) -> - ?line ?CHK_SUSPENDED(P, false), - ?line {'EXIT', _} = (catch erlang:resume_process(P)), - ?line ok; + ?CHK_SUSPENDED(P, false), + {'EXIT', _} = (catch erlang:resume_process(P)), + ok; resume_from_system_limit(P, N, M) -> - ?line NewM = case M of - 1 -> - ?line ?CHK_SUSPENDED(P, true), 2; - 1000000 -> - erlang:display(N), 1; - _ -> - M+1 - end, - ?line erlang:resume_process(P), - ?line resume_from_system_limit(P, N-1, NewM). + NewM = case M of + 1 -> + ?CHK_SUSPENDED(P, true), 2; + 1000000 -> + erlang:display(N), 1; + _ -> + M+1 + end, + erlang:resume_process(P), + resume_from_system_limit(P, N-1, NewM). -record(susp_info, {async = 0, - dbl_async = 0, - synced = 0, - async_once = 0}). - -suspend_opts(doc) -> - []; -suspend_opts(suite) -> - []; + dbl_async = 0, + synced = 0, + async_once = 0}). + suspend_opts(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(3)), - ?line Self = self(), - ?line wait_for_empty_runq(10), - ?line Tok = spawn_link(fun () -> - Self ! self(), - tok_trace_loop(Self, 0, 1000000000) - end), - ?line TC = 1000, - ?line receive Tok -> ok end, - ?line SF = fun (N, #susp_info {async = A, - dbl_async = AA, - synced = S, - async_once = AO} = Acc) -> - ?line erlang:suspend_process(Tok, [asynchronous]), - ?line Res = case {suspend_count(Tok), N rem 4} of - {0, 2} -> - ?line erlang:suspend_process(Tok, - [asynchronous]), - case suspend_count(Tok) of - 2 -> - ?line erlang:resume_process(Tok), - ?line Acc#susp_info{async = A+1}; - 0 -> - ?line erlang:resume_process(Tok), - ?line Acc#susp_info{async = A+1, - dbl_async = AA+1} - end; - {0, 1} -> - ?line erlang:suspend_process(Tok, - [asynchronous, - unless_suspending]), - case suspend_count(Tok) of - 1 -> - ?line Acc#susp_info{async = A+1}; - 0 -> - ?line Acc#susp_info{async = A+1, - async_once = AO+1} - end; - {0, 0} -> - ?line erlang:suspend_process(Tok, - [unless_suspending]), - ?line 1 = suspend_count(Tok), - ?line Acc#susp_info{async = A+1, - synced = S+1}; - {0, _} -> - ?line Acc#susp_info{async = A+1}; - _ -> - Acc - end, - ?line erlang:resume_process(Tok), - ?line erlang:yield(), - ?line Res - end, - ?line SI = repeat_acc(SF, TC, #susp_info{}), - ?line erlang:suspend_process(Tok, [asynchronous]), + ct:timetrap({minutes, 3}), + Self = self(), + wait_for_empty_runq(10), + Tok = spawn_link(fun () -> + Self ! self(), + tok_trace_loop(Self, 0, 1000000000) + end), + TC = 1000, + receive Tok -> ok end, + SF = fun (N, #susp_info {async = A, + dbl_async = AA, + synced = S, + async_once = AO} = Acc) -> + erlang:suspend_process(Tok, [asynchronous]), + Res = case {suspend_count(Tok), N rem 4} of + {0, 2} -> + erlang:suspend_process(Tok, + [asynchronous]), + case suspend_count(Tok) of + 2 -> + erlang:resume_process(Tok), + Acc#susp_info{async = A+1}; + 0 -> + erlang:resume_process(Tok), + Acc#susp_info{async = A+1, + dbl_async = AA+1} + end; + {0, 1} -> + erlang:suspend_process(Tok, + [asynchronous, + unless_suspending]), + case suspend_count(Tok) of + 1 -> + Acc#susp_info{async = A+1}; + 0 -> + Acc#susp_info{async = A+1, + async_once = AO+1} + end; + {0, 0} -> + erlang:suspend_process(Tok, + [unless_suspending]), + 1 = suspend_count(Tok), + Acc#susp_info{async = A+1, + synced = S+1}; + {0, _} -> + Acc#susp_info{async = A+1}; + _ -> + Acc + end, + erlang:resume_process(Tok), + erlang:yield(), + Res + end, + SI = repeat_acc(SF, TC, #susp_info{}), + erlang:suspend_process(Tok, [asynchronous]), %% Verify that it eventually suspends - ?line WaitTime0 = 10, - ?line WaitTime1 = case {erlang:system_info(debug_compiled), - erlang:system_info(lock_checking)} of - {false, false} -> - WaitTime0; - {false, true} -> - WaitTime0*5; - _ -> - WaitTime0*10 - end, - ?line WaitTime = case {erlang:system_info(schedulers_online), - erlang:system_info(logical_processors)} of - {Schdlrs, CPUs} when is_integer(CPUs), - Schdlrs =< CPUs -> - WaitTime1; - _ -> - WaitTime1*10 - end, - ?line receive after WaitTime -> ok end, - ?line 1 = suspend_count(Tok), - ?line erlang:suspend_process(Tok, [asynchronous]), - ?line 2 = suspend_count(Tok), - ?line erlang:suspend_process(Tok, [asynchronous]), - ?line 3 = suspend_count(Tok), - ?line erlang:suspend_process(Tok), - ?line 4 = suspend_count(Tok), - ?line erlang:suspend_process(Tok), - ?line 5 = suspend_count(Tok), - ?line erlang:suspend_process(Tok, [unless_suspending]), - ?line 5 = suspend_count(Tok), - ?line erlang:suspend_process(Tok, [unless_suspending, - asynchronous]), - ?line 5 = suspend_count(Tok), - ?line erlang:resume_process(Tok), - ?line erlang:resume_process(Tok), - ?line erlang:resume_process(Tok), - ?line erlang:resume_process(Tok), - ?line 1 = suspend_count(Tok), - ?line ?t:format("Main suspends: ~p~n" - "Main async: ~p~n" - "Double async: ~p~n" - "Async once: ~p~n" - "Synced: ~p~n", - [TC, - SI#susp_info.async, - SI#susp_info.dbl_async, - SI#susp_info.async_once, - SI#susp_info.synced]), - ?line case erlang:system_info(schedulers_online) of - 1 -> - ?line ok; - _ -> - ?line true = SI#susp_info.async =/= 0 - end, - ?line unlink(Tok), - ?line exit(Tok, bang), - ?line test_server:timetrap_cancel(Dog), - ?line ok. + WaitTime0 = 10, + WaitTime1 = case {erlang:system_info(debug_compiled), + erlang:system_info(lock_checking)} of + {false, false} -> + WaitTime0; + {false, true} -> + WaitTime0*5; + _ -> + WaitTime0*10 + end, + WaitTime = case {erlang:system_info(schedulers_online), + erlang:system_info(logical_processors)} of + {Schdlrs, CPUs} when is_integer(CPUs), + Schdlrs =< CPUs -> + WaitTime1; + _ -> + WaitTime1*10 + end, + receive after WaitTime -> ok end, + 1 = suspend_count(Tok), + erlang:suspend_process(Tok, [asynchronous]), + 2 = suspend_count(Tok), + erlang:suspend_process(Tok, [asynchronous]), + 3 = suspend_count(Tok), + erlang:suspend_process(Tok), + 4 = suspend_count(Tok), + erlang:suspend_process(Tok), + 5 = suspend_count(Tok), + erlang:suspend_process(Tok, [unless_suspending]), + 5 = suspend_count(Tok), + erlang:suspend_process(Tok, [unless_suspending, + asynchronous]), + 5 = suspend_count(Tok), + erlang:resume_process(Tok), + erlang:resume_process(Tok), + erlang:resume_process(Tok), + erlang:resume_process(Tok), + 1 = suspend_count(Tok), + io:format("Main suspends: ~p~n" + "Main async: ~p~n" + "Double async: ~p~n" + "Async once: ~p~n" + "Synced: ~p~n", + [TC, + SI#susp_info.async, + SI#susp_info.dbl_async, + SI#susp_info.async_once, + SI#susp_info.synced]), + case erlang:system_info(schedulers_online) of + 1 -> + ok; + _ -> + true = SI#susp_info.async =/= 0 + end, + unlink(Tok), + exit(Tok, bang), + ok. suspend_count(Suspendee) -> suspend_count(self(), Suspendee). suspend_count(Suspender, Suspendee) -> {suspending, SList} = process_info(Suspender, suspending), - + case lists:keysearch(Suspendee, 1, SList) of - {value, {_Suspendee, 0, 0}} -> - ?line ?t:fail({bad_suspendee_list, SList}); - {value, {Suspendee, Count, 0}} when is_integer(Count), Count > 0 -> - {status, suspended} = process_info(Suspendee, status), - Count; - {value, {Suspendee, 0, Outstanding}} when is_integer(Outstanding), - Outstanding > 0 -> - 0; - false -> - 0; - Error -> - ?line ?t:fail({bad_suspendee_list, Error, SList}) + {value, {_Suspendee, 0, 0}} -> + ct:fail({bad_suspendee_list, SList}); + {value, {Suspendee, Count, 0}} when is_integer(Count), Count > 0 -> + {status, suspended} = process_info(Suspendee, status), + Count; + {value, {Suspendee, 0, Outstanding}} when is_integer(Outstanding), + Outstanding > 0 -> + 0; + false -> + 0; + Error -> + ct:fail({bad_suspendee_list, Error, SList}) end. - + repeat_acc(Fun, N, Acc) -> repeat_acc(Fun, 0, N, Acc). @@ -1283,121 +1599,158 @@ repeat_acc(_Fun, N, N, Acc) -> Acc; repeat_acc(Fun, N, M, Acc) -> repeat_acc(Fun, N+1, M, Fun(N, Acc)). - + %% Tests that waiting process can be suspended %% (bug in R2D and earlier; see OTP-1488). -suspend_waiting(doc) -> "Test that a waiting process can be suspended."; +%% Test that a waiting process can be suspended. suspend_waiting(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - - ?line Process = fun_spawn(fun process/0), - ?line receive after 1 -> ok end, - ?line true = erlang:suspend_process(Process), - ?line {status, suspended} = process_info(Process, status), - - %% Done. - ?line test_server:timetrap_cancel(Dog), + Process = fun_spawn(fun process/0), + receive after 1 -> ok end, + true = erlang:suspend_process(Process), + {status, suspended} = process_info(Process, status), ok. - -new_clear(doc) -> - "Test that erlang:trace(new, true, ...) is cleared when tracer dies."; +%% Test that erlang:trace(new, true, ...) is cleared when tracer dies. new_clear(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - - ?line Tracer = spawn(fun receiver/0), - ?line 0 = erlang:trace(new, true, [send, {tracer, Tracer}]), - ?line {flags, [send]} = erlang:trace_info(new, flags), - ?line {tracer, Tracer} = erlang:trace_info(new, tracer), - ?line Mref = erlang:monitor(process, Tracer), - ?line true = exit(Tracer, done), + Tracer = proplists:get_value(receiver, Config), + + 0 = erlang:trace(new, true, [send, {tracer, Tracer}]), + {flags, [send]} = erlang:trace_info(new, flags), + {tracer, Tracer} = erlang:trace_info(new, tracer), + Mref = erlang:monitor(process, Tracer), + true = exit(Tracer, done), receive - {'DOWN',Mref,_,_,_} -> ok + {'DOWN',Mref,_,_,_} -> ok end, - ?line {flags, []} = erlang:trace_info(new, flags), - ?line {tracer, []} = erlang:trace_info(new, tracer), - - %% Done. - ?line test_server:timetrap_cancel(Dog), - + {flags, []} = erlang:trace_info(new, flags), + {tracer, []} = erlang:trace_info(new, tracer), ok. -existing_clear(doc) -> - "Test that erlang:trace(all, false, ...) works without tracer."; +%% Test that erlang:trace(all, false, ...) works without tracer. existing_clear(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Self = self(), - - ?line Tracer = fun_spawn(fun receiver/0), - ?line N = erlang:trace(existing, true, [send, {tracer, Tracer}]), - ?line {flags, [send]} = erlang:trace_info(Self, flags), - ?line {tracer, Tracer} = erlang:trace_info(Self, tracer), - ?line M = erlang:trace(all, false, [all]), - ?line io:format("Started trace on ~p processes and stopped on ~p~n", - [N, M]), - ?line {flags, []} = erlang:trace_info(Self, flags), - ?line {tracer, []} = erlang:trace_info(Self, tracer), - ?line M = N + 1, % Since trace could not be enabled on the tracer. + Self = self(), + + Tracer = proplists:get_value(receiver, Config), + N = erlang:trace(existing, true, [send, {tracer, Tracer}]), + {flags, [send]} = erlang:trace_info(Self, flags), + {tracer, Tracer} = erlang:trace_info(Self, tracer), + M = erlang:trace(all, false, [all]), + io:format("Started trace on ~p processes and stopped on ~p~n", + [N, M]), + {flags, []} = erlang:trace_info(Self, flags), + {tracer, []} = erlang:trace_info(Self, tracer), + M = N, % Used to be N + 1, but from 19.0 the tracer is also traced - %% Done. - ?line test_server:timetrap_cancel(Dog), ok. -bad_flag(doc) -> "Test that an invalid flag cause badarg"; -bad_flag(suite) -> []; +%% Test that erlang:trace/3 can be called on processes where the +%% tracer has died. OTP-13928 +tracer_die(Config) when is_list(Config) -> + Proc = spawn_link(fun receiver/0), + + Tracer = spawn_link(fun receiver/0), + timer:sleep(1), + N = erlang:trace(existing, true, [send, {tracer, Tracer}]), + {flags, [send]} = erlang:trace_info(Proc, flags), + {tracer, Tracer} = erlang:trace_info(Proc, tracer), + unlink(Tracer), + exit(Tracer, die), + + Tracer2 = spawn_link(fun receiver/0), + timer:sleep(1), + N = erlang:trace(existing, true, [send, {tracer, Tracer2}]), + {flags, [send]} = erlang:trace_info(Proc, flags), + {tracer, Tracer2} = erlang:trace_info(Proc, tracer), + unlink(Tracer2), + exit(Tracer2, die), + + Tracer3 = spawn_link(fun receiver/0), + timer:sleep(1), + 1 = erlang:trace(Proc, true, [send, {tracer, Tracer3}]), + {flags, [send]} = erlang:trace_info(Proc, flags), + {tracer, Tracer3} = erlang:trace_info(Proc, tracer), + unlink(Tracer3), + exit(Tracer3, die), + + ok. + +%% Test that an invalid flag cause badarg bad_flag(Config) when is_list(Config) -> %% A bad flag could deadlock the SMP emulator in erts-5.5 - ?line {'EXIT', {badarg, _}} = (catch erlang:trace(new, - true, - [not_a_valid_flag])), - ?line ok. + {'EXIT', {badarg, _}} = (catch erlang:trace(new, + true, + [not_a_valid_flag])), + ok. -trace_delivered(doc) -> "Test erlang:trace_delivered/1"; -trace_delivered(suite) -> []; +%% Test erlang:trace_delivered/1 trace_delivered(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line TokLoops = 10000, - ?line Go = make_ref(), - ?line Parent = self(), - ?line Tok = spawn(fun () -> - receive Go -> gone end, - tok_trace_loop(Parent, 0, TokLoops) - end), - ?line 1 = erlang:trace(Tok, true, [procs]), - ?line Mon = erlang:monitor(process, Tok), - ?line NoOfTraceMessages = 4*TokLoops + 1, - ?line io:format("Expect a total of ~p trace messages~n", - [NoOfTraceMessages]), - ?line Tok ! Go, - ?line NoOfTraceMessages = drop_trace_until_down(Tok, Mon), - ?line receive - Msg -> - ?line ?t:fail({unexpected_message, Msg}) - after 1000 -> - ?line test_server:timetrap_cancel(Dog), - ?line ok - end. + ct:timetrap({minutes, 1}), + TokLoops = 10000, + Go = make_ref(), + Parent = self(), + Tok = spawn(fun () -> + receive Go -> gone end, + tok_trace_loop(Parent, 0, TokLoops) + end), + 1 = erlang:trace(Tok, true, [procs]), + Mon = erlang:monitor(process, Tok), + NoOfTraceMessages = 4*TokLoops + 1, + io:format("Expect a total of ~p trace messages~n", + [NoOfTraceMessages]), + Tok ! Go, + NoOfTraceMessages = drop_trace_until_down(Tok, Mon), + receive + Msg -> + ct:fail({unexpected_message, Msg}) + after 1000 -> + ok + end. + +%% This testcase checks that receive trace works on exit signal messages +%% when the sender of the exit signal is the process itself. +trap_exit_self_receive(Config) -> + Parent = self(), + Proc = spawn_link(fun() -> process(Parent) end), + + 1 = erlang:trace(Proc, true, ['receive']), + Proc ! {trap_exit_please, true}, + {trace, Proc, 'receive', {trap_exit_please, true}} = receive_first_trace(), + + %% Make the process call exit(self(), signal) + Reason1 = make_ref(), + Proc ! {exit_signal_please, Reason1}, + {trace, Proc, 'receive', {exit_signal_please, Reason1}} = receive_first_trace(), + {trace, Proc, 'receive', {'EXIT', Proc, Reason1}} = receive_first_trace(), + receive {Proc, {'EXIT', Proc, Reason1}} -> ok end, + receive_nothing(), + + unlink(Proc), + Reason2 = make_ref(), + Proc ! {exit_please, Reason2}, + {trace, Proc, 'receive', {exit_please, Reason2}} = receive_first_trace(), + receive_nothing(), + ok. drop_trace_until_down(Proc, Mon) -> drop_trace_until_down(Proc, Mon, false, 0, 0). drop_trace_until_down(Proc, Mon, TDRef, N, D) -> case receive Msg -> Msg end of - {trace_delivered, Proc, TDRef} -> - io:format("~p trace messages on 'DOWN'~n", [D]), - io:format("Got a total of ~p trace messages~n", [N]), - N; - {'DOWN', Mon, process, Proc, _} -> - Ref = erlang:trace_delivered(Proc), - drop_trace_until_down(Proc, Mon, Ref, N, N); - Trace when is_tuple(Trace), - element(1, Trace) == trace, - element(2, Trace) == Proc -> - drop_trace_until_down(Proc, Mon, TDRef, N+1, D) + {trace_delivered, Proc, TDRef} -> + io:format("~p trace messages on 'DOWN'~n", [D]), + io:format("Got a total of ~p trace messages~n", [N]), + N; + {'DOWN', Mon, process, Proc, _} -> + Ref = erlang:trace_delivered(Proc), + drop_trace_until_down(Proc, Mon, Ref, N, N); + Trace when is_tuple(Trace), + element(1, Trace) == trace, + element(2, Trace) == Proc -> + drop_trace_until_down(Proc, Mon, TDRef, N+1, D) end. tok_trace_loop(_, N, N) -> @@ -1414,16 +1767,23 @@ tok_trace_loop(Parent, N, M) -> receive_first() -> receive - Any -> Any + Any -> Any + end. + +%% Waits for and returns the first message in the message queue. + +receive_first_trace() -> + receive + Any when element(1,Any) =:= trace; element(1,Any) =:= trace_ts -> Any end. %% Ensures that there is no message in the message queue. receive_nothing() -> receive - Any -> - test_server:fail({unexpected_message, Any}) - after 200 -> + Any -> + ct:fail({unexpected_message, Any}) + after 100 -> ok end. @@ -1432,39 +1792,42 @@ receive_nothing() -> process(Dest) -> receive - {send_please, To, What} -> - To ! What, - process(Dest); - {spawn_link_please, ReplyTo, {M, F, A}} -> - Pid = spawn_link(M, F, A), - ReplyTo ! {spawned, self(), Pid}, - process(Dest); - {spawn_link_please, ReplyTo, Node, {M, F, A}} -> - Pid = spawn_link(Node, M, F, A), - ReplyTo ! {spawned, self(), Pid}, - process(Dest); - {link_please, Pid} -> - link(Pid), - process(Dest); - {unlink_please, Pid} -> - unlink(Pid), - process(Dest); - {register_please, Name, Pid} -> - register(Name, Pid), - process(Dest); - {unregister_please, Name} -> - unregister(Name), - process(Dest); - {exit_please, Reason} -> - exit(Reason); - {trap_exit_please, State} -> - process_flag(trap_exit, State), - process(Dest); - Other -> - Dest ! {self(), Other}, - process(Dest) + {send_please, To, What} -> + To ! What, + process(Dest); + {spawn_link_please, ReplyTo, {M, F, A}} -> + Pid = spawn_link(M, F, A), + ReplyTo ! {spawned, self(), Pid}, + process(Dest); + {spawn_link_please, ReplyTo, Node, {M, F, A}} -> + Pid = spawn_link(Node, M, F, A), + ReplyTo ! {spawned, self(), Pid}, + process(Dest); + {link_please, Pid} -> + link(Pid), + process(Dest); + {unlink_please, Pid} -> + unlink(Pid), + process(Dest); + {register_please, Name, Pid} -> + register(Name, Pid), + process(Dest); + {unregister_please, Name} -> + unregister(Name), + process(Dest); + {exit_please, Reason} -> + exit(Reason); + {exit_signal_please, Reason} -> + exit(self(), Reason), + process(Dest); + {trap_exit_please, State} -> + process_flag(trap_exit, State), + process(Dest); + Other -> + Dest ! {self(), Other}, + process(Dest) after 3000 -> - exit(timeout) + exit(timeout) end. @@ -1472,17 +1835,17 @@ process(Dest) -> process() -> receive - {spawn_please, ReplyTo, Fun} -> - Pid = fun_spawn(Fun), - ReplyTo ! {spawned, Pid}, - process(); - {send_please, To, What} -> - To ! What, - process(); - timeout_please -> - receive after 1 -> process() end; - _Other -> - process() + {spawn_please, ReplyTo, Fun} -> + Pid = fun_spawn(Fun), + ReplyTo ! {spawned, Pid}, + process(); + {send_please, To, What} -> + To ! What, + process(); + timeout_please -> + receive after 1 -> process() end; + _Other -> + process() end. @@ -1490,18 +1853,23 @@ process() -> sender() -> receive - {send_please, To, What} -> - To ! What, - sender() + {send_please, To, What} -> + To ! What, + sender() end. %% Just consumes messages from its message queue. receiver() -> - receive - _Any -> receiver() - end. + receiver(infinity). + +receiver(Timeout) -> + receiver(receive + {set_timeout, NewTimeout} -> NewTimeout; + _Any -> Timeout + after Timeout -> infinity %% reset + end). %% Works as long as it receives CPU time. Will always be RUNNABLE. @@ -1521,8 +1889,8 @@ fun_spawn(Fun, Args) -> start_node(Name) -> Pa = filename:dirname(code:which(?MODULE)), Cookie = atom_to_list(erlang:get_cookie()), - test_server:start_node(Name, slave, - [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). + test_server:start_node(Name, slave, + [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). stop_node(Node) -> test_server:stop_node(Node). @@ -1530,11 +1898,11 @@ stop_node(Node) -> wait_for_empty_runq(DeadLine) -> case statistics(run_queue) of - 0 -> true; - RQLen -> - erlang:display("Waiting for empty run queue"), - MSDL = DeadLine*1000, - wait_for_empty_runq(MSDL, MSDL, RQLen) + 0 -> true; + RQLen -> + erlang:display("Waiting for empty run queue"), + MSDL = DeadLine*1000, + wait_for_empty_runq(MSDL, MSDL, RQLen) end. wait_for_empty_runq(DeadLine, Left, RQLen) when Left =< 0 -> @@ -1545,48 +1913,48 @@ wait_for_empty_runq(DeadLine, Left, _RQLen) -> UntilDeadLine = Left - Wait, receive after Wait -> ok end, case statistics(run_queue) of - 0 -> - erlang:display("Waited for " - ++ integer_to_list(DeadLine - - UntilDeadLine) - ++ " ms for empty run queue."), - true; - NewRQLen -> - wait_for_empty_runq(DeadLine, - UntilDeadLine, - NewRQLen) + 0 -> + erlang:display("Waited for " + ++ integer_to_list(DeadLine + - UntilDeadLine) + ++ " ms for empty run queue."), + true; + NewRQLen -> + wait_for_empty_runq(DeadLine, + UntilDeadLine, + NewRQLen) end. issue_non_empty_runq_warning(DeadLine, RQLen) -> PIs = lists:foldl( - fun (P, Acc) -> - case process_info(P, - [status, - initial_call, - current_function, - registered_name, - reductions, - message_queue_len]) of - [{status, Runnable} | _] = PI when Runnable /= waiting, - Runnable /= suspended -> - [[{pid, P} | PI] | Acc]; - _ -> - Acc - end - end, - [], - processes()), - ?t:format("WARNING: Unexpected runnable processes in system (waited ~p sec).~n" - " Run queue length: ~p~n" - " Self: ~p~n" - " Processes info: ~p~n", - [DeadLine div 1000, RQLen, self(), PIs]), + fun (P, Acc) -> + case process_info(P, + [status, + initial_call, + current_function, + registered_name, + reductions, + message_queue_len]) of + [{status, Runnable} | _] = PI when Runnable /= waiting, + Runnable /= suspended -> + [[{pid, P} | PI] | Acc]; + _ -> + Acc + end + end, + [], + processes()), + io:format("WARNING: Unexpected runnable processes in system (waited ~p sec).~n" + " Run queue length: ~p~n" + " Self: ~p~n" + " Processes info: ~p~n", + [DeadLine div 1000, RQLen, self(), PIs]), receive after 1000 -> ok end. load_driver(Dir, Driver) -> case erl_ddll:load_driver(Dir, Driver) of - ok -> ok; - {error, Error} = Res -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - Res + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res end. diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index 2c78aa394f..f12c359874 100644 --- a/erts/emulator/test/trace_bif_SUITE.erl +++ b/erts/emulator/test/trace_bif_SUITE.erl @@ -1,28 +1,28 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2011. All Rights Reserved. +%% Copyright Ericsson AB 1998-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(trace_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0]). -export([trace_bif/1, trace_bif_timestamp/1, trace_on_and_off/1, trace_bif_local/1, trace_bif_timestamp_local/1, trace_bif_return/1, not_run/1, @@ -41,248 +41,315 @@ all() -> trace_bif_return, trace_info_old_code] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -trace_on_and_off(doc) -> - "Tests switching tracing on and off."; +%% Tests switching tracing on and off. trace_on_and_off(Config) when is_list(Config) -> - ?line Pid = spawn(?MODULE, bif_process, []), - ?line Self = self(), - ?line 1 = erlang:trace(Pid, true, [call,timestamp]), - ?line {flags,[timestamp,call]} = erlang:trace_info(Pid,flags), - ?line {tracer, Self} = erlang:trace_info(Pid,tracer), - ?line 1 = erlang:trace(Pid, false, [timestamp]), - ?line {flags,[call]} = erlang:trace_info(Pid,flags), - ?line {tracer, Self} = erlang:trace_info(Pid,tracer), - ?line 1 = erlang:trace(Pid, false, [call]), - ?line {flags,[]} = erlang:trace_info(Pid,flags), - ?line {tracer, []} = erlang:trace_info(Pid,tracer), - ?line exit(Pid,kill), + Pid = spawn_link(?MODULE, bif_process, []), + Self = self(), + 1 = erlang:trace(Pid, true, [call,timestamp]), + {flags, Flags} = erlang:trace_info(Pid,flags), + [call,timestamp] = lists:sort(Flags), + {tracer, Self} = erlang:trace_info(Pid,tracer), + 1 = erlang:trace(Pid, false, [timestamp]), + {flags,[call]} = erlang:trace_info(Pid,flags), + {tracer, Self} = erlang:trace_info(Pid,tracer), + 1 = erlang:trace(Pid, false, [call]), + {flags,[]} = erlang:trace_info(Pid,flags), + {tracer, []} = erlang:trace_info(Pid,tracer), + unlink(Pid), + exit(Pid,kill), ok. -trace_bif(doc) -> "Test tracing BIFs."; +%% Test tracing BIFs. trace_bif(Config) when is_list(Config) -> do_trace_bif([]). -trace_bif_local(doc) -> "Test tracing BIFs with local flag."; +%% Test tracing BIFs with local flag. trace_bif_local(Config) when is_list(Config) -> do_trace_bif([local]). do_trace_bif(Flags) -> - ?line Pid = spawn(?MODULE, bif_process, []), - ?line 1 = erlang:trace(Pid, true, [call]), - ?line erlang:trace_pattern({erlang,'_','_'}, [], Flags), - ?line Pid ! {do_bif, time, []}, - ?line receive_trace_msg({trace,Pid,call,{erlang,time, []}}), - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), - - ?line Pid ! {do_time_bif}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,time, []}}), - - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), - - ?line 1 = erlang:trace(Pid, false, [call]), - ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags), - ?line exit(Pid, die), + Pid = spawn_link(?MODULE, bif_process, []), + 1 = erlang:trace(Pid, true, [call]), + erlang:trace_pattern({erlang,'_','_'}, [], Flags), + Pid ! {do_bif, time, []}, + receive_trace_msg({trace,Pid,call,{erlang,time, []}}), + Pid ! {do_bif, statistics, [runtime]}, + receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), + + Pid ! {do_time_bif}, + receive_trace_msg({trace,Pid,call, + {erlang,time, []}}), + + Pid ! {do_statistics_bif}, + receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), + + 1 = erlang:trace(Pid, false, [call]), + erlang:trace_pattern({erlang,'_','_'}, false, Flags), + unlink(Pid), + exit(Pid, die), ok. -trace_bif_timestamp(doc) -> "Test tracing BIFs with timestamps."; +%% Test tracing BIFs with timestamps. trace_bif_timestamp(Config) when is_list(Config) -> - do_trace_bif_timestamp([]). - -trace_bif_timestamp_local(doc) -> - "Test tracing BIFs with timestamps and local flag."; + do_trace_bif_timestamp([], timestamp, [timestamp]), + do_trace_bif_timestamp([], timestamp, + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), + do_trace_bif_timestamp([], strict_monotonic_timestamp, + [strict_monotonic_timestamp]), + do_trace_bif_timestamp([], strict_monotonic_timestamp, + [monotonic_timestamp, strict_monotonic_timestamp]), + do_trace_bif_timestamp([], monotonic_timestamp, [monotonic_timestamp]). + +%% Test tracing BIFs with timestamps and local flag. trace_bif_timestamp_local(Config) when is_list(Config) -> - do_trace_bif_timestamp([local]). - -do_trace_bif_timestamp(Flags) -> - ?line Pid=spawn(?MODULE, bif_process, []), - ?line 1 = erlang:trace(Pid, true, [call,timestamp]), - ?line erlang:trace_pattern({erlang,'_','_'}, [], Flags), - - ?line Pid ! {do_bif, time, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}), - - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), - - ?line Pid ! {do_time_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,time, []}}), - - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), + do_trace_bif_timestamp([local], timestamp, [timestamp]), + do_trace_bif_timestamp([local], timestamp, + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), + do_trace_bif_timestamp([local], strict_monotonic_timestamp, + [strict_monotonic_timestamp]), + do_trace_bif_timestamp([local], strict_monotonic_timestamp, + [monotonic_timestamp, strict_monotonic_timestamp]), + do_trace_bif_timestamp([local], monotonic_timestamp, [monotonic_timestamp]). + +do_trace_bif_timestamp(Flags, TsType, TsFlags) -> + io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]), + Pid = spawn_link(?MODULE, bif_process, []), + 1 = erlang:trace(Pid, true, [call]++TsFlags), + erlang:trace_pattern({erlang,'_','_'}, [], Flags), + + Ts0 = make_ts(TsType), + Pid ! {do_bif, time, []}, + Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}, + Ts0,TsType), + + Pid ! {do_bif, statistics, [runtime]}, + Ts2 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts1, TsType), + + Pid ! {do_time_bif}, + Ts3 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,time, []}}, + Ts2, TsType), + + Pid ! {do_statistics_bif}, + Ts4 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts3, TsType), + + check_ts(TsType, Ts4, make_ts(TsType)), %% We should be able to turn off the timestamp. - ?line 1 = erlang:trace(Pid, false, [timestamp]), + 1 = erlang:trace(Pid, false, TsFlags), - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), + Pid ! {do_statistics_bif}, + receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), + Pid ! {do_bif, statistics, [runtime]}, + receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), - ?line 1 = erlang:trace(Pid, false, [call]), - ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags), + 1 = erlang:trace(Pid, false, [call]), + erlang:trace_pattern({erlang,'_','_'}, false, Flags), - ?line exit(Pid, die), + unlink(Pid), + exit(Pid, die), ok. -trace_bif_return(doc) -> - "Test tracing BIF's with return/return_to trace."; +%% Test tracing BIF's with return/return_to trace. trace_bif_return(Config) when is_list(Config) -> - ?line Pid=spawn(?MODULE, bif_process, []), - ?line 1 = erlang:trace(Pid, true, [call,timestamp,return_to]), - ?line erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], - [local]), - - - ?line Pid ! {do_bif, time, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,time,0}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), - - - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,statistics,1}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), - - - ?line Pid ! {do_time_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,time, []}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,time,0}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), - - - - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,statistics,1}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), + do_trace_bif_return(timestamp, [timestamp]), + do_trace_bif_return(timestamp, + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), + do_trace_bif_return(strict_monotonic_timestamp, + [strict_monotonic_timestamp]), + do_trace_bif_return(strict_monotonic_timestamp, + [monotonic_timestamp, strict_monotonic_timestamp]), + do_trace_bif_return(monotonic_timestamp, [monotonic_timestamp]). + +do_trace_bif_return(TsType, TsFlags) -> + io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]), + Pid = spawn_link(?MODULE, bif_process, []), + 1 = erlang:trace(Pid, true, [call,return_to]++TsFlags), + erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], + [local]), + + Ts0 = make_ts(TsType), + Pid ! {do_bif, time, []}, + Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}, + Ts0, TsType), + Ts2 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,time,0}}, + Ts1, TsType), + Ts3 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts2, TsType), + + + Pid ! {do_bif, statistics, [runtime]}, + Ts4 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts3, TsType), + Ts5 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,statistics,1}}, + Ts4, TsType), + Ts6 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts5, TsType), + + + Pid ! {do_time_bif}, + Ts7 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,time, []}}, + Ts6, TsType), + Ts8 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,time,0}}, + Ts7, TsType), + Ts9 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts8, TsType), + + + + Pid ! {do_statistics_bif}, + Ts10 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts9, TsType), + Ts11 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,statistics,1}}, + Ts10, TsType), + Ts12 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts11, TsType), + check_ts(TsType, Ts12, make_ts(TsType)), + erlang:trace_pattern({erlang,'_','_'}, false, [local]), ok. - - + + receive_trace_msg(Mess) -> receive - Mess -> - ok; - Other -> - io:format("Expected: ~p,~nGot: ~p~n", [Mess, Other]), - ?t:fail() + Mess -> + ok; + Other -> + ct:fail("Expected: ~p,~nGot: ~p~n", [Mess, Other]) after 5000 -> - io:format("Expected: ~p,~nGot: timeout~n", [Mess]), - ?t:fail() + ct:fail("Expected: ~p,~nGot: timeout~n", [Mess]) end. -receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}) -> +receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, call, {erlang, F, A}, _Ts} -> - ok; - Other -> - io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" - "Got: ~p~n", - [Pid, erlang, F, A, Other]), - ?t:fail() - after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + {trace_ts, Pid, call, {erlang, F, A}, Ts} = M -> + io:format("~p (PrevTs: ~p)~n",[M, PrevTs]), + check_ts(TsType, PrevTs, Ts), + Ts; + Other -> + ct:fail("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", + [Pid, erlang, F, A, Other]) + after 5000 -> + ct:fail("Got timeout~n", []) end. -receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}) -> +receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, return_from, {erlang, F, A}, _Value, _Ts} -> - ok; - Other -> - io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" - "Got: ~p~n", - [Pid, erlang, F, A, Other]), - ?t:fail() - after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + {trace_ts, Pid, return_from, {erlang, F, A}, _Value, Ts} = M -> + io:format("~p (PrevTs: ~p)~n",[M, PrevTs]), + check_ts(TsType, PrevTs, Ts), + Ts; + Other -> + ct:fail("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" + "Got: ~p~n", [Pid, erlang, F, A, Other]) + after 5000 -> + ct:fail("Got timeout~n", []) end. -receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) -> +receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, return_to, {M, F, A}, _Ts} -> - ok; - Other -> - io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" - "Got: ~p~n", - [Pid, M, F, A, Other]), - ?t:fail() - after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + {trace_ts, Pid, return_to, {M, F, A}, Ts} = Msg -> + io:format("~p (PrevTs: ~p)~n",[Msg, PrevTs]), + check_ts(TsType, PrevTs, Ts), + Ts; + Other -> + ct:fail("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", [Pid, M, F, A, Other]) + after 5000 -> + ct:fail("Got timeout~n", []) end. +make_ts(timestamp) -> + erlang:now(); +make_ts(monotonic_timestamp) -> + erlang:monotonic_time(nanosecond); +make_ts(strict_monotonic_timestamp) -> + MT = erlang:monotonic_time(nanosecond), + UMI = erlang:unique_integer([monotonic]), + {MT, UMI}. + +check_ts(timestamp, PrevTs, Ts) -> + {Ms, S, Us} = Ts, + true = is_integer(Ms), + true = is_integer(S), + true = is_integer(Us), + true = PrevTs < Ts, + Ts; +check_ts(monotonic_timestamp, PrevTs, Ts) -> + true = is_integer(Ts), + true = PrevTs =< Ts, + Ts; +check_ts(strict_monotonic_timestamp, PrevTs, Ts) -> + {MT, UMI} = Ts, + true = is_integer(MT), + true = is_integer(UMI), + true = PrevTs < Ts, + Ts. + bif_process() -> receive - {do_bif, Name, Args} -> - apply(erlang, Name, Args), - bif_process(); - {do_time_bif} -> - _ = time(), %Assignment tells compiler to keep call. - bif_process(); - {do_statistics_bif} -> - statistics(runtime), - bif_process(); - _Stuff -> - bif_process() + {do_bif, Name, Args} -> + apply(erlang, Name, Args), + bif_process(); + {do_time_bif} -> + %% Match the return value to ensure that the time() call + %% is not optimized away. + {_,_,_} = time(), + bif_process(); + {do_statistics_bif} -> + statistics(runtime), + bif_process(); + _Stuff -> + bif_process() end. - -trace_info_old_code(doc) -> "trace_info on deleted module (OTP-5057)."; + +%% trace_info on deleted module (OTP-5057). trace_info_old_code(Config) when is_list(Config) -> - ?line MFA = {M,F,0} = {test,foo,0}, - ?line Fname = atom_to_list(M)++".erl", - ?line AbsForms = - [{attribute,1,module,M}, % -module(M). - {attribute,2,export,[{F,0}]}, % -export([F/0]). - {function,3,F,0, % F() -> - [{clause,4,[],[],[{atom,4,F}]}]}], % F. + MFA = {M,F,0} = {test,foo,0}, + Fname = atom_to_list(M)++".erl", + AbsForms = + [{attribute,a(1),module,M}, % -module(M). + {attribute,a(2),export,[{F,0}]}, % -export([F/0]). + {function,a(3),F,0, % F() -> + [{clause,a(4),[],[],[{atom,a(4),F}]}]}], % F. %% - ?line {ok,M,Mbin} = compile:forms(AbsForms), - ?line {module,M} = code:load_binary(M, Fname, Mbin), - ?line true = erlang:delete_module(M), - ?line {traced,undefined} = erlang:trace_info(MFA, traced), + {ok,M,Mbin} = compile:forms(AbsForms), + {module,M} = code:load_binary(M, Fname, Mbin), + true = erlang:delete_module(M), + {traced,undefined} = erlang:trace_info(MFA, traced), ok. + +a(L) -> + erl_anno:new(L). diff --git a/erts/emulator/test/trace_call_count_SUITE.erl b/erts/emulator/test/trace_call_count_SUITE.erl index 2ac58493ff..5f871835bc 100644 --- a/erts/emulator/test/trace_call_count_SUITE.erl +++ b/erts/emulator/test/trace_call_count_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -42,7 +43,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). @@ -69,18 +70,17 @@ config(priv_dir,_) -> pause_and_restart/1, combo/1]). init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:seconds(30)), - [{watchdog, Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> +end_per_testcase(_Case, _Config) -> erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]), erlang:trace_pattern(on_load, false, [local,meta,call_count]), erlang:trace(all, false, [all]), - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> case test_server:is_native(trace_call_count_SUITE) of @@ -108,38 +108,23 @@ end_per_group(_GroupName, Config) -> not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -basic(suite) -> - []; -basic(doc) -> - ["Tests basic call count trace"]; +%% Tests basic call count trace basic(Config) when is_list(Config) -> basic_test(). -on_and_off(suite) -> - []; -on_and_off(doc) -> - ["Tests turning trace parameters on and off"]; +%% Tests turning trace parameters on and off on_and_off(Config) when is_list(Config) -> on_and_off_test(). -info(suite) -> - []; -info(doc) -> - ["Tests the trace_info BIF"]; +%% Tests the trace_info BIF info(Config) when is_list(Config) -> info_test(). -pause_and_restart(suite) -> - []; -pause_and_restart(doc) -> - ["Tests pausing and restarting call counters"]; +%% Tests pausing and restarting call counters pause_and_restart(Config) when is_list(Config) -> pause_and_restart_test(). -combo(suite) -> - []; -combo(doc) -> - ["Tests combining local call trace and meta trace with call count trace"]; +%% Tests combining local call trace and meta trace with call count trace combo(Config) when is_list(Config) -> combo_test(). @@ -160,168 +145,168 @@ combo(Config) when is_list(Config) -> %%% basic_test() -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), - ?line M = 1000, + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + M = 1000, %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq_r,3}, call_count), - ?line Lr = seq_r(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count), - ?line L = lists:reverse(Lr), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + {call_count,0} = erlang:trace_info({?MODULE,seq_r,3}, call_count), + Lr = seq_r(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count), + {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + L = lists:reverse(Lr), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% on_and_off_test() -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), - ?line M = 100, + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + M = 100, %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_count]), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line P = erlang:trace_pattern({'_','_','_'}, true, [call_count]), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]), - ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq_r,4}, call_count), - ?line Lr = seq_r(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count), - ?line N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_count]), - ?line {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count), - ?line Lr = seq_r(1, M, fun(X) -> X+1 end), - ?line {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count), - ?line L = lists:reverse(Lr), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_count]), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + P = erlang:trace_pattern({'_','_','_'}, true, [call_count]), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]), + {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), + {call_count,0} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + Lr = seq_r(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_count]), + {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + Lr = seq_r(1, M, fun(X) -> X+1 end), + {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + L = lists:reverse(Lr), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% info_test() -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_count]), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all), - ?line {value,{call_count,0}} = lists:keysearch(call_count, 1, L), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]), - ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line {all,false} = erlang:trace_info({?MODULE,seq,3}, all), + 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_count]), + {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]), + {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all), + {value,{call_count,0}} = lists:keysearch(call_count, 1, L), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]), + {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]), + {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), + {all,false} = erlang:trace_info({?MODULE,seq,3}, all), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pause_and_restart_test() -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), - ?line M = 100, + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + M = 100, %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), + {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]), + {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% combo_test() -> - ?line Self = self(), - - ?line MetaMatchSpec = [{'_',[],[{return_trace}]}], - ?line Flags = lists:sort([call, return_to]), - ?line LocalTracer = spawn_link(fun () -> relay_n(5, Self) end), - ?line MetaTracer = spawn_link(fun () -> relay_n(9, Self) end), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, - MetaMatchSpec, - [{meta,MetaTracer}, call_count]), - ?line 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]), + Self = self(), + + MetaMatchSpec = [{'_',[],[{return_trace}]}], + Flags = lists:sort([call, return_to]), + LocalTracer = spawn_link(fun () -> relay_n(5, Self) end), + MetaTracer = spawn_link(fun () -> relay_n(9, Self) end), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, + MetaMatchSpec, + [{meta,MetaTracer}, call_count]), + 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,MetaMatchSpec} = - erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec), - ?line {call_count,0} = - erlang:trace_info({?MODULE,seq_r,3}, call_count), + {traced,local} = + erlang:trace_info({?MODULE,seq_r,3}, traced), + {match_spec,[]} = + erlang:trace_info({?MODULE,seq_r,3}, match_spec), + {meta,MetaTracer} = + erlang:trace_info({?MODULE,seq_r,3}, meta), + {meta_match_spec,MetaMatchSpec} = + erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec), + {call_count,0} = + erlang:trace_info({?MODULE,seq_r,3}, call_count), %% - ?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,MetaMatchSpec}} = - lists:keysearch(meta_match_spec, 1, TraceInfo), - ?line {value,{call_count,0}} = - lists:keysearch(call_count, 1, TraceInfo), + {all,[_|_]=TraceInfo} = + erlang:trace_info({?MODULE,seq_r,3}, all), + {value,{traced,local}} = + lists:keysearch(traced, 1, TraceInfo), + {value,{match_spec,[]}} = + lists:keysearch(match_spec, 1, TraceInfo), + {value,{meta,MetaTracer}} = + lists:keysearch(meta, 1, TraceInfo), + {value,{meta_match_spec,MetaMatchSpec}} = + lists:keysearch(meta_match_spec, 1, TraceInfo), + {value,{call_count,0}} = + lists:keysearch(call_count, 1, TraceInfo), %% - ?line [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), + [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), %% - ?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])] = 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_test,0})] = Local, - ?line {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count), - ?line {call_count,3} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + List = collect(100), + {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), + Meta = lists:reverse(MetaR), + Local = lists:reverse(LocalR), + [?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])] = Meta, + [?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_test,0})] = Local, + {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count), + {call_count,3} = erlang:trace_info({?MODULE,seq_r,4}, call_count), %% - ?line erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]), - ?line erlang:trace_pattern(on_load, false, [local,meta,call_count]), - ?line erlang:trace(all, false, [all]), + erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]), + erlang:trace_pattern(on_load, false, [local,meta,call_count]), + erlang:trace(all, false, [all]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -351,8 +336,8 @@ relay_n(0, _) -> ok; relay_n(N, Dest) -> receive Msg -> - Dest ! {self(), Msg}, - relay_n(N-1, Dest) + Dest ! {self(), Msg}, + relay_n(N-1, Dest) end. @@ -366,15 +351,15 @@ collect(Time) -> collect(A, 0) -> receive - Mess -> - collect([Mess | A], 0) + Mess -> + collect([Mess | A], 0) after 0 -> - A + A end; collect(A, Ref) -> receive - {timeout, Ref, done} -> - collect(A, 0); - Mess -> - collect([Mess | A], Ref) + {timeout, Ref, done} -> + collect(A, 0); + Mess -> + collect([Mess | A], Ref) end. diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl index 3036d2957b..26f96a1766 100644 --- a/erts/emulator/test/trace_call_time_SUITE.erl +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -57,32 +58,30 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% When run in test server. --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, init_per_testcase/2, end_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]. + Config. -end_per_testcase(_Case, Config) -> +end_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. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. all() -> case test_server:is_native(trace_call_time_SUITE) of @@ -92,382 +91,339 @@ all() -> combo, bif, nif, called_function, dead_tracer] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -basic(suite) -> - []; -basic(doc) -> - ["Tests basic call count trace"]; +%% Tests basic call time trace basic(Config) when is_list(Config) -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line M = 1000, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + 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), + 1 = erlang:trace_pattern({?MODULE,seq, '_'}, true, [call_time]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]), + Pid = setup(), + {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> (X+1) end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + ok = check_trace_info({?MODULE, seq_r, 3}, [], none), + + {Lr, T2} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> (X+1) end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + ok = check_trace_info({?MODULE, seq_r, 3}, [{Pid, 1, 0, 0}], T2/M), + ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid, M, 0, 0}], T2), + L = lists:reverse(Lr), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -on_and_off(suite) -> - []; -on_and_off(doc) -> - ["Tests turning trace parameters on and off"]; +%% "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, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + 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), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]), + Pid = setup(), + {L, T1} = execute(Pid, {?MODULE, seq, [1, M, fun(X) -> X+1 end]}), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + + N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_time]), + {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T2), + + P = erlang:trace_pattern({'_','_','_'}, true, [call_time]), + {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T3), + + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]), + ok = check_trace_info({?MODULE, seq, 3}, false, none), + {L, _T4} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, false, none), + ok = check_trace_info({?MODULE, seq_r, 4}, [], none), + {Lr, T5} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid,M,0,0}], T5), + + N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_time]), + ok = check_trace_info({?MODULE, seq_r, 4}, false, none), + {Lr, _T6} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq_r, 4}, false, none), + L = lists:reverse(Lr), %% - ?line Pid ! quit, - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -info(suite) -> - []; -info(doc) -> - ["Tests the trace_info BIF"]; +%% Tests the trace_info BIF info(Config) when is_list(Config) -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + 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), + 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_time]), + {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]), + {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all), + {value,{call_time,[]}} = lists:keysearch(call_time, 1, L), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]), + {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]), + {call_time,false} = erlang:trace_info({?MODULE,seq,3}, call_time), + {all,false} = erlang:trace_info({?MODULE,seq,3}, all), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -pause_and_restart(suite) -> - []; -pause_and_restart(doc) -> - ["Tests pausing and restarting call time counters"]; +%% 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(), + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 100, + 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), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]), + ok = check_trace_info({?MODULE, seq, 3}, [], none), + {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1), + {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T2), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]), + ok = check_trace_info({?MODULE, seq, 3}, [], none), + {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T3), %% - ?line Pid ! quit, - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -scheduling(suite) -> - []; -scheduling(doc) -> - ["Tests in/out scheduling of call time counters"]; +%% 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, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 1000000, + Np = erlang:system_info(schedulers_online), + F = 12, %% setup load processes %% (single, no internal calls) - ?line erlang:trace_pattern({?MODULE,loaded,1}, true, [call_time]), + 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], + Pids = [setup() || _ <- lists:seq(1, F*Np)], + {_Ls,T1} = execute(Pids, {?MODULE,loaded,[M]}), + [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]), + {call_time, CT} = erlang:trace_info({?MODULE,loaded,1}, call_time), + + lists:foreach(fun (Pid) -> + 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), + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -combo(suite) -> - []; -combo(doc) -> - ["Tests combining local call trace and meta trace with call time trace"]; +%% "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]), + Self = self(), + Nbc = 3, + MetaMs = [{'_',[],[{return_trace}]}], + Flags = lists:sort([call, return_to]), + LocalTracer = spawn_link(fun () -> relay_n(5 + Nbc + 3, Self) end), + MetaTracer = spawn_link(fun () -> relay_n(9 + Nbc + 3, Self) end), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, MetaMs, [{meta,MetaTracer}]), + 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}]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, [], [local]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, MetaMs, [{meta,MetaTracer}]), %% not implemented - %?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_count]), + %2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_count]), - ?line 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]), + 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), + {traced,local} = + erlang:trace_info({?MODULE,seq_r,3}, traced), + {match_spec,[]} = + erlang:trace_info({?MODULE,seq_r,3}, match_spec), + {meta,MetaTracer} = + erlang:trace_info({?MODULE,seq_r,3}, meta), + {meta_match_spec,MetaMs} = + erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec), + 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), + {all,[_|_]=TraceInfo} = erlang:trace_info({?MODULE,seq_r,3}, all), + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo), + {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfo), + {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo), + {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfo), + {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfo), + {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), + {all, [_|_] = TraceInfoBif} = erlang:trace_info({erlang, term_to_binary, 1}, all), + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfoBif), + {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfoBif), + {value,{meta, MetaTracer}} = lists:keysearch(meta, 1, TraceInfoBif), + {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfoBif), %% not implemented - ?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), + {value,{call_count,false}} = lists:keysearch(call_count, 1, TraceInfoBif), + %{value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfoBif), + {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfoBif), %% - ?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), + [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), + T0 = erlang:monotonic_time(), + with_bif(Nbc), + T1 = erlang:monotonic_time(), + TimeB = erlang:convert_time_unit(T1-T0, native, microsecond), %% - ?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), + List = collect(100), + {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), + Meta = lists:reverse(MetaR), + Local = lists:reverse(LocalR), + + [?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, + + [?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, + + ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1), + ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1), + ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1), + ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1), + 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]), + erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time]), + erlang:trace_pattern(on_load, false, [local,meta,call_time]), + erlang:trace(all, false, [all]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -bif(suite) -> - []; -bif(doc) -> - ["Tests tracing of bifs"]; +%% Tests tracing of bifs bif(Config) when is_list(Config) -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line M = 1000000, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 5000000, %% - ?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), + 2 = erlang:trace_pattern({erlang, binary_to_term, '_'}, true, [call_time]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), + Pid = setup(), + {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), + ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M - 1, 0, 0}], T1/2), + ok = check_trace_info({erlang, term_to_binary, 1}, [{Pid, M - 1, 0, 0}], T1/2), % disable term2binary - ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, false, [call_time]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, false, [call_time]), - ?line {L, T2} = execute(Pid, fun() -> with_bif(M) end), + {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), + ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M*2 - 2, 0, 0}], T1/2 + T2), + ok = check_trace_info({erlang, term_to_binary, 1}, false, none), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -nif(suite) -> - []; -nif(doc) -> - ["Tests tracing of nifs"]; +%% Tests tracing of nifs nif(Config) when is_list(Config) -> load_nif(Config), - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line M = 1000000, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 5000000, %% - ?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 {_, T1} = execute(Pid, fun() -> with_nif(M) end), + 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]), + 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]), + Pid = setup(), + {_, T1} = execute(Pid, fun() -> with_nif(M) end), % 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), + ok = check_trace_info({?MODULE, nif_dec, 1}, [{Pid, M-1, 0, 0}], T1/5*4), + 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, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -called_function(suite) -> - []; -called_function(doc) -> - ["Tests combining nested function calls and that the time accumulates to the right function"]; +%% 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(), + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 2100, + 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), + 1 = erlang:trace_pattern({?MODULE,a_function,'_'}, true, [call_time]), + {L, T1} = execute(Pid, {?MODULE, a_function, [M]}), + 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), + 1 = erlang:trace_pattern({?MODULE,a_called_function,'_'}, true, [call_time]), + {L, T2} = execute(Pid, {?MODULE, a_function, [M]}), + ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M, 0, 0}], T1 + M*?SINGLE_CALL_US_TIME), + 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), + 1 = erlang:trace_pattern({?MODULE,dec,'_'}, true, [call_time]), + {L, T3} = execute(Pid, {?MODULE, a_function, [M]}), + ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M+M, 0, 0}], T1 + (M+M)*?SINGLE_CALL_US_TIME), + ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M+M, 0, 0}], T2 + M*?SINGLE_CALL_US_TIME ), + ok = check_trace_info({?MODULE, dec, 1}, [{Pid, M, 0, 0}], T3), - ?line Pid ! quit, - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -481,8 +437,8 @@ dead_tracer(Config) when is_list(Config) -> Ref = erlang:monitor(process, FirstTracer), FirstTracer ! quit, receive - {'DOWN',Ref,process,FirstTracer,normal} -> - ok + {'DOWN',Ref,process,FirstTracer,normal} -> + ok end, erlang:yield(), @@ -512,26 +468,26 @@ dead_tracer(Config) when is_list(Config) -> other_than_self(Info) -> [{Pid,MFA} || {MFA,[{Pid,_,_,_}]} <- Info, - Pid =/= self()]. + Pid =/= self()]. tell_tracer(Tracer, Fun) -> Tracer ! {execute,self(),Fun}, receive - {Tracer,executed} -> - ok + {Tracer,executed} -> + ok end. tracer() -> spawn_link(fun Loop() -> - receive - quit -> - ok; - {execute,From,Fun} -> - Fun(), - From ! {self(),executed}, - Loop() - end - end). + receive + quit -> + ok; + {execute,From,Fun} -> + Fun(), + From ! {self(),executed}, + Loop() + end + end). turn_on_tracing(Pid) -> _ = erlang:trace(Pid, true, [call,set_on_spawn]), @@ -541,18 +497,18 @@ turn_on_tracing(Pid) -> collect_all_info() -> collect_all_info([{?MODULE,F,A} || {F,A} <- module_info(functions)] ++ - erlang:system_info(snifs)). + erlang:system_info(snifs)). collect_all_info([MFA|T]) -> CallTime = erlang:trace_info(MFA, call_time), erlang:trace_pattern(MFA, restart, [call_time]), case CallTime of - {call_time,false} -> - collect_all_info(T); - {call_time,[]} -> - collect_all_info(T); - {call_time,[_|_]=List} -> - [{MFA,List}|collect_all_info(T)] + {call_time,false} -> + collect_all_info(T); + {call_time,[]} -> + collect_all_info(T); + {call_time,[_|_]=List} -> + [{MFA,List}|collect_all_info(T)] end; collect_all_info([]) -> []. @@ -565,8 +521,8 @@ collect_all_info([]) -> []. %% Local helpers load_nif(Config) -> - ?line Path = ?config(data_dir, Config), - ?line ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). + Path = proplists:get_value(data_dir, Config), + ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). %% Stack recursive seq @@ -613,39 +569,39 @@ seq_r(Start, Stop, Succ, 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 + % 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 + {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, + 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 + 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]), @@ -658,8 +614,8 @@ relay_n(0, _) -> ok; relay_n(N, Dest) -> receive Msg -> - Dest ! {self(), Msg}, - relay_n(N-1, Dest) + Dest ! {self(), Msg}, + relay_n(N-1, Dest) end. @@ -673,17 +629,17 @@ collect(Time) -> collect(A, 0) -> receive - Mess -> - collect([Mess | A], 0) + Mess -> + collect([Mess | A], 0) after 0 -> - A + A end; collect(A, Ref) -> receive - {timeout, Ref, done} -> - collect(A, 0); - Mess -> - collect([Mess | A], Ref) + {timeout, Ref, done} -> + collect(A, 0); + Mess -> + collect([Mess | A], Ref) end. setup() -> @@ -695,28 +651,28 @@ setup(Opts) -> Pid. execute(Pids, Mfa) when is_list(Pids) -> - T0 = now(), + T0 = erlang:monotonic_time(), [P ! {self(), execute, Mfa} || P <- Pids], As = [receive {P, answer, Answer} -> Answer end || P <- Pids], - T1 = now(), - {As, timer:now_diff(T1,T0)}; + T1 = erlang:monotonic_time(), + {As, erlang:convert_time_unit(T1-T0, native, microsecond)}; execute(P, Mfa) -> - T0 = now(), + T0 = erlang:monotonic_time(), P ! {self(), execute, Mfa}, A = receive {P, answer, Answer} -> Answer end, - T1 = now(), - {A, timer:now_diff(T1,T0)}. + T1 = erlang:monotonic_time(), + {A, erlang:convert_time_unit(T1-T0, native, microsecond)}. 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() + 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/trace_nif.c b/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c index 33b346aab7..786be35c9c 100644 --- a/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c +++ b/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c @@ -1,4 +1,4 @@ -#include "erl_nif.h" +#include <erl_nif.h> static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) @@ -6,11 +6,6 @@ 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; @@ -34,4 +29,4 @@ static ErlNifFunc nif_funcs[] = {"nif_dec", 1, nif_dec_1} }; -ERL_NIF_INIT(trace_call_time_SUITE,nif_funcs,load,reload,upgrade,unload) +ERL_NIF_INIT(trace_call_time_SUITE,nif_funcs,load,NULL,upgrade,unload) diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl index 1bed49aad2..253d5fed23 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -1,24 +1,24 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(trace_local_SUITE). --compile({nowarn_deprecated_function, {erlang,hash,2}}). -export([basic_test/0, bit_syntax_test/0, return_test/0, on_and_off_test/0, stack_grow_test/0, @@ -28,69 +28,44 @@ -export([exported/1, exported_wrap/1, loop/4, apply_slave_async/5, match/2, clause/2, id/1, undef/1, lists_reverse/2]). -%% -%% Define to run outside of test server -%% -%% (rotten feature) -%% -%%-define(STANDALONE,1). - + %% %% Define for debug output %% %%-define(debug,1). --ifdef(STANDALONE). --define(config(A,B),config(A,B)). --export([config/2]). --define(DEFAULT_RECEIVE_TIMEOUT, 1000). --else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(DEFAULT_RECEIVE_TIMEOUT, infinity). --endif. - + -ifdef(debug). --ifdef(STANDALONE). --define(line, erlang:display({?MODULE,?LINE}), ). --endif. -define(dbgformat(A,B),io:format(A,B)). -else. --ifdef(STANDALONE). --define(line, noop, ). --endif. -define(dbgformat(A,B),noop). -endif. - --ifdef(STANDALONE). -config(priv_dir,_) -> - ".". --else. %%% When run in test server %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, basic/1, bit_syntax/1, - return/1, on_and_off/1, systematic_on_off/1, - stack_grow/1,info/1, delete/1, - exception/1, exception_apply/1, - exception_function/1, exception_apply_function/1, - exception_nocatch/1, exception_nocatch_apply/1, - exception_nocatch_function/1, exception_nocatch_apply_function/1, - exception_meta/1, exception_meta_apply/1, - exception_meta_function/1, exception_meta_apply_function/1, - exception_meta_nocatch/1, exception_meta_nocatch_apply/1, - exception_meta_nocatch_function/1, - exception_meta_nocatch_apply_function/1, - concurrency/1, - init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, + basic/1, bit_syntax/1, + return/1, on_and_off/1, systematic_on_off/1, + stack_grow/1,info/1, delete/1, + exception/1, exception_apply/1, + exception_function/1, exception_apply_function/1, + exception_nocatch/1, exception_nocatch_apply/1, + exception_nocatch_function/1, exception_nocatch_apply_function/1, + exception_meta/1, exception_meta_apply/1, + exception_meta_function/1, exception_meta_apply_function/1, + exception_meta_nocatch/1, exception_meta_nocatch_apply/1, + exception_meta_nocatch_function/1, + exception_meta_nocatch_apply_function/1, + concurrency/1, + init_per_testcase/2, end_per_testcase/2]). + init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(2)), - [{watchdog, Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> +end_per_testcase(_Case, _Config) -> shutdown(), - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), %% Reloading the module will clear all trace patterns, and %% in a debug-compiled emulator run assertions of the counters @@ -98,168 +73,127 @@ end_per_testcase(_Case, Config) -> c:l(?MODULE). +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> +all() -> case test_server:is_native(trace_local_SUITE) of - true -> [not_run]; - false -> - [basic, bit_syntax, return, on_and_off, systematic_on_off, - stack_grow, - info, delete, exception, exception_apply, - exception_function, exception_apply_function, - exception_nocatch, exception_nocatch_apply, - exception_nocatch_function, - exception_nocatch_apply_function, exception_meta, - exception_meta_apply, exception_meta_function, - exception_meta_apply_function, exception_meta_nocatch, - exception_meta_nocatch_apply, - exception_meta_nocatch_function, - exception_meta_nocatch_apply_function, - concurrency] + true -> [not_run]; + false -> + [basic, bit_syntax, return, on_and_off, systematic_on_off, + stack_grow, + info, delete, exception, exception_apply, + exception_function, exception_apply_function, + exception_nocatch, exception_nocatch_apply, + exception_nocatch_function, + exception_nocatch_apply_function, exception_meta, + exception_meta_apply, exception_meta_function, + exception_meta_apply_function, exception_meta_nocatch, + exception_meta_nocatch_apply, + exception_meta_nocatch_function, + exception_meta_nocatch_apply_function, + concurrency] end. -groups() -> - []. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -not_run(Config) when is_list(Config) -> +not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -basic(doc) -> - ["Tests basic local call-trace"]; +%% Tests basic local call-trace basic(Config) when is_list(Config) -> basic_test(). -bit_syntax(doc) -> - "OTP-7399: Make sure that code that uses the optimized bit syntax matching " - "can be traced without crashing the emulator."; +%% OTP-7399: Make sure that code that uses the optimized bit syntax matching +%% can be traced without crashing the emulator. bit_syntax(Config) when is_list(Config) -> bit_syntax_test(). -return(doc) -> - ["Tests the different types of return trace"]; +%% Tests the different types of return trace return(Config) when is_list(Config) -> return_test(). - -on_and_off(doc) -> - ["Tests turning trace parameters on and off, " - "both for trace and trace_pattern"]; + +%% Tests turning trace parameters on and off, +%% both for trace and trace_pattern on_and_off(Config) when is_list(Config) -> on_and_off_test(). - -stack_grow(doc) -> - ["Tests the stack growth during return traces"]; + +%% Tests the stack growth during return traces stack_grow(Config) when is_list(Config) -> stack_grow_test(). - -info(doc) -> - ["Tests the trace_info BIF"]; + +%% Tests the trace_info BIF info(Config) when is_list(Config) -> info_test(). - -delete(doc) -> - ["Tests putting trace on deleted modules"]; + +%% Tests putting trace on deleted modules delete(Config) when is_list(Config) -> delete_test(Config). -exception(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception(Config) when is_list(Config) -> exception_test([]). -exception_apply(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_apply(Config) when is_list(Config) -> exception_test([apply]). -exception_function(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_function(Config) when is_list(Config) -> exception_test([function]). -exception_apply_function(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_apply_function(Config) when is_list(Config) -> exception_test([apply,function]). -exception_nocatch(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_nocatch(Config) when is_list(Config) -> exception_test([nocatch]). -exception_nocatch_apply(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_nocatch_apply(Config) when is_list(Config) -> exception_test([nocatch,apply]). -exception_nocatch_function(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_nocatch_function(Config) when is_list(Config) -> exception_test([nocatch,function]). -exception_nocatch_apply_function(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_nocatch_apply_function(Config) when is_list(Config) -> exception_test([nocatch,apply,function]). -exception_meta(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta(Config) when is_list(Config) -> exception_test([meta]). -exception_meta_apply(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_apply(Config) when is_list(Config) -> exception_test([meta,apply]). -exception_meta_function(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_function(Config) when is_list(Config) -> exception_test([meta,function]). -exception_meta_apply_function(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_apply_function(Config) when is_list(Config) -> exception_test([meta,apply,function]). -exception_meta_nocatch(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_nocatch(Config) when is_list(Config) -> exception_test([meta,nocatch]). -exception_meta_nocatch_apply(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_nocatch_apply(Config) when is_list(Config) -> exception_test([meta,nocatch,apply]). -exception_meta_nocatch_function(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_nocatch_function(Config) when is_list(Config) -> exception_test([meta,nocatch,function]). -exception_meta_nocatch_apply_function(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_nocatch_apply_function(Config) when is_list(Config) -> exception_test([meta,nocatch,apply,function]). --endif. - - %%% Message patterns and expect functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -308,28 +242,28 @@ expect_pid(Pid, Msg) when is_tuple(Msg) -> same(Msg, expect_receive(Pid)); expect_pid(Pid, Fun) when is_function(Fun, 1) -> case Fun(expect_receive(Pid)) of - next -> - expect_pid(Pid, Fun); - done -> - ok; - Other -> - expect_pid(Pid, Other) + next -> + expect_pid(Pid, Fun); + done -> + ok; + Other -> + expect_pid(Pid, Other) end. expect_receive(Pid) when is_pid(Pid) -> receive - Msg when is_tuple(Msg), - element(1, Msg) == trace, - element(2, Msg) =/= Pid; - %% - is_tuple(Msg), - element(1, Msg) == trace_ts, - element(2, Msg) =/= Pid -> - expect_receive(Pid); - Msg -> - expect_msg(Pid, Msg) + Msg when is_tuple(Msg), + element(1, Msg) == trace, + element(2, Msg) =/= Pid; + %% + is_tuple(Msg), + element(1, Msg) == trace_ts, + element(2, Msg) =/= Pid -> + expect_receive(Pid); + Msg -> + expect_msg(Pid, Msg) after 100 -> - {nm} + {nm} end. expect_msg(P, ?pCT(P,M,F,Args)) -> {ct,{M,F},Args}; @@ -342,18 +276,18 @@ expect_msg(P, ?pRT(P,M,F,Arity)) -> {rt,{M,F,Arity}}; expect_msg(P, ?pRTT(P,M,F,Arity)) -> {rtt,{M,F,Arity}}; expect_msg(P, Msg) when is_tuple(Msg) -> case tuple_to_list(Msg) of - [trace,P|T] -> - list_to_tuple([trace|T]); - [trace_ts,P|[_|_]=T] -> - list_to_tuple([trace_ts|reverse(tl(reverse(T)))]); - _ -> - Msg + [trace,P|T] -> + list_to_tuple([trace|T]); + [trace_ts,P|[_|_]=T] -> + list_to_tuple([trace_ts|reverse(tl(reverse(T)))]); + _ -> + Msg end. same(A, B) -> case [A|B] of - [X|X] -> - ok + [X|X] -> + ok end. @@ -361,73 +295,74 @@ same(A, B) -> %%% tests %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% basic_test() -> - ?line setup([call]), + setup([call]), NumMatches = erlang:trace_pattern({?MODULE,'_','_'},[],[local]), NumMatches = erlang:trace_pattern({?MODULE,'_','_'},[],[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported,[1]), - ?line ?CT(?MODULE,local,[1]), - ?line ?CT(?MODULE,local2,[1]), - ?line ?CT(?MODULE,local_tail,[1]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line [1,1,1,1] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?NM, - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?CT(?MODULE,_,_), %% The fun - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported,[1]), - ?line ?CT(?MODULE,local,[1]), - ?line ?CT(?MODULE,local2,[1]), - ?line ?CT(?MODULE,local_tail,[1]), - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[local]), - ?line shutdown(), - ?line ?NM, + false = code:is_module_native(?MODULE), % got fooled by local trace + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported,[1]), + ?CT(?MODULE,local,[1]), + ?CT(?MODULE,local2,[1]), + ?CT(?MODULE,local_tail,[1]), + erlang:trace_pattern({?MODULE,'_','_'},[],[]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + [1,1,1,997] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?NM, + erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,997] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?CT(?MODULE,_,_), %% The fun + ?CT(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported,[1]), + ?CT(?MODULE,local,[1]), + ?CT(?MODULE,local2,[1]), + ?CT(?MODULE,local_tail,[1]), + erlang:trace_pattern({?MODULE,'_','_'},false,[local]), + shutdown(), + ?NM, ok. %% OTP-7399. bit_syntax_test() -> - ?line setup([call]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - - ?line lambda_slave(fun() -> - 6 = bs_sum_a(<<1,2,3>>, 0), - 10 = bs_sum_b(0, <<1,2,3,4>>), - 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0) - end), - ?line ?CT(?MODULE,_,[]), %Ignore call to the fun. - - ?line ?CT(?MODULE,bs_sum_a,[<<1,2,3>>,0]), - ?line ?CT(?MODULE,bs_sum_a,[<<2,3>>,1]), - ?line ?CT(?MODULE,bs_sum_a,[<<3>>,3]), - ?line ?CT(?MODULE,bs_sum_a,[<<>>,6]), - - ?line ?CT(?MODULE,bs_sum_b,[0,<<1,2,3,4>>]), - ?line ?CT(?MODULE,bs_sum_b,[1,<<2,3,4>>]), - ?line ?CT(?MODULE,bs_sum_b,[3,<<3,4>>]), - ?line ?CT(?MODULE,bs_sum_b,[6,<<4>>]), - ?line ?CT(?MODULE,bs_sum_b,[10,<<>>]), - - ?line ?CT(?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>, 0]), - ?line ?CT(?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>, 3]), - ?line ?CT(?MODULE,bs_sum_c,[<<7:4,11:4>>, 8]), - ?line ?CT(?MODULE,bs_sum_c,[<<11:4>>, 15]), - ?line ?CT(?MODULE,bs_sum_c,[<<>>, 26]), - - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[local]), - ?line shutdown(), - ?line ?NM, + setup([call]), + erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + + lambda_slave(fun() -> + 6 = bs_sum_a(<<1,2,3>>, 0), + 10 = bs_sum_b(0, <<1,2,3,4>>), + 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0) + end), + ?CT(?MODULE,_,[]), %Ignore call to the fun. + + ?CT(?MODULE,bs_sum_a,[<<1,2,3>>,0]), + ?CT(?MODULE,bs_sum_a,[<<2,3>>,1]), + ?CT(?MODULE,bs_sum_a,[<<3>>,3]), + ?CT(?MODULE,bs_sum_a,[<<>>,6]), + + ?CT(?MODULE,bs_sum_b,[0,<<1,2,3,4>>]), + ?CT(?MODULE,bs_sum_b,[1,<<2,3,4>>]), + ?CT(?MODULE,bs_sum_b,[3,<<3,4>>]), + ?CT(?MODULE,bs_sum_b,[6,<<4>>]), + ?CT(?MODULE,bs_sum_b,[10,<<>>]), + + ?CT(?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>, 0]), + ?CT(?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>, 3]), + ?CT(?MODULE,bs_sum_c,[<<7:4,11:4>>, 8]), + ?CT(?MODULE,bs_sum_c,[<<11:4>>, 15]), + ?CT(?MODULE,bs_sum_c,[<<>>, 26]), + + erlang:trace_pattern({?MODULE,'_','_'},false,[local]), + shutdown(), + ?NM, ok. @@ -441,149 +376,156 @@ bs_sum_c(<<H:4,T/bits>>, Acc) -> bs_sum_c(T, H+Acc); bs_sum_c(<<>>, Acc) -> Acc. return_test() -> - ?line setup([call]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], - [local]), - ?line erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}], - [local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported,[1]), - ?line ?CT(?MODULE,local,[1]), - ?line ?CT(?MODULE,local2,[1]), - ?line ?CT(?MODULE,local_tail,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line ?RF(erlang,hash,2,1), - ?line ?RF(?MODULE,local_tail,1,[1,1]), - ?line ?RF(?MODULE,local2,1,[1,1]), - ?line ?RF(?MODULE,local,1,[1,1,1]), - ?line ?RF(?MODULE,exported,1,[1,1,1,1]), - ?line ?RF(?MODULE,exported_wrap,1,[1,1,1,1]), - ?line shutdown(), - ?line setup([call,return_to]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[], - [local]), - ?line erlang:trace_pattern({erlang,hash,'_'},[], - [local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported,[1]), - ?line ?CT(?MODULE,local,[1]), - ?line ?CT(?MODULE,local2,[1]), - ?line ?CT(?MODULE,local_tail,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line ?RT(?MODULE,local_tail,1), - ?line ?RT(?MODULE,local,1), - ?line ?RT(?MODULE,exported,1), - ?line ?RT(?MODULE,slave,2), - ?line shutdown(), - ?line setup([call,return_to]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], - [local]), - ?line erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}], - [local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported,[1]), - ?line ?CT(?MODULE,local,[1]), - ?line ?CT(?MODULE,local2,[1]), - ?line ?CT(?MODULE,local_tail,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line ?RF(erlang,hash,2,1), - ?line ?RT(?MODULE,local_tail,1), - ?line ?RF(?MODULE,local_tail,1,[1,1]), - ?line ?RF(?MODULE,local2,1,[1,1]), - ?line ?RT(?MODULE,local,1), - ?line ?RF(?MODULE,local,1,[1,1,1]), - ?line ?RT(?MODULE,exported,1), - ?line ?RF(?MODULE,exported,1,[1,1,1,1]), - ?line ?RF(?MODULE,exported_wrap,1,[1,1,1,1]), - ?line ?RT(?MODULE,slave,2), - ?line shutdown(), - ?line ?NM, + setup([call]), + erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + [local]), + erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], + [local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported,[1]), + ?CT(?MODULE,local,[1]), + ?CT(?MODULE,local2,[1]), + ?CT(?MODULE,local_tail,[1]), + ?CT(erlang,phash2,[1,1023]), + ?RF(erlang,phash2,2,997), + ?RF(?MODULE,local_tail,1,[1,997]), + ?RF(?MODULE,local2,1,[1,997]), + ?RF(?MODULE,local,1,[1,1,997]), + ?RF(?MODULE,exported,1,[1,1,1,997]), + ?RF(?MODULE,exported_wrap,1,[1,1,1,997]), + shutdown(), + setup([call,return_to]), + erlang:trace_pattern({?MODULE,'_','_'},[], + [local]), + erlang:trace_pattern({erlang,phash2,'_'},[], + [local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported,[1]), + ?CT(?MODULE,local,[1]), + ?CT(?MODULE,local2,[1]), + ?CT(?MODULE,local_tail,[1]), + ?CT(erlang,phash2,[1,1023]), + ?RT(?MODULE,local_tail,1), + ?RT(?MODULE,local,1), + ?RT(?MODULE,exported,1), + ?RT(?MODULE,slave,2), + shutdown(), + setup([call,return_to]), + erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + [local]), + erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], + [local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported,[1]), + ?CT(?MODULE,local,[1]), + ?CT(?MODULE,local2,[1]), + ?CT(?MODULE,local_tail,[1]), + ?CT(erlang,phash2,[1,1023]), + ?RF(erlang,phash2,2,997), + ?RT(?MODULE,local_tail,1), + ?RF(?MODULE,local_tail,1,[1,997]), + ?RF(?MODULE,local2,1,[1,997]), + ?RT(?MODULE,local,1), + ?RF(?MODULE,local,1,[1,1,997]), + ?RT(?MODULE,exported,1), + ?RF(?MODULE,exported,1,[1,1,1,997]), + ?RF(?MODULE,exported_wrap,1,[1,1,1,997]), + ?RT(?MODULE,slave,2), + shutdown(), + ?NM, + + %% Test a regression where turning off return_to tracing + %% on yourself would cause a segfault. + Pid = setup([call,return_to]), + erlang:trace_pattern({'_','_','_'},[],[local]), + apply_slave(erlang,trace,[Pid, false, [all]]), + shutdown(), ok. on_and_off_test() -> - ?line Pid = setup([call]), - ?line 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line LocalTail = fun() -> - local_tail(1) - end, - ?line [1,1] = lambda_slave(LocalTail), - ?line ?CT(?MODULE,local_tail,[1]), - ?line erlang:trace(Pid,true,[return_to]), - ?line [1,1] = lambda_slave(LocalTail), - ?line ?CT(?MODULE,local_tail,[1]), - ?line ?RT(?MODULE,_,_), - ?line 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), - ?line [1,1] = lambda_slave(LocalTail), - ?line ?NM, - ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[global]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?RT(?MODULE,slave,2), - ?line 1 = erlang:trace_pattern({erlang,hash,2},[],[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line ?RT(?MODULE,local_tail,1), - ?line ?RT(?MODULE,slave,2), - ?line erlang:trace(Pid,true,[timestamp]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(?MODULE,exported_wrap,[1]), - ?line ?CTT(erlang,hash,[1,1]), - ?line ?RTT(?MODULE,local_tail,1), - ?line ?RTT(?MODULE,slave,2), - ?line erlang:trace(Pid,false,[return_to,timestamp]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line erlang:trace(Pid,true,[return_to]), - ?line 1 = erlang:trace_pattern({erlang,hash,2},[],[]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line ?RT(?MODULE,slave,2), - ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line shutdown(), - ?line erlang:trace_pattern({'_','_','_'},false,[local]), - ?line N = erlang:trace_pattern({erlang,'_','_'},true,[local]), - ?line case erlang:trace_pattern({erlang,'_','_'},false,[local]) of - N -> - ok; - Else -> - exit({number_mismatch, {expected, N}, {got, Else}}) - end, - ?line case erlang:trace_pattern({erlang,'_','_'},false,[local]) of - N -> - ok; - Else2 -> - exit({number_mismatch, {expected, N}, {got, Else2}}) - end, - ?line M = erlang:trace_pattern({erlang,'_','_'},true,[]), - ?line case erlang:trace_pattern({erlang,'_','_'},false,[]) of - M -> - ok; - Else3 -> - exit({number_mismatch, {expected, N}, {got, Else3}}) - end, - ?line case erlang:trace_pattern({erlang,'_','_'},false,[]) of - M -> - ok; - Else4 -> - exit({number_mismatch, {expected, N}, {got, Else4}}) - end, - ?line ?NM, + Pid = setup([call]), + 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + LocalTail = fun() -> + local_tail(1) + end, + [1,997] = lambda_slave(LocalTail), + ?CT(?MODULE,local_tail,[1]), + erlang:trace(Pid,true,[return_to]), + [1,997] = lambda_slave(LocalTail), + ?CT(?MODULE,local_tail,[1]), + ?RT(?MODULE,_,_), + 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), + [1,997] = lambda_slave(LocalTail), + ?NM, + 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[global]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[local]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?RT(?MODULE,slave,2), + 1 = erlang:trace_pattern({erlang,phash2,2},[],[local]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(erlang,phash2,[1,1023]), + ?RT(?MODULE,local_tail,1), + ?RT(?MODULE,slave,2), + erlang:trace(Pid,true,[timestamp]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(?MODULE,exported_wrap,[1]), + ?CTT(erlang,phash2,[1,1023]), + ?RTT(?MODULE,local_tail,1), + ?RTT(?MODULE,slave,2), + erlang:trace(Pid,false,[return_to,timestamp]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(erlang,phash2,[1,1023]), + erlang:trace(Pid,true,[return_to]), + 1 = erlang:trace_pattern({erlang,phash2,2},[],[]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(erlang,phash2,[1,1023]), + ?RT(?MODULE,slave,2), + 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(erlang,phash2,[1,1023]), + shutdown(), + erlang:trace_pattern({'_','_','_'},false,[local]), + N = erlang:trace_pattern({erlang,'_','_'},true,[local]), + case erlang:trace_pattern({erlang,'_','_'},false,[local]) of + N -> + ok; + Else -> + exit({number_mismatch, {expected, N}, {got, Else}}) + end, + case erlang:trace_pattern({erlang,'_','_'},false,[local]) of + N -> + ok; + Else2 -> + exit({number_mismatch, {expected, N}, {got, Else2}}) + end, + M = erlang:trace_pattern({erlang,'_','_'},true,[]), + case erlang:trace_pattern({erlang,'_','_'},false,[]) of + M -> + ok; + Else3 -> + exit({number_mismatch, {expected, N}, {got, Else3}}) + end, + case erlang:trace_pattern({erlang,'_','_'},false,[]) of + M -> + ok; + Else4 -> + exit({number_mismatch, {expected, N}, {got, Else4}}) + end, + ?NM, ok. systematic_on_off(Config) when is_list(Config) -> @@ -633,12 +575,12 @@ systematic_on_off_1(Local) -> verify_trace_info(Global, Local) -> case erlang:trace_info({?MODULE,exported_wrap,1}, all) of - {all,false} -> - false = Global, - [] = Local; - {all,Ps} -> - io:format("~p\n", [Ps]), - [verify_trace_info(P, Global, Local) || P <- Ps] + {all,false} -> + false = Global, + [] = Local; + {all,Ps} -> + io:format("~p\n", [Ps]), + [verify_trace_info(P, Global, Local) || P <- Ps] end, global_call(Global, Local), local_call(Local), @@ -650,12 +592,10 @@ verify_trace_info({match_spec,[]}, _, _) -> ok; verify_trace_info({meta_match_spec,[]}, _, _) -> ok; verify_trace_info({LocalFlag,Bool}, _, Local) when is_boolean(Bool) -> try - Bool = lists:member(LocalFlag, Local) + Bool = lists:member(LocalFlag, Local) catch - error:_ -> - io:format("Line ~p: {~p,~p}, false, ~p\n", - [?LINE,LocalFlag,Bool,Local]), - ?t:fail() + error:_ -> + ct:fail("Line ~p: {~p,~p}, false, ~p\n", [?LINE,LocalFlag,Bool,Local]) end; verify_trace_info({meta,Pid}, false, Local) when is_pid(Pid) -> true = lists:member(meta, Local); @@ -667,10 +607,10 @@ verify_trace_info({call_count,_}, false, Local) -> global_call(Global, Local) -> apply_slave(?MODULE, exported_wrap, [global_call]), case Global of - false -> - recv_local_call(Local, [global_call]); - true -> - ?CT(?MODULE, exported_wrap, [global_call]) + false -> + recv_local_call(Local, [global_call]); + true -> + ?CT(?MODULE, exported_wrap, [global_call]) end. local_call(Local) -> @@ -679,16 +619,16 @@ local_call(Local) -> recv_local_call(Local, Args) -> case lists:member(local, Local) of - false -> - ok; - true -> - ?CT(?MODULE, exported_wrap, Args) + false -> + ok; + true -> + ?CT(?MODULE, exported_wrap, Args) end, case lists:member(meta, Local) of - false -> - ok; - true -> - ?CTT(?MODULE, exported_wrap, Args) + false -> + ok; + true -> + ?CTT(?MODULE, exported_wrap, Args) end, ok. @@ -697,99 +637,99 @@ combinations([_]=One) -> combinations([H|T]) -> Cs = combinations(T), [[H|C] || C <- Cs] ++ Cs. - + stack_grow_test() -> - ?line setup([call,return_to]), - ?line 1 = erlang:trace_pattern({?MODULE,loop,4}, - [{'_',[],[{return_trace}]}],[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line Num = 1 bsl 15, - ?line Fun = - fun(_F,0) -> ok; - (F,N) -> - receive _A -> - receive _B -> - receive _C -> - F(F,N-1) - end - end - end - end, - ?line apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), - ?line Fun(Fun,Num + 1), - ?line ?NM, + setup([call,return_to]), + 1 = erlang:trace_pattern({?MODULE,loop,4}, + [{'_',[],[{return_trace}]}],[local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + Num = 1 bsl 15, + Fun = + fun(_F,0) -> ok; + (F,N) -> + receive _A -> + receive _B -> + receive _C -> + F(F,N-1) + end + end + end + end, + apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), + Fun(Fun,Num + 1), + ?NM, ok. info_test() -> - ?line Flags1 = lists:sort([call,return_to]), - ?line Pid = setup(Flags1), - ?line Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, - {'_',[],[]}], - ?line erlang:trace_pattern({?MODULE,exported_wrap,1},Prog,[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line Self = self(), - ?line {flags,L} = erlang:trace_info(Pid,flags), - ?line case lists:sort(L) of - Flags1 -> - ok; - Wrong1 -> - exit({bad_result, {erlang,trace_info,[Pid,flags]}, - {expected, Flags1}, {got, Wrong1}}) - end, - ?line {tracer,Tracer} = erlang:trace_info(Pid,tracer), - ?line case Tracer of - Self -> - ok; - Wrong2 -> - exit({bad_result, {erlang,trace_info,[Pid,tracer]}, - {expected, Self}, {got, Wrong2}}) - end, - ?line {traced,local} = erlang:trace_info({?MODULE,exported_wrap,1},traced), - ?line {match_spec, MS} = - erlang:trace_info({?MODULE,exported_wrap,1},match_spec), - ?line case MS of - Prog -> - ok; - Wrong3 -> - exit({bad_result, {erlang,trace_info, - [{?MODULE,exported_wrap,1}, - match_spec]}, - {expected, Prog}, {got, Wrong3}}) - end, - ?line erlang:garbage_collect(self()), - ?line receive - after 1 -> - ok - end, - ?line io:format("~p~n",[MS]), - ?line {match_spec,MS2} = - erlang:trace_info({?MODULE,exported_wrap,1},match_spec), - ?line io:format("~p~n",[MS2]), - ?line erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), - ?line {traced,global} = - erlang:trace_info({?MODULE,exported_wrap,1},traced), - ?line {match_spec,[]} = - erlang:trace_info({?MODULE,exported_wrap,1},match_spec), - ?line {traced,undefined} = - erlang:trace_info({?MODULE,exported_wrap,2},traced), - ?line {match_spec,undefined} = - erlang:trace_info({?MODULE,exported_wrap,2},match_spec), - ?line {traced,false} = erlang:trace_info({?MODULE,exported,1},traced), - ?line {match_spec,false} = - erlang:trace_info({?MODULE,exported,1},match_spec), - ?line shutdown(), + Flags1 = lists:sort([call,return_to]), + Pid = setup(Flags1), + Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, + {'_',[],[]}], + erlang:trace_pattern({?MODULE,exported_wrap,1},Prog,[local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + Self = self(), + {flags,L} = erlang:trace_info(Pid,flags), + case lists:sort(L) of + Flags1 -> + ok; + Wrong1 -> + exit({bad_result, {erlang,trace_info,[Pid,flags]}, + {expected, Flags1}, {got, Wrong1}}) + end, + {tracer,Tracer} = erlang:trace_info(Pid,tracer), + case Tracer of + Self -> + ok; + Wrong2 -> + exit({bad_result, {erlang,trace_info,[Pid,tracer]}, + {expected, Self}, {got, Wrong2}}) + end, + {traced,local} = erlang:trace_info({?MODULE,exported_wrap,1},traced), + {match_spec, MS} = + erlang:trace_info({?MODULE,exported_wrap,1},match_spec), + case MS of + Prog -> + ok; + Wrong3 -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + match_spec]}, + {expected, Prog}, {got, Wrong3}}) + end, + erlang:garbage_collect(self()), + receive + after 1 -> + ok + end, + io:format("~p~n",[MS]), + {match_spec,MS2} = + erlang:trace_info({?MODULE,exported_wrap,1},match_spec), + io:format("~p~n",[MS2]), + erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), + {traced,global} = + erlang:trace_info({?MODULE,exported_wrap,1},traced), + {match_spec,[]} = + erlang:trace_info({?MODULE,exported_wrap,1},match_spec), + {traced,undefined} = + erlang:trace_info({?MODULE,exported_wrap,2},traced), + {match_spec,undefined} = + erlang:trace_info({?MODULE,exported_wrap,2},match_spec), + {traced,false} = erlang:trace_info({?MODULE,exported,1},traced), + {match_spec,false} = + erlang:trace_info({?MODULE,exported,1},match_spec), + shutdown(), ok. delete_test(Config) -> - ?line Priv = ?config(priv_dir, Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "trace_local_dummy"), - ?line {ok,trace_local_dummy} = c:c(File, [{outdir,Priv}]), - ?line code:purge(trace_local_dummy), - ?line code:delete(trace_local_dummy), - ?line 0 = erlang:trace_pattern({trace_local_dummy,'_','_'},true,[local]), - ?line ?NM, + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "trace_local_dummy"), + {ok,trace_local_dummy} = c:c(File, [{outdir,Priv}]), + code:purge(trace_local_dummy), + code:delete(trace_local_dummy), + 0 = erlang:trace_pattern({trace_local_dummy,'_','_'},true,[local]), + ?NM, ok. @@ -797,34 +737,34 @@ delete_test(Config) -> %%% exception_test %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% exception_test(Opts) -> - ?line {ProcFlags,PatFlags} = - case proplists:get_bool(meta, Opts) of - true -> {[timestamp],[meta]}; - false -> {[call,return_to,timestamp],[local]} - end, - ?line case proplists:get_bool(nocatch, Opts) of - false -> - ?line Exceptions = exceptions(), - ?line exception_test_setup(ProcFlags, PatFlags), - ?line lists:foreach( - fun ({Func,Args}) -> - ?line exception_test(Opts, Func, Args) - end, - Exceptions), - ?line shutdown(); - true -> - ?line Exceptions = exceptions(), - ?line lists:foreach( - fun ({Func,Args}) -> - ?line exception_test_setup( - [procs|ProcFlags], - PatFlags), - ?line exception_test(Opts, Func, Args), - ?line shutdown() - end, - Exceptions) - end, - ?line ok. + {ProcFlags,PatFlags} = + case proplists:get_bool(meta, Opts) of + true -> {[timestamp],[meta]}; + false -> {[call,return_to,timestamp],[local]} + end, + case proplists:get_bool(nocatch, Opts) of + false -> + Exceptions = exceptions(), + exception_test_setup(ProcFlags, PatFlags), + lists:foreach( + fun ({Func,Args}) -> + exception_test(Opts, Func, Args) + end, + Exceptions), + shutdown(); + true -> + Exceptions = exceptions(), + lists:foreach( + fun ({Func,Args}) -> + exception_test_setup( + [procs|ProcFlags], + PatFlags), + exception_test(Opts, Func, Args), + shutdown() + end, + Exceptions) + end, + ok. exceptions() -> Ref = make_ref(), @@ -847,65 +787,65 @@ exceptions() -> {{?MODULE,lists_reverse}, [LL,[]]}]. exception_test_setup(ProcFlags, PatFlags) -> - ?line Pid = setup(ProcFlags), - ?line io:format("=== exception_test_setup(~p, ~p): ~p~n", - [ProcFlags,PatFlags,Pid]), - ?line Mprog = [{'_',[],[{exception_trace}]}], - ?line erlang:trace_pattern({?MODULE,'_','_'}, Mprog, PatFlags), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,PatFlags), - ?line [1,1,1,1,1] = - [erlang:trace_pattern({erlang,F,A}, Mprog, PatFlags) - || {F,A} <- [{exit,1},{error,1},{error,2},{throw,1},{'++',2}]], - ?line 1 = erlang:trace_pattern({lists,reverse,2}, Mprog, PatFlags), - ?line ok. + Pid = setup(ProcFlags), + io:format("=== exception_test_setup(~p, ~p): ~p~n", + [ProcFlags,PatFlags,Pid]), + Mprog = [{'_',[],[{exception_trace}]}], + erlang:trace_pattern({?MODULE,'_','_'}, Mprog, PatFlags), + erlang:trace_pattern({?MODULE,slave,'_'},false,PatFlags), + [1,1,1,1,1] = + [erlang:trace_pattern({erlang,F,A}, Mprog, PatFlags) + || {F,A} <- [{exit,1},{error,1},{error,2},{throw,1},{'++',2}]], + 1 = erlang:trace_pattern({lists,reverse,2}, Mprog, PatFlags), + ok. -record(exc_opts, {nocatch=false, meta=false}). exception_test(Opts, Func0, Args0) -> - ?line io:format("=== exception_test(~p, ~p, ~p)~n", - [Opts,Func0,abbr(Args0)]), - ?line Apply = proplists:get_bool(apply, Opts), - ?line Function = proplists:get_bool(function, Opts), - ?line Nocatch = proplists:get_bool(nocatch, Opts), - ?line Meta = proplists:get_bool(meta, Opts), - ?line ExcOpts = #exc_opts{nocatch=Nocatch,meta=Meta}, - + io:format("=== exception_test(~p, ~p, ~p)~n", + [Opts,Func0,abbr(Args0)]), + Apply = proplists:get_bool(apply, Opts), + Function = proplists:get_bool(function, Opts), + Nocatch = proplists:get_bool(nocatch, Opts), + Meta = proplists:get_bool(meta, Opts), + ExcOpts = #exc_opts{nocatch=Nocatch,meta=Meta}, + %% Func0 and Args0 are for the innermost call, now we will %% wrap them in wrappers... - ?line {Func1,Args1} = - case Function of - true -> {fun exc/2,[Func0,Args0]}; - false -> {Func0,Args0} - end, - - ?line {Func,Args} = - case Apply of - true -> {{erlang,apply},[Func1,Args1]}; - false -> {Func1,Args1} - end, - - ?line R1 = exc_slave(ExcOpts, Func, Args), - ?line Stack2 = [{?MODULE,exc_top,3,[]},{?MODULE,slave,2,[]}], - ?line Stack3 = [{?MODULE,exc,2,[]}|Stack2], - ?line Rs = - case x_exc_top(ExcOpts, Func, Args) of % Emulation - {crash,{Reason,Stack}}=R when is_list(Stack) -> - [R, - {crash,{Reason,Stack++Stack2}}, - {crash,{Reason,Stack++Stack3}}]; - R -> - [R] - end, - ?line exception_validate(R1, Rs), - ?line case R1 of - {crash,Crash} -> - ?line expect({trace_ts,exit,Crash}); - _ when not Meta -> - ?line expect({rtt,{?MODULE,slave,2}}); - _ -> - ok - end, - ?line expect({nm}). + {Func1,Args1} = + case Function of + true -> {fun exc/2,[Func0,Args0]}; + false -> {Func0,Args0} + end, + + {Func,Args} = + case Apply of + true -> {{erlang,apply},[Func1,Args1]}; + false -> {Func1,Args1} + end, + + R1 = exc_slave(ExcOpts, Func, Args), + Stack2 = [{?MODULE,exc_top,3,[]},{?MODULE,slave,2,[]}], + Stack3 = [{?MODULE,exc,2,[]}|Stack2], + Rs = + case x_exc_top(ExcOpts, Func, Args) of % Emulation + {crash,{Reason,Stack}}=R when is_list(Stack) -> + [R, + {crash,{Reason,Stack++Stack2}}, + {crash,{Reason,Stack++Stack3}}]; + R -> + [R] + end, + exception_validate(R1, Rs), + case R1 of + {crash,Crash} -> + expect({trace_ts,exit,Crash}); + _ when not Meta -> + expect({rtt,{?MODULE,slave,2}}); + _ -> + ok + end, + expect({nm}). exception_validate(R0, Rs0) -> R = clean_location(R0), @@ -914,16 +854,16 @@ exception_validate(R0, Rs0) -> exception_validate_1(R1, [R2|Rs]) -> case [R1|R2] of - [R|R] -> - ok; - [{crash,{badarg,[{lists,reverse,[L1a,L1b],_}|T]}}| - {crash,{badarg,[{lists,reverse,[L2a,L2b],_}|T]}}] -> - same({crash,{badarg,[{lists,reverse, - [lists:reverse(L1b, L1a),[]],[]}|T]}}, - {crash,{badarg,[{lists,reverse, - [lists:reverse(L2b, L2a),[]],[]}|T]}}); - _ when is_list(Rs), Rs =/= [] -> - exception_validate(R1, Rs) + [R|R] -> + ok; + [{crash,{badarg,[{lists,reverse,[L1a,L1b],_}|T]}}| + {crash,{badarg,[{lists,reverse,[L2a,L2b],_}|T]}}] -> + same({crash,{badarg,[{lists,reverse, + [lists:reverse(L1b, L1a),[]],[]}|T]}}, + {crash,{badarg,[{lists,reverse, + [lists:reverse(L2b, L2a),[]],[]}|T]}}); + _ when is_list(Rs), Rs =/= [] -> + exception_validate(R1, Rs) end. clean_location({crash,{Reason,Stk0}}) -> @@ -941,20 +881,20 @@ concurrency(_Config) -> %% if an aligned word-sized write is not atomic. Ps0 = [spawn_monitor(fun() -> infinite_loop() end) || - _ <- lists:seq(1, 2*N)], + _ <- lists:seq(1, 2*N)], OnAndOff = fun() -> concurrency_on_and_off() end, Ps1 = [spawn_monitor(OnAndOff)|Ps0], - ?t:sleep(1000), + timer:sleep(1000), %% Now spawn off N more processes that turn on off and off %% a local trace pattern. Ps = [spawn_monitor(OnAndOff) || _ <- lists:seq(1, N)] ++ Ps1, - ?t:sleep(1000), + timer:sleep(1000), %% Clean up. [exit(Pid, kill) || {Pid,_} <- Ps], [receive - {'DOWN',Ref,process,Pid,killed} -> ok + {'DOWN',Ref,process,Pid,killed} -> ok end || {Pid,Ref} <- Ps], erlang:trace_pattern({?MODULE,infinite_loop,0}, false, [local]), ok. @@ -989,7 +929,7 @@ local2(Val) -> local_tail(Val). %% Tail recursive call local_tail(Val) -> - [Val , erlang:hash(1,1)]. + [Val , erlang:phash2(1,1023)]. @@ -998,16 +938,16 @@ local_tail(Val) -> exc_top(ExcOpts, Func, Args) -> case ExcOpts#exc_opts.nocatch of - false -> - try exc_jump(Func, Args) of - Value -> - {value,Value} - catch - Class:Reason -> - {Class,Reason} - end; - true -> - {value,exc_jump(Func, Args)} + false -> + try exc_jump(Func, Args) of + Value -> + {value,Value} + catch + Class:Reason -> + {Class,Reason} + end; + true -> + {value,exc_jump(Func, Args)} end. %% x_* functions emulate the non-x_* ones. @@ -1016,42 +956,42 @@ exc_top(ExcOpts, Func, Args) -> %% The only possible place for exception %% is below exc/2. x_exc_top(ExcOpts, Func, Args) -> - ?line Rtt = not ExcOpts#exc_opts.meta, - ?line expect({ctt,{?MODULE,exc_top},[ExcOpts,Func,Args]}), - ?line case x_exc_jump(ExcOpts, Func, Args) of - Result when not ExcOpts#exc_opts.nocatch -> - ?line expect([Rtt,{rtt,{?MODULE,exc_top,3}}, - ?LINE,{rft,{?MODULE,exc_top,3},Result}]), - ?line Result; - {value,_}=Result -> - - ?line expect([Rtt,{rtt,{?MODULE,exc_top,3}}, - ?LINE,{rft,{?MODULE,exc_top,3},Result}]), - ?line Result; - {exit,Reason}=CR -> - ?line expect({eft,{?MODULE,exc_top,3},CR}), - ?line {crash,Reason}; - {error,Reason}=CR -> - ?line expect({eft,{?MODULE,exc_top,3},CR}), - ?line {crash,{Reason,x_exc_stacktrace()}}; - CR -> - ?line expect({eft,{?MODULE,exc_top,3},CR}), - ?line {crash,CR} - end. + Rtt = not ExcOpts#exc_opts.meta, + expect({ctt,{?MODULE,exc_top},[ExcOpts,Func,Args]}), + case x_exc_jump(ExcOpts, Func, Args) of + Result when not ExcOpts#exc_opts.nocatch -> + expect([Rtt,{rtt,{?MODULE,exc_top,3}}, + ?LINE,{rft,{?MODULE,exc_top,3},Result}]), + Result; + {value,_}=Result -> + + expect([Rtt,{rtt,{?MODULE,exc_top,3}}, + ?LINE,{rft,{?MODULE,exc_top,3},Result}]), + Result; + {exit,Reason}=CR -> + expect({eft,{?MODULE,exc_top,3},CR}), + {crash,Reason}; + {error,Reason}=CR -> + expect({eft,{?MODULE,exc_top,3},CR}), + {crash,{Reason,x_exc_stacktrace()}}; + CR -> + expect({eft,{?MODULE,exc_top,3},CR}), + {crash,CR} + end. exc_jump(Func, Args) -> exc(Func, Args, jump). x_exc_jump(ExcOpts, Func, Args) -> - ?line expect({ctt,{?MODULE,exc_jump},[Func,Args]}), - ?line case x_exc(ExcOpts, Func, Args, jump) of - {value,Value}=Result -> - ?line expect({rft,{?MODULE,exc_jump,2},Value}), - ?line Result; - CR -> - ?line expect({eft,{?MODULE,exc_jump,2},CR}), - ?line CR - end. + expect({ctt,{?MODULE,exc_jump},[Func,Args]}), + case x_exc(ExcOpts, Func, Args, jump) of + {value,Value}=Result -> + expect({rft,{?MODULE,exc_jump,2},Value}), + Result; + CR -> + expect({eft,{?MODULE,exc_jump,2},CR}), + CR + end. exc(Func, Args, jump) -> exc(Func, Args, do); @@ -1059,25 +999,25 @@ exc(Func, Args, do) -> exc(Func, Args). x_exc(ExcOpts, Func, Args, jump) -> - ?line expect({ctt,{?MODULE,exc},[Func,Args,jump]}), - ?line case x_exc(ExcOpts, Func, Args, do) of - {value,Value}=Result -> - ?line expect({rft,{?MODULE,exc,3},Value}), - ?line Result; - CR -> - ?line expect({eft,{?MODULE,exc,3},CR}), - ?line CR - end; + expect({ctt,{?MODULE,exc},[Func,Args,jump]}), + case x_exc(ExcOpts, Func, Args, do) of + {value,Value}=Result -> + expect({rft,{?MODULE,exc,3},Value}), + Result; + CR -> + expect({eft,{?MODULE,exc,3},CR}), + CR + end; x_exc(ExcOpts, Func, Args, do) -> - ?line expect({ctt,{?MODULE,exc},[Func,Args,do]}), - ?line case x_exc(ExcOpts, Func, Args) of - {value,Value}=Result -> - ?line expect({rft,{?MODULE,exc,3},Value}), - ?line Result; - CR -> - ?line expect({eft,{?MODULE,exc,3},CR}), - ?line CR - end. + expect({ctt,{?MODULE,exc},[Func,Args,do]}), + case x_exc(ExcOpts, Func, Args) of + {value,Value}=Result -> + expect({rft,{?MODULE,exc,3},Value}), + Result; + CR -> + expect({eft,{?MODULE,exc,3},CR}), + CR + end. exc({erlang,apply}, [{M,F},A]) -> erlang:apply(M, F, id(A)); @@ -1107,114 +1047,114 @@ exc(Func, [A,B]) when is_function(Func, 2) -> Func(A, id(B)). x_exc(ExcOpts, {erlang,apply}=Func0, [{_,_}=Func,Args]=Args0) -> - ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}), - ?line x_exc_body(ExcOpts, Func, Args, true); + expect({ctt,{?MODULE,exc},[Func0,Args0]}), + x_exc_body(ExcOpts, Func, Args, true); x_exc(ExcOpts, {erlang,apply}=Func0, [Func,Args]=Args0) when is_function(Func, 2)-> - ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}), - ?line x_exc_func(ExcOpts, Func, Args, Args); + expect({ctt,{?MODULE,exc},[Func0,Args0]}), + x_exc_func(ExcOpts, Func, Args, Args); x_exc(ExcOpts, {_,_}=Func, Args) -> - ?line expect({ctt,{?MODULE,exc},[Func,Args]}), - ?line x_exc_body(ExcOpts, Func, Args, false); + expect({ctt,{?MODULE,exc},[Func,Args]}), + x_exc_body(ExcOpts, Func, Args, false); x_exc(ExcOpts, Func0, [_,Args]=Args0) when is_function(Func0, 2) -> - ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}), - ?line x_exc_func(ExcOpts, Func0, Args0, Args). + expect({ctt,{?MODULE,exc},[Func0,Args0]}), + x_exc_func(ExcOpts, Func0, Args0, Args). x_exc_func(ExcOpts, Func, [Func1,Args1]=Args, Id) -> %% Assumes the called fun =:= fun exc/2, %% will utterly fail otherwise. - ?line Rtt = not ExcOpts#exc_opts.meta, - ?line {module,M} = erlang:fun_info(Func, module), - ?line {name,F} = erlang:fun_info(Func, name), - ?line expect([{ctt,{?MODULE,id},[Id]}, - ?LINE,{rft,{?MODULE,id,1},Id}, - ?LINE,Rtt,{rtt,{?MODULE,exc,2}}, - ?LINE,{ctt,{M,F},Args}]), - ?line case x_exc(ExcOpts, Func1, Args1) of - {value,Value}=Result -> - ?line expect([{rft,{M,F,2},Value}, - ?LINE,{rft,{?MODULE,exc,2},Value}]), - ?line Result; - CR -> - ?line expect([{eft,{M,F,2},CR}, - ?LINE,{eft,{?MODULE,exc,2},CR}]), - ?line CR - end. + Rtt = not ExcOpts#exc_opts.meta, + {module,M} = erlang:fun_info(Func, module), + {name,F} = erlang:fun_info(Func, name), + expect([{ctt,{?MODULE,id},[Id]}, + ?LINE,{rft,{?MODULE,id,1},Id}, + ?LINE,Rtt,{rtt,{?MODULE,exc,2}}, + ?LINE,{ctt,{M,F},Args}]), + case x_exc(ExcOpts, Func1, Args1) of + {value,Value}=Result -> + expect([{rft,{M,F,2},Value}, + ?LINE,{rft,{?MODULE,exc,2},Value}]), + Result; + CR -> + expect([{eft,{M,F,2},CR}, + ?LINE,{eft,{?MODULE,exc,2},CR}]), + CR + end. x_exc_body(ExcOpts, {M,F}=Func, Args, Apply) -> - ?line Nocatch = ExcOpts#exc_opts.nocatch, - ?line Rtt = not ExcOpts#exc_opts.meta, - ?line Id = case Apply of - true -> Args; - false -> lists:last(Args) - end, - ?line expect([{ctt,{?MODULE,id},[Id]}, - ?LINE,{rft,{?MODULE,id,1},Id}, - ?LINE,Rtt,{rtt,{?MODULE,exc,2}}, - ?LINE,{ctt,{M,F},Args}]), - ?line Arity = length(Args), - ?line try exc(Func, Args) of - Value -> - ?line x_exc_value(Rtt, M, F, Args, Arity, Value), - ?line case expect() of - {rtt,{M,F,Arity}} when Rtt, Apply -> - %% We may get the above when - %% applying a BIF. - ?line expect({rft,{?MODULE,exc,2},Value}); - {rtt,{?MODULE,exc,2}} when Rtt, not Apply -> - %% We may get the above when - %% calling a BIF. - ?line expect({rft,{?MODULE,exc,2},Value}); - {rft,{?MODULE,exc,2},Value} -> - ?line ok - end, - ?line {value,Value} - catch - Thrown when Nocatch -> - ?line CR = {error,{nocatch,Thrown}}, - ?line x_exc_exception(Rtt, M, F, Args, Arity, CR), - ?line expect({eft,{?MODULE,exc,2},CR}), - ?line CR; - Class:Reason -> - ?line CR = {Class,Reason}, - ?line x_exc_exception(Rtt, M, F, Args, Arity, CR), - ?line expect({eft,{?MODULE,exc,2},CR}), - ?line CR - end. + Nocatch = ExcOpts#exc_opts.nocatch, + Rtt = not ExcOpts#exc_opts.meta, + Id = case Apply of + true -> Args; + false -> lists:last(Args) + end, + expect([{ctt,{?MODULE,id},[Id]}, + ?LINE,{rft,{?MODULE,id,1},Id}, + ?LINE,Rtt,{rtt,{?MODULE,exc,2}}, + ?LINE,{ctt,{M,F},Args}]), + Arity = length(Args), + try exc(Func, Args) of + Value -> + x_exc_value(Rtt, M, F, Args, Arity, Value), + case expect() of + {rtt,{M,F,Arity}} when Rtt, Apply -> + %% We may get the above when + %% applying a BIF. + expect({rft,{?MODULE,exc,2},Value}); + {rtt,{?MODULE,exc,2}} when Rtt, not Apply -> + %% We may get the above when + %% calling a BIF. + expect({rft,{?MODULE,exc,2},Value}); + {rft,{?MODULE,exc,2},Value} -> + ok + end, + {value,Value} + catch + Thrown when Nocatch -> + CR = {error,{nocatch,Thrown}}, + x_exc_exception(Rtt, M, F, Args, Arity, CR), + expect({eft,{?MODULE,exc,2},CR}), + CR; + Class:Reason -> + CR = {Class,Reason}, + x_exc_exception(Rtt, M, F, Args, Arity, CR), + expect({eft,{?MODULE,exc,2},CR}), + CR + end. x_exc_value(Rtt, ?MODULE, lists_reverse, [La,Lb], 2, R) -> - ?line L = lists:reverse(Lb, La), - ?line expect([fun ({ctt,{lists,reverse},[L1,L2]}) -> - ?line same(L, lists:reverse(L2, L1)), - ?line next; - (Msg) -> - ?line same({rft,{lists,reverse,2},R}, Msg), - ?line same(R, lists:reverse(L, [])), - ?line done - end, - ?LINE,Rtt,{rtt,{?MODULE,lists_reverse,2}}, - ?LINE,{rft,{?MODULE,lists_reverse,2},R}]); + L = lists:reverse(Lb, La), + expect([fun ({ctt,{lists,reverse},[L1,L2]}) -> + same(L, lists:reverse(L2, L1)), + next; + (Msg) -> + same({rft,{lists,reverse,2},R}, Msg), + same(R, lists:reverse(L, [])), + done + end, + ?LINE,Rtt,{rtt,{?MODULE,lists_reverse,2}}, + ?LINE,{rft,{?MODULE,lists_reverse,2},R}]); x_exc_value(_Rtt, M, F, _, Arity, Value) -> - ?line expect({rft,{M,F,Arity},Value}). + expect({rft,{M,F,Arity},Value}). x_exc_exception(_Rtt, ?MODULE, lists_reverse, [La,Lb], 2, CR) -> - ?line L = lists:reverse(Lb, La), - ?line expect([fun ({ctt,{lists,reverse},[L1,L2]}) -> - ?line same(L, lists:reverse(L2, L1)), - ?line next; - (Msg) -> - ?line same({eft,{lists,reverse,2},CR}, Msg), - ?line done - end, - ?LINE,{eft,{?MODULE,lists_reverse,2},CR}]); + L = lists:reverse(Lb, La), + expect([fun ({ctt,{lists,reverse},[L1,L2]}) -> + same(L, lists:reverse(L2, L1)), + next; + (Msg) -> + same({eft,{lists,reverse,2},CR}, Msg), + done + end, + ?LINE,{eft,{?MODULE,lists_reverse,2},CR}]); x_exc_exception(Rtt, ?MODULE, undef, [_], 1, {Class,Reason}=CR) -> - ?line expect([{ctt,{erlang,Class},[Reason]}, - ?LINE,{eft,{erlang,Class,1},CR}, - ?LINE,Rtt,{rtt,{error_handler,crash,1}}, - ?LINE,{eft,{?MODULE,undef,1},CR}]); + expect([{ctt,{erlang,Class},[Reason]}, + ?LINE,{eft,{erlang,Class,1},CR}, + ?LINE,Rtt,{rtt,{error_handler,crash,1}}, + ?LINE,{eft,{?MODULE,undef,1},CR}]); x_exc_exception(_Rtt, M, F, _, Arity, CR) -> - ?line expect({eft,{M,F,Arity},CR}). + expect({eft,{M,F,Arity},CR}). x_exc_stacktrace() -> x_exc_stacktrace(erlang:get_stacktrace()). @@ -1251,24 +1191,24 @@ lists_reverse(A, B) -> slave(Dest, Sync) -> Dest ! Sync, receive - {From,Tag,{apply,M,F,A}} when is_pid(From) -> - ?line ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), - ?line Res = apply(M,F,A), - ?line ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), - From ! {Tag,Res}, - slave(From, Tag); - {From,Tag,{lambda,Fun}} when is_pid(From) -> - Res = Fun(), - From ! {Tag,Res}, - slave(From, Tag); - {From,Tag,{exc_top,Catch,Func,Args}} when is_pid(From) -> - ?line ?dbgformat("Exc: ~p ~p~p ~n",[Catch,Func,Args]), - ?line Res = exc_top(Catch, Func, Args), - ?line ?dbgformat("done Exc: ~p ~p~p ~n",[Catch,Func,Args]), - From ! {Tag,Res}, - slave(From,Tag); - die -> - exit(normal) + {From,Tag,{apply,M,F,A}} when is_pid(From) -> + ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + Res = apply(M,F,A), + ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + From ! {Tag,Res}, + slave(From, Tag); + {From,Tag,{lambda,Fun}} when is_pid(From) -> + Res = Fun(), + From ! {Tag,Res}, + slave(From, Tag); + {From,Tag,{exc_top,Catch,Func,Args}} when is_pid(From) -> + ?dbgformat("Exc: ~p ~p~p ~n",[Catch,Func,Args]), + Res = exc_top(Catch, Func, Args), + ?dbgformat("done Exc: ~p ~p~p ~n",[Catch,Func,Args]), + From ! {Tag,Res}, + slave(From,Tag); + die -> + exit(normal) end. setup(ProcFlags) -> @@ -1279,30 +1219,34 @@ setup(ProcFlags) -> Pid = spawn(fun () -> slave(Self, Sync) end), Mref = erlang:monitor(process, Pid), receive - Sync -> - put(slave, {Pid,Mref}), - case ProcFlags of - [] -> ok; - _ -> - erlang:trace(Pid, true, ProcFlags) - end, - Pid + Sync -> + put(slave, {Pid,Mref}), + case ProcFlags of + [] -> ok; + _ -> + erlang:trace(Pid, true, ProcFlags) + end, + Pid end. shutdown() -> trace_off(), - {Pid,Mref} = get(slave), - try erlang:is_process_alive(Pid) of - true -> - Pid ! die, - receive - {'DOWN',Mref,process,Pid,Reason} -> - Reason - end; - _ -> - not_alive - catch _:_ -> - undefined + case get(slave) of + {Pid,Mref} -> + try erlang:is_process_alive(Pid) of + true -> + Pid ! die, + receive + {'DOWN',Mref,process,Pid,Reason} -> + Reason + end; + _ -> + not_alive + catch _:_ -> + undefined + end; + _ -> + undefined end. trace_off() -> @@ -1310,7 +1254,7 @@ trace_off() -> erlang:trace_pattern({'_','_','_'},false,[local]), erlang:trace_pattern({'_','_','_'},false,[meta]), erlang:trace(all, false, [all]). - + apply_slave_async(M,F,A) -> {Pid,Mref} = get(slave), @@ -1331,8 +1275,8 @@ lambda_slave(Fun) -> exc_slave(Opts, Func, Args) -> try request({exc_top,Opts,Func,Args}) catch - Reason -> - {crash,Reason} + Reason -> + {crash,Reason} end. request(Request) -> @@ -1343,13 +1287,13 @@ request(Request) -> result(Tag, Mref) -> receive - {Tag,Result} -> - receive - Tag -> - Result - end; - {'DOWN',Mref,process,_Pid,Reason} -> - throw(Reason) + {Tag,Result} -> + receive + Tag -> + Result + end; + {'DOWN',Mref,process,_Pid,Reason} -> + throw(Reason) end. @@ -1362,25 +1306,25 @@ receive_next() -> receive_next(TO) -> receive - M -> - M + M -> + M after TO -> - ?t:fail(timeout) + ct:fail(timeout) end. receive_no_next(TO) -> receive M -> - ?t:fail({unexpected_message,[M|flush(TO)]}) + ct:fail({unexpected_message,[M|flush(TO)]}) after TO -> - ok + ok end. flush(T) -> receive - M -> - [M|flush(T)] + M -> + [M|flush(T)] after T -> - [] + [] end. @@ -1415,19 +1359,19 @@ abbr(Term, _) -> Term. %% abbr_tuple(Tuple, N, J) when J =< size(Tuple) -> if J > N; N =< 0 -> - ['...']; + ['...']; true -> - [abbr(element(J, Tuple), N-1)|abbr_tuple(Tuple, J+1, N)] + [abbr(element(J, Tuple), N-1)|abbr_tuple(Tuple, J+1, N)] end; abbr_tuple(_, _, _) -> []. %% abbr_list(_, 0, R) -> case io_lib:printable_list(R) of - true -> - reverse(R, "..."); - false -> - reverse(R, '...') + true -> + reverse(R, "..."); + false -> + reverse(R, '...') end; abbr_list([H|T], N, R) -> M = N-1, diff --git a/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl b/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl index be9bea209a..a886323302 100644 --- a/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl +++ b/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl index 45987cc319..f157a6c9eb 100644 --- a/erts/emulator/test/trace_meta_SUITE.erl +++ b/erts/emulator/test/trace_meta_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -45,7 +46,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). @@ -65,22 +66,21 @@ config(priv_dir,_) -> ".". -else. %% When run in test server. --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2, not_run/1]). -export([basic/1, return/1, on_and_off/1, stack_grow/1, info/1, tracer/1, combo/1, nosilent/1]). init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(5)), - [{watchdog, Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> +end_per_testcase(_Case, _Config) -> shutdown(), - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> case test_server:is_native(trace_meta_SUITE) of @@ -90,74 +90,39 @@ case test_server:is_native(trace_meta_SUITE) of combo, nosilent] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -basic(suite) -> - []; -basic(doc) -> - ["Tests basic meta trace"]; +%% Tests basic meta trace basic(Config) when is_list(Config) -> basic_test(). -return(suite) -> - []; -return(doc) -> - ["Tests return trace"]; +%% Tests return trace return(Config) when is_list(Config) -> return_test(). -on_and_off(suite) -> - []; -on_and_off(doc) -> - ["Tests turning trace parameters on and off"]; +%% Tests turning trace parameters on and off on_and_off(Config) when is_list(Config) -> on_and_off_test(). -stack_grow(doc) -> - ["Tests the stack growth during return traces"]; +%% Tests the stack growth during return traces stack_grow(Config) when is_list(Config) -> stack_grow_test(). -info(doc) -> - ["Tests the trace_info BIF"]; +%% Tests the trace_info BIF info(Config) when is_list(Config) -> info_test(). -tracer(suite) -> - []; -tracer(doc) -> - ["Tests stopping and changing tracer process"]; +%% Tests stopping and changing tracer process tracer(Config) when is_list(Config) -> tracer_test(). -combo(suite) -> - []; -combo(doc) -> - ["Tests combining local call trace with meta trace"]; +%% Tests combining local call trace with meta trace combo(Config) when is_list(Config) -> combo_test(). -nosilent(suite) -> - []; -nosilent(doc) -> - ["Tests that meta trace is not silenced by the silent process flag"]; +%% Tests that meta trace is not silenced by the silent process flag nosilent(Config) when is_list(Config) -> nosilent_test(). @@ -179,107 +144,112 @@ nosilent(Config) when is_list(Config) -> %%% basic_test() -> - ?line Pid = setup(), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?NM, - ?line [1,1,1,0] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?NM, - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), - ?line [1,1,1,0] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), - ?line shutdown(), - ?line ?NM, + Pid = setup(), + erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?NM, + [1,1,1,0] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?NM, + erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), + [1,1,1,0] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% return_test() -> - ?line Pid = setup(), - ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + Pid = setup(), + erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], [meta]), - ?line erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], + erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], [meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), - ?line ?RFT(Pid,{erlang,phash2,2},0) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(), - ?line shutdown(), - ?line ?NM, + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), + ?RFT(Pid,{erlang,phash2,2},0) = receive_next(), + ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% on_and_off_test() -> - ?line Pid = setup(), - ?line 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]), - ?line LocalTail = fun() -> - local_tail(1) - end, - ?line [1,0] = lambda_slave(LocalTail), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), - ?line [1,0] = lambda_slave(LocalTail), - ?line ?NM, - ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), - ?line shutdown(), - ?line erlang:trace_pattern({'_','_','_'},false,[meta]), - ?line N = erlang:trace_pattern({erlang,'_','_'},true,[meta]), - ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of - N -> - ok; - Else -> - exit({number_mismatch, {expected, N}, {got, Else}}) - end, - ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of - N -> - ok; - Else2 -> - exit({number_mismatch, {expected, N}, {got, Else2}}) - end, - ?line ?NM, + Pid = setup(), + 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]), + LocalTail = fun() -> + local_tail(1) + end, + [1,0] = lambda_slave(LocalTail), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), + [1,0] = lambda_slave(LocalTail), + ?NM, + 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), + shutdown(), + erlang:trace_pattern({'_','_','_'},false,[meta]), + N = erlang:trace_pattern({erlang,'_','_'},true,[meta]), + case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of + N -> ok; + Else -> + exit({number_mismatch, {expected, N}, {got, Else}}) + end, + case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of + N -> ok; + Else2 -> + exit({number_mismatch, {expected, N}, {got, Else2}}) + end, + %% ?NM, + %% Can't check for erlang:*/* stuff since common_test or test_server + %% will likely call list_to_binary in the logger. just drain any potential + %% message + ok = flush(), ok. - + +flush() -> + receive _ -> flush() after 0 -> ok end. + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% stack_grow_test() -> - ?line Pid = setup(), - ?line 1 = erlang:trace_pattern({?MODULE,loop,4}, + Pid = setup(), + 1 = erlang:trace_pattern({?MODULE,loop,4}, [{'_',[],[{return_trace}]}],[meta]), - ?line Num = 1 bsl 15, - ?line Surface = + Num = 1 bsl 15, + Surface = fun (This, ?RFT(P,{?MODULE,loop,4},N), N) when P == Pid-> if N == Num -> ?NM, @@ -288,7 +258,7 @@ stack_grow_test() -> This(This, receive_next(), N+1) end end, - ?line Dive = + Dive = fun (This, ?CTT(P,{?MODULE,loop,[{hej,hopp},[a,b,c],4.5,N]}), N) when P == Pid-> if N == 0 -> @@ -297,272 +267,263 @@ stack_grow_test() -> This(This, receive_next(), N-1) end end, - ?line apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), -% ?line apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), -% ?line List = collect(test_server:seconds(5)), - ?line ok = Dive(Dive, receive_next(), Num), - ?line ?NM, + apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), +% apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), +% List = collect(test_server:seconds(5)), + ok = Dive(Dive, receive_next(), Num), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% info_test() -> - ?line setup(), - ?line Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, - {'_',[],[]}], - ?line Self = self(), - ?line GoOn = make_ref(), - - ?line Pid = + setup(), + Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, {'_',[],[]}], + Self = self(), + GoOn = make_ref(), + Pid = spawn_link( fun () -> erlang:trace_pattern({?MODULE,exported_wrap,1}, - Prog, [{meta, Self}]), + Prog, [{meta, Self}]), Self ! {self(), GoOn} end), - ?line receive {Pid, GoOn} -> ok end, - ?line {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced), - ?line {match_spec, false} = + receive {Pid, GoOn} -> ok end, + {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced), + {match_spec, false} = erlang:trace_info({?MODULE,exported_wrap,1}, match_spec), - ?line {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), - ?line {meta_match_spec, MMS} = + {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), + {meta_match_spec, MMS} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line case MMS of - Prog -> - ok; - Wrong -> - exit({bad_result, {erlang,trace_info, - [{?MODULE,exported_wrap,1}, - meta_match_spec]}, - {expected, Prog}, {got, Wrong}}) - end, - ?line erlang:garbage_collect(self()), - ?line receive - after 1 -> - ok - end, - ?line io:format("~p~n",[MMS]), - ?line {meta_match_spec,MMS2} = + case MMS of + Prog -> + ok; + Wrong -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + meta_match_spec]}, + {expected, Prog}, {got, Wrong}}) + end, + erlang:garbage_collect(self()), + receive + after 1 -> + ok + end, + io:format("~p~n",[MMS]), + {meta_match_spec,MMS2} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line io:format("~p~n",[MMS2]), - ?line case MMS2 of - Prog -> - ok; - Wrong2 -> - exit({bad_result, {erlang,trace_info, - [{?MODULE,exported_wrap,1}, - meta_match_spec]}, - {expected, Prog}, {got, Wrong2}}) - end, - ?line {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all), - ?line {value, {meta, Self}} = - lists:keysearch(meta, 1, L), - ?line {value, {meta_match_spec, MMS}} = - lists:keysearch(meta_match_spec, 1, L), - - ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]), - ?line {meta_match_spec, []} = + io:format("~p~n",[MMS2]), + case MMS2 of + Prog -> + ok; + Wrong2 -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + meta_match_spec]}, + {expected, Prog}, {got, Wrong2}}) + end, + {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all), + {value, {meta, Self}} = lists:keysearch(meta, 1, L), + {value, {meta_match_spec, MMS}} = lists:keysearch(meta_match_spec, 1, L), + + erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]), + {meta_match_spec, []} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - - ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]), - ?line {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), - ?line {meta_match_spec, false} = + + erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]), + {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), + {meta_match_spec, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all), - - ?line shutdown(), - ?line ?NM, + {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% tracer_test() -> - ?line Slave = setup(), - ?line Self = self(), - - ?line MatchSpec = [{'_',[],[{return_trace}]}], - ?line Tracer1 = spawn_link(fun () -> relay_n(3, Self) end), - ?line Setter = - spawn_link( - fun () -> - erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer1}]), - erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer1}]), - Self ! {self(), done} - end), - ?line receive {Setter, done} -> ok end, - ?line Ref = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref]), - ?line {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100), - ?line {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100), - ?line {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100), + Slave = setup(), + Self = self(), + + MatchSpec = [{'_',[],[{return_trace}]}], + Tracer1 = spawn_link(fun () -> relay_n(3, Self) end), + Setter = spawn_link( + fun () -> + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer1}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer1}]), + Self ! {self(), done} + end), + receive {Setter, done} -> ok end, + Ref = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref]), + {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100), + {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100), + {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100), %% Initiate a return_trace that will fail since the tracer just stopped - ?line Slave ! Ref, - ?line receive_no_next(100), + Slave ! Ref, + receive_no_next(100), %% The breakpoint has not been hit since the tracer stopped - ?line {meta,Tracer1} = + {meta,Tracer1} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,Tracer1} = + {meta,Tracer1} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), %% Initiate trace messages that will fail - ?line Ref2 = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref2]), - ?line Slave ! Ref2, - ?line receive_no_next(100), - ?line {meta,[]} = + Ref2 = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref2]), + Slave ! Ref2, + receive_no_next(100), + {meta,[]} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,[]} = + {meta,[]} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), %% Change tracer - ?line Tracer2 = spawn_link(fun () -> relay_n(4, Self) end), - ?line erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer2}]), - ?line erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer2}]), - ?line Ref3 = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref3]), - ?line {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(), - ?line {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), - ?line {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), + Tracer2 = spawn_link(fun () -> relay_n(4, Self) end), + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer2}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer2}]), + Ref3 = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref3]), + {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(), + {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), + {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), %% Change tracer between call trace and return trace - ?line Tracer3 = spawn_link(fun () -> relay_n(4, Self) end), - ?line erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer3}]), - ?line erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer3}]), - ?line Slave ! Ref3, + Tracer3 = spawn_link(fun () -> relay_n(4, Self) end), + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer3}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer3}]), + Slave ! Ref3, %% The return trace should still come from Tracer2 - ?line {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(), - ?line Ref4 = make_ref(), + {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(), + Ref4 = make_ref(), %% Now should Tracer3 be used - ?line apply_slave_async(?MODULE, receiver, [Ref4]), - ?line Slave ! Ref4, - ?line {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(), - ?line {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), - ?line {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), - ?line {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(), + apply_slave_async(?MODULE, receiver, [Ref4]), + Slave ! Ref4, + {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(), + {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), + {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), + {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(), %% The breakpoint has not been hit since the tracer stopped - ?line {meta,Tracer3} = - erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta,Tracer3} = erlang:trace_info({?MODULE,receiver,1}, meta), + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,Tracer3} = + {meta,Tracer3} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), - - ?line shutdown(), - ?line ?NM, + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% combo_test() -> - ?line Slave = setup(), - ?line Self = self(), - - ?line MatchSpec = [{'_',[],[{return_trace}]}], - ?line Flags = lists:sort([call, return_to]), - ?line LocalTracer = spawn_link(fun () -> relay_n(6, Self) end), - ?line MetaTracer = spawn_link(fun () -> relay_n(4, Self) end), - ?line 1 = erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [local,{meta,MetaTracer}]), - ?line 1 = erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [local,{meta,MetaTracer}]), - ?line 1 = erlang:trace(Slave, true, - [{tracer,LocalTracer} | Flags]), + Slave = setup(), + Self = self(), + + MatchSpec = [{'_',[],[{return_trace}]}], + Flags = lists:sort([call, return_to]), + LocalTracer = spawn_link(fun () -> relay_n(6, Self) end), + MetaTracer = spawn_link(fun () -> relay_n(4, Self) end), + 1 = erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [local,{meta,MetaTracer}]), + 1 = erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [local,{meta,MetaTracer}]), + 1 = erlang:trace(Slave, true, + [{tracer,LocalTracer} | Flags]), %% - ?line {all, TraceInfo1} = + {all, TraceInfo1} = erlang:trace_info({?MODULE,receiver,1}, all), - ?line {meta,MetaTracer} = + {meta,MetaTracer} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {value,{meta,MetaTracer}} = + {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo1), - ?line {meta_match_spec,MatchSpec} = + {meta_match_spec,MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {value,{meta_match_spec,MatchSpec}} = + {value,{meta_match_spec,MatchSpec}} = lists:keysearch(meta_match_spec, 1, TraceInfo1), - ?line {traced,local} = + {traced,local} = erlang:trace_info({?MODULE,receiver,1}, traced), - ?line {value,{traced,local}} = + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo1), - ?line {match_spec,MatchSpec} = + {match_spec,MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, match_spec), - ?line {value,{match_spec,MatchSpec}} = + {value,{match_spec,MatchSpec}} = lists:keysearch(match_spec, 1, TraceInfo1), %% - ?line {all, TraceInfo2} = + {all, TraceInfo2} = erlang:trace_info({erlang,phash2,2}, all), - ?line {meta,MetaTracer} = + {meta,MetaTracer} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {value,{meta,MetaTracer}} = + {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo2), - ?line {meta_match_spec,MatchSpec} = + {meta_match_spec,MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), - ?line {value,{meta_match_spec,MatchSpec}} = + {value,{meta_match_spec,MatchSpec}} = lists:keysearch(meta_match_spec, 1, TraceInfo2), - ?line {traced,local} = + {traced,local} = erlang:trace_info({erlang,phash2,2}, traced), - ?line {value,{traced,local}} = + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo2), - ?line {match_spec,MatchSpec} = + {match_spec,MatchSpec} = erlang:trace_info({erlang,phash2,2}, match_spec), - ?line {value,{match_spec,MatchSpec}} = + {value,{match_spec,MatchSpec}} = lists:keysearch(match_spec, 1, TraceInfo2), %% - ?line {flags,Flags1} = erlang:trace_info(Slave, flags), - ?line Flags = lists:sort(Flags1), - ?line {tracer,LocalTracer} = erlang:trace_info(Slave, tracer), + {flags,Flags1} = erlang:trace_info(Slave, flags), + Flags = lists:sort(Flags1), + {tracer,LocalTracer} = erlang:trace_info(Slave, tracer), %% - ?line Ref = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref]), - ?line Slave ! Ref, - ?line ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer), - ?line ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer), - ?line ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer), - ?line ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer), - ?line ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer), - ?line ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer), - ?line case {receive_next_bytag(LocalTracer), + Ref = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref]), + Slave ! Ref, + ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer), + ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer), + ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer), + ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer), + ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer), + ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer), + case {receive_next_bytag(LocalTracer), receive_next_bytag(LocalTracer)} of {?RF(Slave,{erlang,phash2,2},0), ?RT(Slave,{?MODULE,receiver,1})} -> - ?line ok; + ok; {?RT(Slave,{?MODULE,receiver,1}), ?RF(Slave,{erlang,phash2,2},0)} -> - ?line ok; - Error1 -> ?t:fail({unexpected_message, Error1}) + ok; + Error1 -> ct:fail({unexpected_message, Error1}) end, - ?line case {receive_next_bytag(LocalTracer), + case {receive_next_bytag(LocalTracer), receive_next_bytag(LocalTracer)} of {?RF(Slave,{?MODULE,receiver,1},Ref), ?RT(Slave,{?MODULE,slave,1})} -> - ?line ok; + ok; {?RT(Slave,{?MODULE,slave,1}), ?RF(Slave,{?MODULE,receiver,1},Ref)} -> - ?line ok; - Error2 -> ?t:fail({unexpected_message, Error2}) + ok; + Error2 -> ct:fail({unexpected_message, Error2}) end, - - ?line shutdown(), - ?line ?NM, + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -570,38 +531,38 @@ combo_test() -> %% Setup silent local call tracing, and start it using meta trace. nosilent_test() -> - ?line Pid = setup(), - ?line Trigger = {?MODULE,id,1}, - ?line TriggerMS = [{[start],[],[{silent,false}]}, - {[stop],[],[{silent,true},{return_trace}]}], - ?line 1 = erlang:trace(Pid, true, [call,silent,return_to]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), - ?line 1 = erlang:trace_pattern({?MODULE,local2,1}, - [{'_',[],[{return_trace}]}], - [local]), - ?line 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]), - ?line 1 = erlang:trace_pattern(Trigger,false,[local]), - ?line 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line receive_no_next(17), - ?line start = apply_slave(?MODULE, id, [start]), - ?line ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(), - ?line [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]), - ?line ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(), - ?line ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(), - ?line ?RT(Pid,{?MODULE,local,1}) = receive_next(), - ?line ?RT(Pid,{?MODULE,exported,1}) = receive_next(), - ?line ?RT(Pid,{?MODULE,slave,1}) = receive_next(), - ?line stop = apply_slave(?MODULE, id, [stop]), - ?line ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(), - ?line ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(), - ?line [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]), - ?line receive_no_next(17), - ?line shutdown(), + Pid = setup(), + Trigger = {?MODULE,id,1}, + TriggerMS = [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true},{return_trace}]}], + 1 = erlang:trace(Pid, true, [call,silent,return_to]), + erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + 1 = erlang:trace_pattern({?MODULE,local2,1}, + [{'_',[],[{return_trace}]}], + [local]), + 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]), + 1 = erlang:trace_pattern(Trigger,false,[local]), + 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + receive_no_next(17), + start = apply_slave(?MODULE, id, [start]), + ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(), + [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]), + ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(), + ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(), + ?RT(Pid,{?MODULE,local,1}) = receive_next(), + ?RT(Pid,{?MODULE,exported,1}) = receive_next(), + ?RT(Pid,{?MODULE,slave,1}) = receive_next(), + stop = apply_slave(?MODULE, id, [stop]), + ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(), + ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(), + [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]), + receive_no_next(17), + shutdown(), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -645,9 +606,9 @@ slave(Sync) -> Sync ! sync, receive {From,apply, M, F, A} -> - ?line ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), - ?line Res = apply(M,F,A), - ?line ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + Res = apply(M,F,A), + ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), From ! {apply, Res}, erlang:trace_pattern({?MODULE,slave,1},false,[meta]), slave(From); @@ -748,13 +709,13 @@ receive_next(TO) -> M -> M after TO -> - ?t:fail(timeout) + ct:fail(timeout) end. receive_no_next(TO) -> receive M -> - ?t:fail({unexpected_message, M}) + ct:fail({unexpected_message, M}) after TO -> ok diff --git a/erts/emulator/test/trace_nif_SUITE.erl b/erts/emulator/test/trace_nif_SUITE.erl index a7484a22fd..f796b9d667 100644 --- a/erts/emulator/test/trace_nif_SUITE.erl +++ b/erts/emulator/test/trace_nif_SUITE.erl @@ -1,28 +1,28 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(trace_nif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0]). -export([trace_nif/1, trace_nif_timestamp/1, trace_nif_local/1, @@ -44,264 +44,243 @@ all() -> trace_nif_return] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -trace_nif(doc) -> "Test tracing NIFs."; +%% Test tracing NIFs. trace_nif(Config) when is_list(Config) -> load_nif(Config), - + do_trace_nif([]). -trace_nif_local(doc) -> "Test tracing NIFs with local flag."; +%% Test tracing NIFs with local flag. trace_nif_local(Config) when is_list(Config) -> load_nif(Config), do_trace_nif([local]). -trace_nif_meta(doc) -> "Test tracing NIFs with meta flag."; +%% Test tracing NIFs with meta flag. trace_nif_meta(Config) when is_list(Config) -> load_nif(Config), - ?line Pid=spawn_link(?MODULE, nif_process, []), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], [meta]), - - ?line Pid ! {apply_nif, nif, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), - - ?line Pid ! {apply_nif, nif, ["Arg1"]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, ["Arg1"]}}), - - ?line Pid ! {call_nif, nif, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, []}}), - - ?line Pid ! {call_nif, nif, ["Arg1"]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, ["Arg1"]}}), + Pid=spawn_link(?MODULE, nif_process, []), + erlang:trace_pattern({?MODULE,nif,'_'}, [], [meta]), + + Pid ! {apply_nif, nif, []}, + receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), + + Pid ! {apply_nif, nif, ["Arg1"]}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + + Pid ! {call_nif, nif, []}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, []}}), + + Pid ! {call_nif, nif, ["Arg1"]}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), ok. do_trace_nif(Flags) -> - ?line Pid = spawn(?MODULE, nif_process, []), - ?line 1 = erlang:trace(Pid, true, [call]), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), - ?line Pid ! {apply_nif, nif, []}, - ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}), - ?line Pid ! {apply_nif, nif, ["Arg1"]}, - ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}), + Pid = spawn_link(?MODULE, nif_process, []), + 1 = erlang:trace(Pid, true, [call]), + erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), + Pid ! {apply_nif, nif, []}, + receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}), + Pid ! {apply_nif, nif, ["Arg1"]}, + receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}), + + Pid ! {call_nif, nif, []}, + receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}), - ?line Pid ! {call_nif, nif, []}, - ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}), + Pid ! {call_nif, nif, ["Arg1"]}, + receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}), - ?line Pid ! {call_nif, nif, ["Arg1"]}, - ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}), - %% Switch off - ?line 1 = erlang:trace(Pid, false, [call]), + 1 = erlang:trace(Pid, false, [call]), - ?line Pid ! {apply_nif, nif, []}, + Pid ! {apply_nif, nif, []}, receive_nothing(), - ?line Pid ! {apply_nif, nif, ["Arg1"]}, + Pid ! {apply_nif, nif, ["Arg1"]}, receive_nothing(), - ?line Pid ! {call_nif, nif, []}, + Pid ! {call_nif, nif, []}, receive_nothing(), - ?line Pid ! {call_nif, nif, ["Arg1"]}, + Pid ! {call_nif, nif, ["Arg1"]}, receive_nothing(), %% Switch on again - ?line 1 = erlang:trace(Pid, true, [call]), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), - ?line Pid ! {apply_nif, nif, []}, - ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}), - ?line Pid ! {apply_nif, nif, ["Arg1"]}, - ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}), - - ?line Pid ! {call_nif, nif, []}, - ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}), - - ?line Pid ! {call_nif, nif, ["Arg1"]}, - ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}), - - ?line 1 = erlang:trace(Pid, false, [call]), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, false, Flags), - ?line exit(Pid, die), + 1 = erlang:trace(Pid, true, [call]), + erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), + Pid ! {apply_nif, nif, []}, + receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}), + Pid ! {apply_nif, nif, ["Arg1"]}, + receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}), + + Pid ! {call_nif, nif, []}, + receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}), + + Pid ! {call_nif, nif, ["Arg1"]}, + receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}), + + 1 = erlang:trace(Pid, false, [call]), + erlang:trace_pattern({?MODULE,nif,'_'}, false, Flags), + + unlink(Pid), + exit(Pid, die), ok. -trace_nif_timestamp(doc) -> "Test tracing NIFs with timestamps."; +%% Test tracing NIFs with timestamps. trace_nif_timestamp(Config) when is_list(Config) -> load_nif(Config), do_trace_nif_timestamp([]). -trace_nif_timestamp_local(doc) -> - "Test tracing NIFs with timestamps and local flag."; +%% Test tracing NIFs with timestamps and local flag. trace_nif_timestamp_local(Config) when is_list(Config) -> load_nif(Config), do_trace_nif_timestamp([local]). do_trace_nif_timestamp(Flags) -> - ?line Pid=spawn(?MODULE, nif_process, []), - ?line 1 = erlang:trace(Pid, true, [call,timestamp]), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), - - ?line Pid ! {apply_nif, nif, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), - - ?line Pid ! {apply_nif, nif, ["Arg1"]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, ["Arg1"]}}), - - ?line Pid ! {call_nif, nif, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, []}}), - - ?line Pid ! {call_nif, nif, ["Arg1"]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, ["Arg1"]}}), - + Pid = spawn_link(?MODULE, nif_process, []), + 1 = erlang:trace(Pid, true, [call,timestamp]), + erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), + + Pid ! {apply_nif, nif, []}, + receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), + + Pid ! {apply_nif, nif, ["Arg1"]}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + + Pid ! {call_nif, nif, []}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, []}}), + + Pid ! {call_nif, nif, ["Arg1"]}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + %% We should be able to turn off the timestamp. - ?line 1 = erlang:trace(Pid, false, [timestamp]), - - ?line Pid ! {call_nif, nif, []}, - ?line receive_trace_msg({trace,Pid,call, - {?MODULE,nif, []}}), - - ?line Pid ! {apply_nif, nif, ["tjoho"]}, - ?line receive_trace_msg({trace,Pid,call, - {?MODULE,nif, ["tjoho"]}}), - - ?line 1 = erlang:trace(Pid, false, [call]), - ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags), - - ?line exit(Pid, die), + 1 = erlang:trace(Pid, false, [timestamp]), + + Pid ! {call_nif, nif, []}, + receive_trace_msg({trace,Pid,call, + {?MODULE,nif, []}}), + + Pid ! {apply_nif, nif, ["tjoho"]}, + receive_trace_msg({trace,Pid,call, + {?MODULE,nif, ["tjoho"]}}), + + 1 = erlang:trace(Pid, false, [call]), + erlang:trace_pattern({erlang,'_','_'}, false, Flags), + + unlink(Pid), + exit(Pid, die), ok. -trace_nif_return(doc) -> - "Test tracing NIF's with return/return_to trace."; +%% Test tracing NIF's with return/return_to trace. trace_nif_return(Config) when is_list(Config) -> load_nif(Config), - ?line Pid=spawn(?MODULE, nif_process, []), - ?line 1 = erlang:trace(Pid, true, [call,timestamp,return_to]), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, [{'_',[],[{return_trace}]}], - [local]), - - ?line Pid ! {apply_nif, nif, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {?MODULE,nif,0}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, nif_process,0}}), - - ?line Pid ! {call_nif, nif, ["Arg1"]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, ["Arg1"]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {?MODULE,nif,1}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, nif_process,0}}), + Pid = spawn_link(?MODULE, nif_process, []), + 1 = erlang:trace(Pid, true, [call,timestamp,return_to]), + erlang:trace_pattern({?MODULE,nif,'_'}, [{'_',[],[{return_trace}]}], + [local]), + + Pid ! {apply_nif, nif, []}, + receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), + receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {?MODULE,nif,0}}), + receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, nif_process,0}}), + + Pid ! {call_nif, nif, ["Arg1"]}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {?MODULE,nif,1}}), + receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, nif_process,0}}), ok. receive_trace_msg(Mess) -> receive - Mess -> - ok; - Other -> - io:format("Expected: ~p,~nGot: ~p~n", [Mess, Other]), - ?t:fail() + Mess -> + ok; + Other -> + ct:fail("Expected: ~p,~nGot: ~p~n", [Mess, Other]) after 5000 -> - io:format("Expected: ~p,~nGot: timeout~n", [Mess]), - ?t:fail() + ct:fail("Expected: ~p,~nGot: timeout~n", [Mess]) end. receive_nothing() -> - ?line timeout = receive M -> M after 100 -> timeout end. + timeout = receive M -> M after 100 -> timeout end. receive_trace_msg_ts({trace_ts, Pid, call, {M,F,A}}) -> receive - {trace_ts, Pid, call, {M, F, A}, _Ts} -> - ok; - Other -> - io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" - "Got: ~p~n", - [Pid, M, F, A, Other]), - ?t:fail() + {trace_ts, Pid, call, {M, F, A}, _Ts} -> + ok; + Other -> + ct:fail("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", [Pid, M, F, A, Other]) after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + ct:fail("Got timeout~n", []) end. receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {M,F,A}}) -> receive - {trace_ts, Pid, return_from, {M, F, A}, _Value, _Ts} -> - ok; - Other -> - io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" - "Got: ~p~n", - [Pid, M, F, A, Other]), - ?t:fail() + {trace_ts, Pid, return_from, {M, F, A}, _Value, _Ts} -> + ok; + Other -> + ct:fail("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" + "Got: ~p~n", [Pid, M, F, A, Other]) after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + ct:fail("Got timeout~n", []) end. receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) -> receive - {trace_ts, Pid, return_to, {M, F, A}, _Ts} -> - ok; - Other -> - io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" - "Got: ~p~n", - [Pid, M, F, A, Other]), - ?t:fail() + {trace_ts, Pid, return_to, {M, F, A}, _Ts} -> + ok; + Other -> + ct:fail("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", [Pid, M, F, A, Other]) after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + ct:fail("Got timeout~n", []) end. nif_process() -> receive - {apply_nif, Name, Args} -> - ?line {ok,Args} = apply(?MODULE, Name, Args); - - {call_nif, Name, []} -> - ?line {ok, []} = ?MODULE:Name(); - - {call_nif, Name, [A1]} -> - ?line {ok, [A1]} = ?MODULE:Name(A1); - - {call_nif, Name, [A1,A2]} -> - ?line {ok,[A1,A2]} = ?MODULE:Name(A1,A2); - - {call_nif, Name, [A1,A2,A3]} -> - ?line {ok,[A1,A2,A3]} = ?MODULE:Name(A1,A2,A3) + {apply_nif, Name, Args} -> + {ok,Args} = apply(?MODULE, Name, Args); + + {call_nif, Name, []} -> + {ok, []} = ?MODULE:Name(); + + {call_nif, Name, [A1]} -> + {ok, [A1]} = ?MODULE:Name(A1); + + {call_nif, Name, [A1,A2]} -> + {ok,[A1,A2]} = ?MODULE:Name(A1,A2); + + {call_nif, Name, [A1,A2,A3]} -> + {ok,[A1,A2,A3]} = ?MODULE:Name(A1,A2,A3) end, nif_process(). load_nif(Config) -> - ?line Path = ?config(data_dir, Config), - - ?line ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). + case is_nif_loaded() of + true -> + ok; + false -> + Path = proplists:get_value(data_dir, Config), + ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0) + end. +is_nif_loaded() -> + false. nif() -> {"Stub0",[]}. %exit("nif/0 stub called"). nif(A1) -> {"Stub1",[A1]}. %exit(["nif/1 stub called",A1]). - diff --git a/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c b/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c index 26f2420b8b..1afb5ee919 100644 --- a/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c +++ b/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c @@ -1,4 +1,4 @@ -#include "erl_nif.h" +#include <erl_nif.h> static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) @@ -6,18 +6,18 @@ 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 upgrade(ErlNifEnv* env, void** priv_data, void** old_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) +static void unload(ErlNifEnv* env, void* priv_data) { - return 0; } -static void unload(ErlNifEnv* env, void* priv_data) +static ERL_NIF_TERM is_nif_loaded(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + return enif_make_atom(env,"true"); } static ERL_NIF_TERM nif_0(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -38,9 +38,10 @@ static ERL_NIF_TERM nif_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) static ErlNifFunc nif_funcs[] = { + {"is_nif_loaded", 0, is_nif_loaded}, {"nif", 0, nif_0}, {"nif", 1, nif_1} }; -ERL_NIF_INIT(trace_nif_SUITE,nif_funcs,load,reload,upgrade,unload) +ERL_NIF_INIT(trace_nif_SUITE,nif_funcs,load,NULL,upgrade,unload) diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl index 99df8da107..c85a77536e 100644 --- a/erts/emulator/test/trace_port_SUITE.erl +++ b/erts/emulator/test/trace_port_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -20,238 +21,227 @@ -module(trace_port_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, +-export([all/0, suite/0, call_trace/1, return_trace/1, send/1, receive_trace/1, + receive_trace_non_scheduler/1, process_events/1, schedule/1, - fake_schedule/1, - fake_schedule_after_register/1, - fake_schedule_after_getting_linked/1, - fake_schedule_after_getting_unlinked/1, gc/1, - default_tracer/1]). - --include_lib("test_server/include/test_server.hrl"). - -test_cases() -> - [call_trace, return_trace, send, receive_trace, - process_events, schedule, fake_schedule, - fake_schedule_after_register, - fake_schedule_after_getting_linked, - fake_schedule_after_getting_unlinked, gc, - default_tracer]. - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - test_cases(). - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. + default_tracer/1, + tracer_port_crash/1]). +-include_lib("common_test/include/ct.hrl"). -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:seconds(30)), - [{watchdog, Dog}|Config]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). +all() -> + [call_trace, return_trace, send, receive_trace, + receive_trace_non_scheduler, + process_events, schedule, gc, + default_tracer, tracer_port_crash]. -call_trace(doc) -> "Test sending call trace messages to a port."; +%% Test sending call trace messages to a port. call_trace(Config) when is_list(Config) -> case test_server:is_native(?MODULE) orelse - test_server:is_native(lists) of - true -> - {skip,"Native code"}; - false -> - ?line start_tracer(Config), - Self = self(), - ?line trace_func({lists,reverse,1}, []), - ?line trace_pid(Self, true, [call]), - ?line trace_info(Self, flags), - ?line trace_info(Self, tracer), - ?line [b,a] = lists:reverse([a,b]), - ?line expect({trace,Self,call,{lists,reverse,[[a,b]]}}), - - ?line trace_pid(Self, true, [timestamp]), - ?line trace_info(Self, flags), - ?line Huge = huge_data(), - ?line lists:reverse(Huge), - ?line expect({trace_ts,Self,call,{lists,reverse,[Huge]},ts}), - - ?line trace_pid(Self, true, [arity]), - ?line trace_info(Self, flags), - ?line [y,x] = lists:reverse([x,y]), - ?line expect({trace_ts,Self,call,{lists,reverse,1},ts}), - - ?line trace_pid(Self, false, [timestamp]), - ?line trace_info(Self, flags), - ?line [z,y,x] = lists:reverse([x,y,z]), - ?line expect({trace,Self,call,{lists,reverse,1}}), - - %% OTP-7399. Delayed sub-binary creation optimization. - ?line trace_pid(Self, false, [arity]), - ?line trace_info(Self, flags), - ?line trace_func({?MODULE,bs_sum_c,2}, [], [local]), - ?line 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0), - ?line trace_func({?MODULE,bs_sum_c,2}, false, [local]), - ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>,0]}}), - ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>,3]}}), - ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<7:4,11:4>>,8]}}), - ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<11:4>>,15]}}), - ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<>>,26]}}), - - ?line trace_func({lists,reverse,1}, false), - ok + test_server:is_native(lists) of + true -> + {skip,"Native code"}; + false -> + start_tracer(Config), + Self = self(), + trace_func({lists,reverse,1}, []), + trace_pid(Self, true, [call]), + trace_info(Self, flags), + trace_info(Self, tracer), + [b,a] = lists:reverse([a,b]), + expect({trace,Self,call,{lists,reverse,[[a,b]]}}), + + trace_pid(Self, true, [timestamp]), + trace_info(Self, flags), + Huge = huge_data(), + lists:reverse(Huge), + expect({trace_ts,Self,call,{lists,reverse,[Huge]},ts}), + + trace_pid(Self, true, [arity]), + trace_info(Self, flags), + [y,x] = lists:reverse([x,y]), + expect({trace_ts,Self,call,{lists,reverse,1},ts}), + + trace_pid(Self, false, [timestamp]), + trace_info(Self, flags), + [z,y,x] = lists:reverse([x,y,z]), + expect({trace,Self,call,{lists,reverse,1}}), + + %% OTP-7399. Delayed sub-binary creation optimization. + trace_pid(Self, false, [arity]), + trace_info(Self, flags), + trace_func({?MODULE,bs_sum_c,2}, [], [local]), + 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0), + trace_func({?MODULE,bs_sum_c,2}, false, [local]), + expect({trace,Self,call,{?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>,0]}}), + expect({trace,Self,call,{?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>,3]}}), + expect({trace,Self,call,{?MODULE,bs_sum_c,[<<7:4,11:4>>,8]}}), + expect({trace,Self,call,{?MODULE,bs_sum_c,[<<11:4>>,15]}}), + expect({trace,Self,call,{?MODULE,bs_sum_c,[<<>>,26]}}), + + trace_func({lists,reverse,1}, false), + ok end. bs_sum_c(<<H:4,T/bits>>, Acc) -> bs_sum_c(T, H+Acc); bs_sum_c(<<>>, Acc) -> Acc. -return_trace(doc) -> "Test the new return trace."; +%% Test the new return trace. return_trace(Config) when is_list(Config) -> case test_server:is_native(?MODULE) orelse - test_server:is_native(lists) of - true -> - {skip,"Native code"}; - false -> - ?line start_tracer(Config), - Self = self(), - MFA = {lists,reverse,1}, - - %% Plain (no timestamp, small data). - - ?line trace_func(MFA, [{['$1'],[],[{return_trace}, - {message,false}]}]), - ?line trace_pid(Self, true, [call]), - ?line trace_info(Self, flags), - ?line trace_info(Self, tracer), - ?line trace_info(MFA, match_spec), - ?line {traced,global} = trace_info(MFA, traced), - ?line [b,a] = lists:reverse([a,b]), - ?line expect({trace,Self,return_from,MFA,[b,a]}), - - %% Timestamp, huge data. - ?line trace_pid(Self, true, [timestamp]), - ?line Result = lists:reverse(huge_data()), - ?line expect({trace_ts,Self,return_from,MFA,Result,ts}), - - %% Turn off trace. - ?line trace_func(MFA, false), - ?line trace_info(MFA, match_spec), - ?line {traced,false} = trace_info(MFA, traced), - ok + test_server:is_native(lists) of + true -> + {skip,"Native code"}; + false -> + start_tracer(Config), + Self = self(), + MFA = {lists,reverse,1}, + + %% Plain (no timestamp, small data). + + trace_func(MFA, [{['$1'],[],[{return_trace}, + {message,false}]}]), + trace_pid(Self, true, [call]), + trace_info(Self, flags), + trace_info(Self, tracer), + trace_info(MFA, match_spec), + {traced,global} = trace_info(MFA, traced), + [b,a] = lists:reverse([a,b]), + expect({trace,Self,return_from,MFA,[b,a]}), + + %% Timestamp, huge data. + trace_pid(Self, true, [timestamp]), + Result = lists:reverse(huge_data()), + expect({trace_ts,Self,return_from,MFA,Result,ts}), + + %% Turn off trace. + trace_func(MFA, false), + trace_info(MFA, match_spec), + {traced,false} = trace_info(MFA, traced), + ok end. -send(doc) -> "Test sending send trace messages to a port."; +%% Test sending send trace messages to a port. send(Config) when is_list(Config) -> - ?line Tracer = start_tracer(Config), + Tracer = start_tracer(Config), Self = self(), - ?line Sender = fun_spawn(fun sender/0), - ?line trac(Sender, true, [send]), + Sender = fun_spawn(fun sender/0), + trac(Sender, true, [send]), %% Simple message, no timestamp. - ?line Bin = list_to_binary(lists:seq(1, 10)), - ?line Msg = {some_data,Bin}, + Bin = list_to_binary(lists:seq(1, 10)), + Msg = {some_data,Bin}, Sender ! {send_please,self(),Msg}, receive Msg -> ok end, - ?line expect({trace,Sender,send,Msg,Self}), + expect({trace,Sender,send,Msg,Self}), %% Timestamp. BiggerMsg = {even_bigger,Msg}, - ?line trac(Sender, true, [send,timestamp]), + trac(Sender, true, [send,timestamp]), Sender ! {send_please,self(),BiggerMsg}, receive BiggerMsg -> ok end, - ?line expect({trace_ts,Sender,send,BiggerMsg,Self,ts}), + expect({trace_ts,Sender,send,BiggerMsg,Self,ts}), %% Huge message. - ?line HugeMsg = huge_data(), + HugeMsg = huge_data(), Sender ! {send_please,self(),HugeMsg}, receive HugeMsg -> ok end, - ?line expect({trace_ts,Sender,send,HugeMsg,Self,ts}), + expect({trace_ts,Sender,send,HugeMsg,Self,ts}), %% Kill trace port and force a trace. The emulator should not crasch. - ?line unlink(Tracer), - ?line exit(Tracer, kill), + unlink(Tracer), + exit(Tracer, kill), erlang:yield(), % Make sure that port gets killed. Sender ! {send_please,Self,good_bye}, receive good_bye -> ok end, ok. -receive_trace(doc) -> "Test sending receive traces to a port."; +%% Test sending receive traces to a port. receive_trace(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Receiver = fun_spawn(fun receiver/0), - ?line trac(Receiver, true, ['receive']), + start_tracer(Config), + Receiver = fun_spawn(fun receiver/0), + trac(Receiver, true, ['receive']), Receiver ! {hello,world}, - ?line expect({trace,Receiver,'receive',{hello,world}}), + expect({trace,Receiver,'receive',{hello,world}}), - ?line trac(Receiver, true, ['receive',timestamp]), + trac(Receiver, true, ['receive',timestamp]), Huge = {hello,huge_data()}, Receiver ! {hello,huge_data()}, - ?line expect({trace_ts,Receiver,'receive',Huge,ts}), + expect({trace_ts,Receiver,'receive',Huge,ts}), + ok. + +%% Test sending receive traces to a port. +receive_trace_non_scheduler(Config) when is_list(Config) -> + start_tracer(Config), + S = self(), + Receiver = spawn_link( + fun() -> + receive + go -> + Ref = S ! erlang:trace_delivered(all), + receive {trace_delivered, Ref, all} -> ok end + end + end), + trac(Receiver, true, ['receive']), + Receiver ! go, + Ref = receive R -> R end, + expect({trace,Receiver,'receive',go}), + expect({trace,Receiver,'receive',{trace_delivered, all, Ref}}), + ok. -process_events(doc) -> "Tests a few process events (like getting linked)."; +%% Tests a few process events (like getting linked). process_events(Config) when is_list(Config) -> - ?line start_tracer(Config), + start_tracer(Config), Self = self(), - ?line Receiver = fun_spawn(fun receiver/0), - ?line trac(Receiver, true, [procs]), + Receiver = fun_spawn(fun receiver/0), + trac(Receiver, true, [procs]), unlink(Receiver), %It is already linked. - ?line expect({trace,Receiver,getting_unlinked,Self}), + expect({trace,Receiver,getting_unlinked,Self}), link(Receiver), - ?line expect({trace,Receiver,getting_linked,Self}), - ?line trac(Receiver, true, [procs,timestamp]), + expect({trace,Receiver,getting_linked,Self}), + trac(Receiver, true, [procs,timestamp]), unlink(Receiver), - ?line expect({trace_ts,Receiver,getting_unlinked,Self,ts}), + expect({trace_ts,Receiver,getting_unlinked,Self,ts}), link(Receiver), - ?line expect({trace_ts,Receiver,getting_linked,Self,ts}), + expect({trace_ts,Receiver,getting_linked,Self,ts}), unlink(Receiver), - ?line expect({trace_ts,Receiver,getting_unlinked,Self,ts}), + expect({trace_ts,Receiver,getting_unlinked,Self,ts}), Huge = huge_data(), exit(Receiver, Huge), - ?line expect({trace_ts,Receiver,exit,Huge,ts}), + expect({trace_ts,Receiver,exit,Huge,ts}), ok. -schedule(doc) -> "Test sending scheduling events to a port."; +%% Test sending scheduling events to a port. schedule(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Receiver = fun_spawn(fun receiver/0), - ?line trac(Receiver, true, [running]), + start_tracer(Config), + Receiver = fun_spawn(fun receiver/0), + trac(Receiver, true, [running]), Receiver ! hi, expect({trace,Receiver,in,{?MODULE,receiver,0}}), expect({trace,Receiver,out,{?MODULE,receiver,0}}), - ?line trac(Receiver, true, [running,timestamp]), + trac(Receiver, true, [running,timestamp]), Receiver ! hi_again, expect({trace_ts,Receiver,in,{?MODULE,receiver,0},ts}), @@ -259,219 +249,95 @@ schedule(Config) when is_list(Config) -> ok. -run_fake_sched_test(Fun, Config) when is_function(Fun), is_list(Config) -> - ?line case catch erlang:system_info(smp_support) of - true -> - ?line {skipped, - "No need for faked schedule out/in trace messages " - "when smp support is enabled"}; - _ -> - ?line Fun(Config) - end. - -fake_schedule(doc) -> "Tests time compensating fake out/in scheduling."; -fake_schedule(Config) when is_list(Config) -> - ?line run_fake_sched_test(fun fake_schedule_test/1, Config). - -fake_schedule_test(Config) when is_list(Config) -> - ?line Tracer = start_tracer(Config), - ?line Port = get(tracer_port), - ?line General = fun_spawn(fun general/0), - %% - ?line trac(General, true, [send, running]), - %% - %% Test that fake out/in scheduling is not generated unless - %% both 'running' and 'timestamp' is active. - ?line [] = erlang:port_control(Port, $h, []), - ?line General ! nop, - ?line expect({trace, General, in, {?MODULE, general, 0}}), - ?line expect({trace, General, out, {?MODULE, general, 0}}), - ?line expect(), - %% - ?line trac(General, false, [running]), - ?line trac(General, true, [timestamp]), - %% - ?line Ref1 = make_ref(), - ?line Msg1 = {Port, {data, term_to_binary(Ref1)}}, - ?line [] = erlang:port_control(Port, $h, []), - ?line General ! {send, Tracer, Msg1}, - ?line expect({trace_ts, General, send, Msg1, Tracer, ts}), - ?line expect(Ref1), - ?line expect(), - %% - ?line trac(General, true, [running]), - %% - %% Test that fake out/in scheduling can be generated by the driver - ?line Ref2 = make_ref(), - ?line Msg2 = {Port, {data, term_to_binary(Ref2)}}, - ?line [] = erlang:port_control(Port, $h, []), - ?line General ! {send, Tracer, Msg2}, - ?line {_,_,_,_,Ts} = - expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), - ?line expect({trace_ts, General, out, 0, Ts}), - ?line expect({trace_ts, General, in, 0, ts}), - ?line expect({trace_ts, General, send, Msg2, Tracer, ts}), - ?line expect(Ref2), - ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), - ?line expect(), - %% - %% Test that fake out/in scheduling is not generated after an - %% 'out' scheduling event - ?line Ref3 = make_ref(), - ?line Msg3 = {Port, {data, term_to_binary(Ref3)}}, - ?line General ! {apply, {erlang, port_control, [Port, $h, []]}}, - ?line expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), - ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), - ?line General ! {send, Tracer, Msg3}, - ?line expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), - ?line expect({trace_ts, General, send, Msg3, Tracer, ts}), - ?line expect(Ref3), - ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), - ?line expect(), - %% - ok. - -fake_schedule_after_register(doc) -> - "Tests fake out/in scheduling contents."; -fake_schedule_after_register(Config) when is_list(Config) -> - ?line run_fake_sched_test(fun fake_schedule_after_register_test/1, Config). - -fake_schedule_after_register_test(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Port = get(tracer_port), - ?line G1 = fun_spawn(fun general/0), - ?line G2 = fun_spawn(fun general/0), - %% - ?line trac(G1, true, [running, timestamp, procs]), - ?line trac(G2, true, [running, timestamp]), - %% - %% Test fake out/in scheduling after certain messages - ?line erlang:yield(), - ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, - ?line G2 ! {apply, {erlang, register, [fake_schedule_after_register, G1]}}, - ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), - ?line {_,_,_,_,Ts} = - expect({trace_ts, G1, register, fake_schedule_after_register, ts}), - ?line expect({trace_ts, G2, out, 0, Ts}), - ?line expect({trace_ts, G2, in, 0, ts}), - ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), - ?line expect(), - %% - ok. - -fake_schedule_after_getting_linked(doc) -> - "Tests fake out/in scheduling contents."; -fake_schedule_after_getting_linked(Config) when is_list(Config) -> - ?line run_fake_sched_test(fun fake_schedule_after_getting_linked_test/1, - Config). - -fake_schedule_after_getting_linked_test(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Port = get(tracer_port), - ?line G1 = fun_spawn(fun general/0), - ?line G2 = fun_spawn(fun general/0), - %% - ?line trac(G1, true, [running, timestamp, procs]), - ?line trac(G2, true, [running, timestamp]), - %% - %% Test fake out/in scheduling after certain messages - ?line erlang:yield(), - ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, - ?line G2 ! {apply, {erlang, link, [G1]}}, - ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), - ?line {_,_,_,_,Ts} = - expect({trace_ts, G1, getting_linked, G2, ts}), - ?line expect({trace_ts, G2, out, 0, Ts}), - ?line expect({trace_ts, G2, in, 0, ts}), - ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), - ?line expect(), - %% - ok. - -fake_schedule_after_getting_unlinked(doc) -> - "Tests fake out/in scheduling contents."; -fake_schedule_after_getting_unlinked(Config) when is_list(Config) -> - ?line run_fake_sched_test(fun fake_schedule_after_getting_unlinked_test/1, - Config). - -fake_schedule_after_getting_unlinked_test(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Port = get(tracer_port), - ?line G1 = fun_spawn(fun general/0), - ?line G2 = fun_spawn(fun general/0), - %% - ?line trac(G1, true, [running, procs]), - ?line trac(G2, true, [running, timestamp]), - %% - %% Test fake out/in scheduling after certain messages - ?line erlang:yield(), - ?line G2 ! {apply, {erlang, link, [G1]}}, - ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, - ?line G2 ! {apply, {erlang, unlink, [G1]}}, - ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), - ?line expect({trace, G1, getting_linked, G2}), - ?line expect({trace, G1, getting_unlinked, G2}), - ?line expect({trace_ts, G2, out, 0, ts}), - ?line expect({trace_ts, G2, in, 0, ts}), - ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), - ?line expect(), - %% - ok. - -gc(doc) -> "Test sending garbage collection events to a port."; +%% Test sending garbage collection events to a port. gc(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Garber = fun_spawn(fun garber/0, [{min_heap_size, 5000}]), - ?line trac(Garber, true, [garbage_collection]), - ?line trace_info(Garber, flags), + start_tracer(Config), + Garber = fun_spawn(fun garber/0, [{min_heap_size, 5000}]), + trac(Garber, true, [garbage_collection]), + trace_info(Garber, flags), - ?line trace_info(Garber, flags), + trace_info(Garber, flags), Garber ! hi, - expect({trace,Garber,gc_start,info}), - expect({trace,Garber,gc_end,info}), + expect({trace,Garber,gc_major_start,info}), + expect({trace,Garber,gc_major_end,info}), - ?line trac(Garber, true, [garbage_collection,timestamp]), + trac(Garber, true, [garbage_collection,timestamp]), Garber ! hi, - expect({trace_ts,Garber,gc_start,info,ts}), - expect({trace_ts,Garber,gc_end,info,ts}), + expect({trace_ts,Garber,gc_major_start,info,ts}), + expect({trace_ts,Garber,gc_major_end,info,ts}), ok. -default_tracer(doc) -> - "Test a port as default tracer."; +%% Test a port as default tracer. default_tracer(Config) when is_list(Config) -> - ?line Tracer = start_tracer(Config), - ?line TracerMonitor = erlang:monitor(process, Tracer), - ?line Port = get(tracer_port), + Tracer = start_tracer(Config), + TracerMonitor = erlang:monitor(process, Tracer), + Port = get(tracer_port), %% - ?line N = erlang:trace(all, true, [send, {tracer, Port}]), - ?line {flags, [send]} = erlang:trace_info(self(), flags), - ?line {tracer, Port} = erlang:trace_info(self(), tracer), - ?line {flags, [send]} = erlang:trace_info(new, flags), - ?line {tracer, Port} = erlang:trace_info(new, tracer), - ?line G1 = fun_spawn(fun general/0), - ?line {flags, [send]} = erlang:trace_info(G1, flags), - ?line {tracer, Port} = erlang:trace_info(G1, tracer), - ?line unlink(Tracer), - ?line exit(Port, done), - ?line receive - {'DOWN', TracerMonitor, process, Tracer, TracerExitReason} -> - ?line done = TracerExitReason - end, - ?line {flags, []} = erlang:trace_info(self(), flags), - ?line {tracer, []} = erlang:trace_info(self(), tracer), - ?line {flags, []} = erlang:trace_info(new, flags), - ?line {tracer, []} = erlang:trace_info(new, tracer), - ?line M = erlang:trace(all, false, [all]), - ?line {flags, []} = erlang:trace_info(self(), flags), - ?line {tracer, []} = erlang:trace_info(self(), tracer), - ?line {flags, []} = erlang:trace_info(G1, flags), - ?line {tracer, []} = erlang:trace_info(G1, tracer), - ?line G1 ! {apply,{erlang,exit,[normal]}}, - ?line io:format("~p = ~p.~n", [M, N]), - ?line M = N, + N = erlang:trace(all, true, [send, {tracer, Port}]), + {flags, [send]} = erlang:trace_info(self(), flags), + {tracer, Port} = erlang:trace_info(self(), tracer), + {flags, [send]} = erlang:trace_info(new, flags), + {tracer, Port} = erlang:trace_info(new, tracer), + G1 = fun_spawn(fun general/0), + {flags, [send]} = erlang:trace_info(G1, flags), + {tracer, Port} = erlang:trace_info(G1, tracer), + unlink(Tracer), + exit(Port, done), + receive + {'DOWN', TracerMonitor, process, Tracer, TracerExitReason} -> + done = TracerExitReason + end, + {flags, []} = erlang:trace_info(self(), flags), + {tracer, []} = erlang:trace_info(self(), tracer), + {flags, []} = erlang:trace_info(new, flags), + {tracer, []} = erlang:trace_info(new, tracer), + M = erlang:trace(all, false, [all]), + {flags, []} = erlang:trace_info(self(), flags), + {tracer, []} = erlang:trace_info(self(), tracer), + {flags, []} = erlang:trace_info(G1, flags), + {tracer, []} = erlang:trace_info(G1, tracer), + G1 ! {apply,{erlang,exit,[normal]}}, + io:format("~p = ~p.~n", [M, N]), + M = N - 1, % G1 has been started, but Tracer and Port have died ok. +tracer_port_crash(Config) when is_list(Config) -> + case test_server:is_native(?MODULE) orelse + test_server:is_native(lists) of + true -> + {skip,"Native code"}; + false -> + Tr = start_tracer(Config), + Port = get(tracer_port), + Tracee = spawn(fun () -> + register(trace_port_linker, self()), + link(Port), + receive go -> ok end, + lists:reverse([1,b,c]), + receive die -> ok end + end), + Tr ! {unlink_tracer_port, self()}, + receive {unlinked_tracer_port, Tr} -> ok end, + port_control(Port, $c, []), %% Make port commands crash tracer port... + trace_func({lists,reverse,1}, []), + trace_pid(Tracee, true, [call]), + trace_info(Tracee, flags), + trace_info(self(), tracer), + Tracee ! go, + receive after 1000 -> ok end, + case whereis(trace_port_linker) of + undefined -> + ok; + Id -> + % erts_debug:set_internal_state(available_internal_state, true), + % erts_debug:set_internal_state(abort, {trace_port_linker, Id}) + ct:fail({trace_port_linker, Id}) + end, + undefined = process_info(Tracee), + ok + end. + %%% Help functions. huge_data() -> huge_data(16384). @@ -483,108 +349,99 @@ huge_data(N) -> P = huge_data(N div 2), [16#1234566,P|P]. -expect() -> - receive - Other -> - ok = io:format("Unexpected; got ~p", [Other]), - test_server:fail({unexpected, Other}) - after 200 -> - ok - end. - expect({trace_ts,E1,E2,info,ts}=Message) -> receive - {trace_ts,E1,E2,_Info,_Ts}=MessageTs -> - ok = io:format("Expected and got ~p", [MessageTs]), - MessageTs; - Other -> - io:format("Expected ~p; got ~p", [Message,Other]), - test_server:fail({unexpected,Other}) + {trace_ts,E1,E2,_Info,_Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + ct:fail({unexpected,Other}) after 5000 -> - io:format("Expected ~p; got nothing", [Message]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [Message]), + ct:fail(no_trace_message) end; expect({trace,E1,E2,info}=Message) -> receive - {trace,E1,E2,_Info}=MessageTs -> - ok = io:format("Expected and got ~p", [MessageTs]), - MessageTs; - Other -> - io:format("Expected ~p; got ~p", [Message,Other]), - test_server:fail({unexpected,Other}) + {trace,E1,E2,_Info}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + ct:fail({unexpected,Other}) after 5000 -> - io:format("Expected ~p; got nothing", [Message]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [Message]), + ct:fail(no_trace_message) end; expect({trace_ts,E1,E2,E3,ts}=Message) -> receive - {trace_ts,E1,E2,E3,_Ts}=MessageTs -> - ok = io:format("Expected and got ~p", [MessageTs]), - MessageTs; - Other -> - io:format("Expected ~p; got ~p", [Message,Other]), - test_server:fail({unexpected,Other}) + {trace_ts,E1,E2,E3,_Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + ct:fail({unexpected,Other}) after 5000 -> - io:format("Expected ~p; got nothing", [Message]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [Message]), + ct:fail(no_trace_message) end; expect({trace_ts,E1,E2,E3,E4,ts}=Message) -> receive - {trace_ts,E1,E2,E3,E4,_Ts}=MessageTs -> - ok = io:format("Expected and got ~p", [MessageTs]), - MessageTs; - Other -> - io:format("Expected ~p; got ~p", [Message,Other]), - test_server:fail({unexpected,Other}) + {trace_ts,E1,E2,E3,E4,_Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + ct:fail({unexpected,Other}) after 5000 -> - io:format("Expected ~p; got nothing", [Message]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [Message]), + ct:fail(no_trace_message) end; expect(Message) -> receive - Message -> - ok = io:format("Expected and got ~p", [Message]), - Message; - Other -> - io:format("Expected ~p; got ~p", [Message,Other]), - test_server:fail({unexpected,Other}) + Message -> + ok = io:format("Expected and got ~p", [Message]), + Message; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + ct:fail({unexpected,Other}) after 5000 -> - io:format("Expected ~p; got nothing", [Message]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [Message]), + ct:fail(no_trace_message) end. trac(What, On, Flags0) -> Flags = [{tracer,get(tracer_port)}|Flags0], get(tracer) ! {apply,self(),{erlang,trace,[What,On,Flags]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace(~p, ~p, ~p) -> ~p", - [What,On,Flags,Res]), + [What,On,Flags,Res]), Res. - + trace_info(What, Key) -> get(tracer) ! {apply,self(),{erlang,trace_info,[What,Key]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace_info(~p, ~p) -> ~p", - [What,Key,Res]), + [What,Key,Res]), Res. - + trace_func(MFA, MatchProg) -> get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA,MatchProg]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace_pattern(~p, ~p) -> ~p", [MFA,MatchProg,Res]), Res. trace_func(MFA, MatchProg, Flags) -> get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA,MatchProg,Flags]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace_pattern(~p, ~p) -> ~p", [MFA,MatchProg,Res]), Res. @@ -592,29 +449,29 @@ trace_pid(Pid, On, Flags0) -> Flags = [{tracer,get(tracer_port)}|Flags0], get(tracer) ! {apply,self(),{erlang,trace,[Pid,On,Flags]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace(~p, ~p, ~p) -> ~p", - [Pid,On,Flags,Res]), + [Pid,On,Flags,Res]), Res. start_tracer(Config) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, echo_drv), Self = self(), put(tracer, fun_spawn(fun() -> tracer(Self) end)), receive - {started,Port} -> - put(tracer_port, Port) + {started,Port} -> + put(tracer_port, Port) end, get(tracer). load_driver(Dir, Driver) -> case erl_ddll:load_driver(Dir, Driver) of - ok -> ok; - {error, Error} = Res -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - Res + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res end. tracer(RelayTo) -> @@ -624,14 +481,18 @@ tracer(RelayTo) -> tracer_loop(RelayTo, Port) -> receive - {apply,From,{M,F,A}} -> - From ! {apply_result,apply(M, F, A)}, - tracer_loop(RelayTo, Port); - {Port,{data,Msg}} -> - RelayTo ! binary_to_term(Msg), - tracer_loop(RelayTo, Port); - Other -> - exit({bad_message,Other}) + {apply,From,{M,F,A}} -> + From ! {apply_result,apply(M, F, A)}, + tracer_loop(RelayTo, Port); + {Port,{data,Msg}} -> + RelayTo ! binary_to_term(Msg), + tracer_loop(RelayTo, Port); + {unlink_tracer_port, From} -> + unlink(Port), + From ! {unlinked_tracer_port, self()}, + tracer_loop(RelayTo, Port); + Other -> + exit({bad_message,Other}) end. fun_spawn(Fun) -> @@ -655,43 +516,43 @@ fun_spawn(Fun, Opts) -> sender() -> receive - {send_please, To, What} -> - To ! What, - sender() + {send_please, To, What} -> + To ! What, + sender() end. %% Just consumes messages from its message queue. receiver() -> receive - _Any -> receiver() + _Any -> receiver() end. %% Does a garbage collection when it receives a message. garber() -> receive - _Any -> - lists:seq(1, 100), - erlang:garbage_collect(), - garber() + _Any -> + lists:seq(1, 100), + erlang:garbage_collect(), + garber() end. %% All-purpose process general() -> receive - {apply, {M, F, Args}} -> - erlang:apply(M, F, Args), - general(); - {send, Dest, Msg} -> - Dest ! Msg, - general(); - {call_f_1, Arg} -> - f(Arg), - general(); - nop -> - general() + {apply, {M, F, Args}} -> + erlang:apply(M, F, Args), + general(); + {send, Dest, Msg} -> + Dest ! Msg, + general(); + {call_f_1, Arg} -> + f(Arg), + general(); + nop -> + general() end. f(Arg) -> diff --git a/erts/emulator/test/trace_port_SUITE_data/echo_drv.c b/erts/emulator/test/trace_port_SUITE_data/echo_drv.c index a8d4ede4fe..e40b9193ea 100644 --- a/erts/emulator/test/trace_port_SUITE_data/echo_drv.c +++ b/erts/emulator/test/trace_port_SUITE_data/echo_drv.c @@ -1,5 +1,6 @@ #include <stdio.h> #include "erl_driver.h" +#include <errno.h> @@ -14,6 +15,7 @@ enum e_heavy { typedef struct _erl_drv_data { ErlDrvPort erlang_port; enum e_heavy heavy; + int crash; } EchoDrvData; static EchoDrvData echo_drv_data, *echo_drv_data_p; @@ -78,6 +80,7 @@ static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command) echo_drv_data_p = &echo_drv_data; echo_drv_data_p->erlang_port = port; echo_drv_data_p->heavy = heavy_off; + echo_drv_data_p->crash = 0; return echo_drv_data_p; } @@ -87,6 +90,12 @@ static void echo_drv_stop(EchoDrvData *data_p) { static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { EchoDrvData* data_p = (EchoDrvData *) drv_data; + + if (data_p->crash) { + driver_failure_posix(data_p->erlang_port, EINTR); + return; + } + driver_output(data_p->erlang_port, buf, len); switch (data_p->heavy) { case heavy_off: @@ -100,6 +109,7 @@ static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { data_p->heavy = heavy_off; break; } + } static void echo_drv_finish() { @@ -115,6 +125,8 @@ static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data, case 'h': data_p->heavy = heavy_set; break; + case 'c': + data_p->crash = 1; } return 0; } diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl new file mode 100644 index 0000000000..ab7d047bc3 --- /dev/null +++ b/erts/emulator/test/tracer_SUITE.erl @@ -0,0 +1,696 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(tracer_SUITE). + +%%% +%%% Tests the tracer module interface +%%% + +-export([all/0, suite/0,groups/0, init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, init_per_testcase/2, + end_per_testcase/2]). +-export([load/1, unload/1, reload/1, invalid_tracers/1]). +-export([send/1, recv/1, call/1, call_return/1, spawn/1, exit/1, + link/1, unlink/1, getting_linked/1, getting_unlinked/1, + register/1, unregister/1, in/1, out/1, gc_start/1, gc_end/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. + +all() -> + [load, unload, reload, invalid_tracers, {group, basic}]. + +groups() -> + [{ basic, [], [send, recv, call, call_return, spawn, exit, + link, unlink, getting_linked, getting_unlinked, + register, unregister, in, out, gc_start, gc_end]}]. + +init_per_suite(Config) -> + erlang:trace_pattern({'_','_','_'}, false, [local]), + erlang:trace_pattern({'_','_','_'}, false, []), + purge(), + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(TC, Config) when TC =:= load; TC =:= reload -> + + DataDir = proplists:get_value(data_dir, Config), + + Pid = erlang:spawn(fun F() -> + receive + {get, Pid} -> + Pid ! DataDir, + F() + end + end), + register(tracer_test_config, Pid), + common_init_per_testcase(Config); +init_per_testcase(_, Config) -> + DataDir = proplists:get_value(data_dir, Config), + case catch tracer_test:enabled(trace_status, self(), self()) of + discard -> + ok; + _ -> + tracer_test:load(DataDir) + end, + common_init_per_testcase(Config). + +common_init_per_testcase(Config) -> + Killer = erlang:spawn(fun() -> killer_loop([]) end), + register(killer_process, Killer), + Config. + +end_per_testcase(TC, _Config) when TC =:= load; TC =:= reload -> + purge(), + exit(whereis(tracer_test_config), kill), + kill_processes(); +end_per_testcase(_, _Config) -> + purge(), + kill_processes(). + +kill_processes() -> + killer_process ! {get_pids,self()}, + receive + {pids_to_kill,Pids} -> ok + end, + _ = [begin + case erlang:is_process_alive(P) of + true -> + io:format("Killing ~p\n", [P]); + false -> + ok + end, + erlang:unlink(P), + exit(P, kill) + end || P <- Pids], + ok. + +killer_loop(Pids) -> + receive + {add_pid,Pid} -> + killer_loop([Pid|Pids]); + {get_pids,To} -> + To ! {pids_to_kill,Pids} + end. + +kill_me(Pid) -> + killer_process ! {add_pid,Pid}, + Pid. + +%%% Test cases follow. + +load(_Config) -> + purge(), + 1 = erlang:trace(self(), true, [{tracer, tracer_test, []}, call]), + purge(), + 1 = erlang:trace_pattern({?MODULE, all, 0}, [], + [{meta, tracer_test, []}]), + ok. + +unload(_Config) -> + + ServerFun = fun F(0, undefined) -> + receive + {N, Pid} -> F(N, Pid) + end; + F(0, Pid) -> + Pid ! done, + F(0, undefined); + F(N, Pid) -> + ?MODULE:all(), + F(N-1, Pid) + end, + + Pid = erlang:spawn_link(fun() -> ServerFun(0, undefined) end), + + Tc = fun(N) -> + Pid ! {N, self()}, + receive done -> ok after 1000 -> ct:fail(timeout) end, + trace_delivered(Pid) + end, + + 1 = erlang:trace(Pid, true, [{tracer, tracer_test, + {#{ call => trace }, self(), []}}, + call]), + 1 = erlang:trace_pattern({?MODULE, all, 0}, [], []), + + Tc(1), + receive _M -> ok after 0 -> ct:fail(timeout) end, + receive M0 -> ct:fail({unexpected_message0, M0}) after 0 -> ok end, + + code:purge(tracer_test), + code:delete(tracer_test), + + Tc(1), + receive M1 -> ct:fail({unexpected_message1, M1}) after 0 -> ok end, + + code:purge(tracer_test), + + Tc(1), + receive M2 -> ct:fail({unexpected_message2, M2}) after 0 -> ok end, + + ok. + +%% This testcase is here to make sure there are not +%% segfaults when reloading the current nifs. +reload(_Config) -> + + Tracer = spawn_opt(fun F() -> receive _M -> F() end end, + [{message_queue_data, off_heap}]), + erlang:link(Tracer), + Tracee = spawn_link(fun reload_loop/0), + + [begin + Ref = make_ref(), + State = {#{ call => trace }, Tracer, [Ref]}, + erlang:trace(Tracee, true, [{tracer, tracer_test,State}, call]), + erlang:trace_pattern({?MODULE, all, 0}, []), + + false = code:purge(tracer_test), + {module, _} = code:load_file(tracer_test), + + %% There is a race involved in between when the internal nif cache + %% is purged and when the reload_loop needs the tracer module + %% so the tracer may be removed or still there. + case erlang:trace_info(Tracee, tracer) of + {tracer, []} -> ok; + {tracer, {tracer_test, State}} -> ok + end, + + false = code:purge(tracer_test), + true = code:delete(tracer_test), + false = code:purge(tracer_test), + timer:sleep(10) + end || _ <- lists:seq(1,15)], + + ok. + +reload_loop() -> + ?MODULE:all(), + ?MODULE:all(), + ?MODULE:all(), + ?MODULE:all(), + ?MODULE:all(), + timer:sleep(1), + reload_loop(). + +invalid_tracers(_Config) -> + FailTrace = fun(A) -> + try erlang:trace(self(), true, A) of + _ -> ct:fail(A) + catch _:_ -> ok end + end, + + FailTrace([{tracer, foobar}, call]), + FailTrace([{tracer, foobar, []}, call]), + FailTrace([{tracer, make_ref(), []}, call]), + FailTrace([{tracer, lists, []}, call]), + + FailTP = fun(MS,FL) -> + try erlang:trace_pattern({?MODULE,all,0}, MS, FL) of + _ -> ct:fail({MS, FL}) + catch _:_ -> ok end + end, + + FailTP([],[{meta, foobar}]), + FailTP([],[{meta, foobar, []}]), + FailTP([],[{meta, make_ref(), []}]), + FailTP([],[{meta, lists, []}]), + + ok. + + + +send(_Config) -> + + Self = self(), + Tc = fun(Pid) -> + Pid ! fun() -> Self ! ok end, + receive ok -> ok after 100 -> ct:fail(timeout) end + end, + + Expect = fun(Pid, State, EOpts) -> + receive + Msg -> + {send, State, Pid, ok, Opts} = Msg, + check_opts(EOpts, Opts, Self) + end + end, + test(send, Tc, Expect). + + +recv(_Config) -> + + Tc = fun(Pid) -> + Pid ! ok + end, + + Expect = fun(Pid, State, EOpts) -> + receive + Msg -> + {'receive', State, Pid, ok, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test('receive', Tc, Expect, false). + +call(_Config) -> + + Self = self(), + Tc = fun(Pid) -> + Pid ! fun() -> call_test(Self), Self ! ok end, + receive ok -> ok after 100 -> ct:fail(timeout) end + end, + + erlang:trace_pattern({?MODULE, call_test, 1}, [], [local]), + + Expect = fun(Pid, State, EOpts) -> + receive + Msg -> + {call, State, Pid, {?MODULE, call_test, [Self]}, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + test(call, Tc, Expect). + +call_return(_Config) -> + + Self = self(), + Tc = fun(Pid) -> + Pid ! fun() -> call_test(undefined), Self ! ok end, + receive ok -> ok after 100 -> ct:fail(timeout) end + end, + + 1 = erlang:trace_pattern({?MODULE, call_test, 1}, [{'_',[],[{return_trace}]}], [local]), + + Expect = fun(Pid, State, EOpts) -> + receive + CallMsg -> + {call, State, Pid, {?MODULE, call_test, [undefined]}, COpts} = CallMsg, + check_opts(EOpts, COpts) + end, + receive + RetMsg -> + {return_from, State, Pid, {?MODULE, call_test, 1}, ROpts} = RetMsg, + check_opts(EOpts, ROpts, undefined) + end + end, + test(call, Tc, Expect). + +call_test(Arg) -> + Arg. + +spawn(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> kill_me(erlang:spawn(lists,seq,[1,10])), ok end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {spawn, State, Pid, NewPid, Opts} = Msg, + check_opts(EOpts, Opts, {lists,seq,[1,10]}), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(spawn, procs, Tc, Expect, false). + +exit(_Config) -> + Tc = fun(Pid) -> + Pid ! fun() -> exit end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {exit, State, Pid, normal, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(exit, procs, Tc, Expect, true, true). + +link(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + SPid = erlang:spawn(fun() -> receive _ -> ok end end), + erlang:link(SPid), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {link, State, Pid, NewPid, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(link, procs, Tc, Expect, false). + +unlink(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + SPid = erlang:spawn(fun() -> receive _ -> ok end end), + erlang:link(SPid), + erlang:unlink(SPid), + kill_me(SPid), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {unlink, State, Pid, NewPid, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(unlink, procs, Tc, Expect, false). + +getting_linked(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + Self = self(), + erlang:spawn(fun() -> erlang:link(Self) end), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {getting_linked, State, Pid, NewPid, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(getting_linked, procs, Tc, Expect, false). + +getting_unlinked(_Config) -> + Tc = fun(Pid) -> + Pid ! fun() -> + Self = self(), + erlang:spawn(fun() -> + erlang:link(Self), + erlang:unlink(Self) + end), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {getting_unlinked, State, Pid, NewPid, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(getting_unlinked, procs, Tc, Expect, false). + +register(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:register(?MODULE, self()), + erlang:unregister(?MODULE), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {register, State, Pid, ?MODULE, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(register, procs, Tc, Expect, false). + +unregister(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:register(?MODULE, self()), + erlang:unregister(?MODULE), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {unregister, State, Pid, ?MODULE, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(unregister, procs, Tc, Expect, false). + +in(_Config) -> + + Tc = fun(Pid) -> + Self = self(), + Pid ! fun() -> receive after 10 -> Self ! ok end end, + receive ok -> ok end + end, + + Expect = + fun(Pid, State, EOpts) -> + N = (fun F(N) -> + receive + Msg -> + {in, State, Pid, _, Opts} = Msg, + check_opts(EOpts, Opts), + F(N+1) + after 0 -> N + end + end)(0), + true = N > 0 + end, + + test(in, running, Tc, Expect, false). + +out(_Config) -> + Tc = fun(Pid) -> + Pid ! fun() -> receive after 10 -> exit end end, + Ref = erlang:monitor(process, Pid), + receive {'DOWN', Ref, _, _, _} -> ok end + end, + + Expect = + fun(Pid, State, EOpts) -> + %% We cannot predict how many out schedules there will be + N = (fun F(N) -> + receive + Msg -> + {out, State, Pid, _, Opts} = Msg, + check_opts(EOpts, Opts), + F(N+1) + after 0 -> N + end + end)(0), + true = N > 0 + end, + + test(out, running, Tc, Expect, false, true). + +gc_start(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:garbage_collect(), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {gc_major_start, State, Pid, _, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(gc_major_start, garbage_collection, Tc, Expect, false). + +gc_end(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:garbage_collect(), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {gc_major_end, State, Pid, _, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(gc_major_end, garbage_collection, Tc, Expect, false). + +test(Event, Tc, Expect) -> + test(Event, Tc, Expect, false). +test(Event, Tc, Expect, Removes) -> + test(Event, Event, Tc, Expect, Removes). +test(Event, TraceFlag, Tc, Expect, Removes) -> + test(Event, TraceFlag, Tc, Expect, Removes, false). +test(Event, TraceFlag, Tc, Expect, _Removes, Dies) -> + + ComplexState = {fun() -> ok end, <<0:(128*8)>>}, + Opts = #{ }, + + %% Test that trace works + State1 = {#{ Event => trace }, self(), ComplexState}, + Pid1 = start_tracee(), + 1 = erlang:trace(Pid1, true, [TraceFlag, {tracer, tracer_test, State1}]), + Tc(Pid1), + ok = trace_delivered(Pid1), + + Expect(Pid1, State1, Opts), + receive M11 -> ct:fail({unexpected, M11}) after 0 -> ok end, + if not Dies -> + {flags, [TraceFlag]} = erlang:trace_info(Pid1, flags), + {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1, tracer), + erlang:trace(Pid1, false, [TraceFlag]); + true -> ok + end, + + %% Test that trace works with scheduler id and timestamp + Pid1T = start_tracee(), + 1 = erlang:trace(Pid1T, true, [TraceFlag, {tracer, tracer_test, State1}, + timestamp, scheduler_id]), + Tc(Pid1T), + ok = trace_delivered(Pid1T), + + Expect(Pid1T, State1, Opts#{ scheduler_id => number, + timestamp => timestamp}), + receive M11T -> ct:fail({unexpected, M11T}) after 0 -> ok end, + if not Dies -> + {flags, [scheduler_id, TraceFlag, timestamp]} + = erlang:trace_info(Pid1T, flags), + {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1T, tracer), + erlang:trace(Pid1T, false, [TraceFlag]); + true -> ok + end, + + %% Test that discard works + Pid2 = start_tracee(), + State2 = {#{ Event => discard }, self(), ComplexState}, + 1 = erlang:trace(Pid2, true, [TraceFlag, {tracer, tracer_test, State2}]), + Tc(Pid2), + ok = trace_delivered(Pid2), + receive M2 -> ct:fail({unexpected, M2}) after 0 -> ok end, + if not Dies -> + {flags, [TraceFlag]} = erlang:trace_info(Pid2, flags), + {tracer, {tracer_test, State2}} = erlang:trace_info(Pid2, tracer), + erlang:trace(Pid2, false, [TraceFlag]); + true -> + ok + end, + + ok. + +check_opts(E, O, Extra) -> + check_opts(E#{ extra => Extra }, O). +check_opts(#{ scheduler_id := number } = E, #{ scheduler_id := N } = O) + when is_integer(N) -> + E1 = maps:remove(scheduler_id, E), + O1 = maps:remove(scheduler_id, O), + if E1 == O1 -> ok; + true -> ct:fail({invalid_opts, E, O}) + end; +check_opts(Opts, Opts) -> + ok; +check_opts(E,O) -> + ct:fail({invalid_opts, E, O}). + +start_tracee() -> + spawn_link( + fun F() -> + receive + Action when is_function(Action) -> + case Action() of + ok -> + F(); + Err -> + Err + end; + _ -> + F() + end + end). + +trace_delivered(Pid) -> + Ref = erlang:trace_delivered(Pid), + receive + {trace_delivered, Pid, Ref} -> + ok + after 1000 -> + timeout + end. + +purge() -> + %% Make sure module is not loaded + case erlang:module_loaded(tracer_test) of + true -> + code:purge(tracer_test), + true = code:delete(tracer_test), + code:purge(tracer_test); + _ -> + ok + end. diff --git a/erts/emulator/test/tracer_SUITE_data/Makefile.src b/erts/emulator/test/tracer_SUITE_data/Makefile.src new file mode 100644 index 0000000000..154bd70ccc --- /dev/null +++ b/erts/emulator/test/tracer_SUITE_data/Makefile.src @@ -0,0 +1,8 @@ + +NIF_LIBS = tracer_test@dll@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ + +$(NIF_LIBS): tracer_test.c diff --git a/erts/emulator/test/tracer_SUITE_data/tracer_test.c b/erts/emulator/test/tracer_SUITE_data/tracer_test.c new file mode 100644 index 0000000000..1555a95d9a --- /dev/null +++ b/erts/emulator/test/tracer_SUITE_data/tracer_test.c @@ -0,0 +1,116 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#include <erl_nif.h> + +#include <stdio.h> +#include <string.h> +#include <assert.h> +#include <limits.h> + +/* NIF interface declarations */ +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); +static void unload(ErlNifEnv* env, void* priv_data); + +/* The NIFs: */ +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ErlNifFunc nif_funcs[] = { + {"enabled", 3, enabled}, + {"trace", 5, trace} +}; + +ERL_NIF_INIT(tracer_test, nif_funcs, load, NULL, upgrade, unload) + +static ERL_NIF_TERM atom_discard; +static ERL_NIF_TERM atom_ok; + +#define ASSERT(expr) assert(expr) + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + + atom_discard = enif_make_atom(env, "discard"); + atom_ok = enif_make_atom(env, "ok"); + + *priv_data = NULL; + + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) +{ + if (*old_priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (*priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (load(env, priv_data, load_info)) { + return -1; + } + return 0; +} + +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int state_arity; + const ERL_NIF_TERM *state_tuple; + ERL_NIF_TERM value; + ASSERT(argc == 3); + + if (!enif_get_tuple(env, argv[1], &state_arity, &state_tuple)) + return atom_discard; + + if (enif_get_map_value(env, state_tuple[0], argv[0], &value)) { + return value; + } else { + return atom_discard; + } +} + +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int state_arity; + ErlNifPid self, to; + ERL_NIF_TERM *tuple, msg; + const ERL_NIF_TERM *state_tuple; + ASSERT(argc == 5); + + enif_get_tuple(env, argv[1], &state_arity, &state_tuple); + + tuple = enif_alloc(sizeof(ERL_NIF_TERM)*(argc)); + memcpy(tuple,argv,sizeof(ERL_NIF_TERM)*argc); + + msg = enif_make_tuple_from_array(env, tuple, argc); + enif_get_local_pid(env, state_tuple[1], &to); + enif_send(env, &to, NULL, msg); + enif_free(tuple); + + return atom_ok; +} diff --git a/erts/emulator/test/tracer_test.erl b/erts/emulator/test/tracer_test.erl new file mode 100644 index 0000000000..a82fd04d2e --- /dev/null +++ b/erts/emulator/test/tracer_test.erl @@ -0,0 +1,55 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(tracer_test). + +%%% +%%% Test tracer +%%% + +-export([enabled/3, trace/5]). +-export([load/1, load/2]). +-on_load(load/0). + +enabled(_, _, _) -> + erlang:nif_error(nif_not_loaded). + +trace(_, _, _, _, _) -> + erlang:nif_error(nif_not_loaded). + +load() -> + case whereis(tracer_test_config) of + undefined -> + ok; + Pid -> + Pid ! {get, self()}, + receive + {Conf, Postfix} -> + load(Conf, Postfix); + Conf -> + load(Conf) + end + end. + +load(DataDir) -> + load(DataDir, ""). +load(DataDir, Postfix) -> + SoFile = atom_to_list(?MODULE) ++ Postfix, + erlang:load_nif(filename:join(DataDir, SoFile) , 0). diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl index 46ece41096..baf41180e0 100644 --- a/erts/emulator/test/tuple_SUITE.erl +++ b/erts/emulator/test/tuple_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,10 +22,11 @@ init_per_group/2,end_per_group/2, t_size/1, t_tuple_size/1, t_element/1, t_setelement/1, t_insert_element/1, t_delete_element/1, - t_list_to_tuple/1, t_tuple_to_list/1, - t_make_tuple_2/1, t_make_tuple_3/1, t_append_element/1, + t_list_to_tuple/1, t_list_to_upper_boundry_tuple/1, t_tuple_to_list/1, + t_make_tuple_2/1, t_make_upper_boundry_tuple_2/1, t_make_tuple_3/1, + t_append_element/1, t_append_element_upper_boundry/1, build_and_match/1, tuple_with_case/1, tuple_in_guard/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Tests tuples and the BIFs: %% @@ -40,8 +42,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [build_and_match, t_size, t_tuple_size, t_list_to_tuple, + t_list_to_upper_boundry_tuple, t_tuple_to_list, t_element, t_setelement, - t_make_tuple_2, t_make_tuple_3, t_append_element, + t_make_tuple_2, t_make_upper_boundry_tuple_2, t_make_tuple_3, + t_append_element, t_append_element_upper_boundry, t_insert_element, t_delete_element, tuple_with_case, tuple_in_guard]. @@ -49,11 +53,21 @@ groups() -> []. init_per_suite(Config) -> + A0 = case application:start(sasl) of + ok -> [sasl]; + _ -> [] + end, + A = case application:start(os_mon) of + ok -> [os_mon|A0]; + _ -> A0 + end, + [{started_apps, A}|Config]. + +end_per_suite(Config) -> + As = proplists:get_value(started_apps, Config), + lists:foreach(fun (A) -> application:stop(A) end, As), Config. -end_per_suite(_Config) -> - ok. - init_per_group(_GroupName, Config) -> Config. @@ -120,6 +134,13 @@ t_element(Config) when is_list(Config) -> {'EXIT', {badarg, _}} = (catch element(1, id(42))), {'EXIT', {badarg, _}} = (catch element(id(1.5), id({a,b}))), + %% Make sure that the loader does not reject the module when + %% huge literal index values are used. + {'EXIT', {badarg, _}} = (catch element((1 bsl 24)-1, id({a,b,c}))), + {'EXIT', {badarg, _}} = (catch element(1 bsl 24, id({a,b,c}))), + {'EXIT', {badarg, _}} = (catch element(1 bsl 32, id({a,b,c}))), + {'EXIT', {badarg, _}} = (catch element(1 bsl 64, id({a,b,c}))), + ok. get_elements([Element|Rest], Tuple, Pos) -> @@ -176,14 +197,19 @@ t_list_to_tuple(Config) when is_list(Config) -> {'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))), {'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))), - % test upper boundry, 16777215 elements - MaxSize = 1 bsl 24 - 1, - MaxTuple = list_to_tuple(lists:seq(1, MaxSize)), - MaxSize = size(MaxTuple), - {'EXIT', {badarg,_}} = (catch list_to_tuple(lists:seq(1, 1 bsl 24))), ok. +t_list_to_upper_boundry_tuple(Config) when is_list(Config) -> + sys_mem_cond_run(2048, + fun () -> + %% test upper boundry, 16777215 elements + MaxSize = 1 bsl 24 - 1, + MaxTuple = list_to_tuple(lists:seq(1, MaxSize)), + MaxSize = size(MaxTuple), + ok + end). + %% Tests tuple_to_list/1. t_tuple_to_list(Config) when is_list(Config) -> @@ -214,8 +240,6 @@ t_make_tuple_2(Config) when is_list(Config) -> t_make_tuple1({a}), t_make_tuple1(erlang:make_tuple(400, [])), - % test upper boundry, 16777215 elements - t_make_tuple(1 bsl 24 - 1, a), {'EXIT', {badarg,_}} = (catch erlang:make_tuple(1 bsl 24, a)), {'EXIT', {badarg,_}} = (catch erlang:make_tuple(-1, a)), @@ -225,6 +249,13 @@ t_make_tuple_2(Config) when is_list(Config) -> {'EXIT', {badarg,_}} = (catch erlang:make_tuple(1 bsl 65 + 3, a)), ok. +t_make_upper_boundry_tuple_2(Config) when is_list(Config) -> + sys_mem_cond_run(2048, + fun () -> + %% test upper boundry, 16777215 elements + t_make_tuple(1 bsl 24 - 1, a) + end). + t_make_tuple1(Element) -> lists:foreach(fun(Size) -> t_make_tuple(Size, Element) end, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 255, 256, 511, 512, 999, @@ -235,7 +266,7 @@ t_make_tuple(Size, Element) -> lists:foreach(fun(El) when El =:= Element -> ok; (Other) -> - test_server:fail({got, Other, expected, Element}) + ct:fail({got, Other, expected, Element}) end, tuple_to_list(Tuple)). %% Tests the erlang:make_tuple/3 BIF. @@ -309,13 +340,17 @@ t_delete_element(Config) when is_list(Config) -> %% Tests the append_element/2 BIF. t_append_element(Config) when is_list(Config) -> - ok = t_append_element({}, 2048, 2048), - - % test upper boundry, 16777215 elements - MaxSize = 1 bsl 24 - 1, - MaxTuple = list_to_tuple(lists:seq(1, MaxSize)), - {'EXIT',{badarg,_}} = (catch erlang:append_element(MaxTuple, a)), - ok. + ok = t_append_element({}, 2048, 2048). + +t_append_element_upper_boundry(Config) when is_list(Config) -> + sys_mem_cond_run(2048, + fun () -> + %% test upper boundry, 16777215 elements + MaxSize = 1 bsl 24 - 1, + MaxTuple = list_to_tuple(lists:seq(1, MaxSize)), + {'EXIT',{badarg,_}} = (catch erlang:append_element(MaxTuple, a)), + ok + end). t_append_element(_Tuple, 0, _High) -> ok; t_append_element(Tuple, N, High) -> @@ -357,17 +392,45 @@ tuple_in_guard(Config) when is_list(Config) -> Tuple1 == {element(1, Tuple2),element(2, Tuple2)} -> ok; true -> - test_server:fail() + ct:fail("failed") end, if Tuple2 == {element(1, Tuple2),element(2, Tuple2), element(3, Tuple2)} -> ok; true -> - test_server:fail() + ct:fail("failed") end, ok. %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. + +sys_mem_cond_run(ReqSizeMB, TestFun) when is_integer(ReqSizeMB) -> + case total_memory() of + TotMem when is_integer(TotMem), TotMem >= ReqSizeMB -> + TestFun(); + TotMem when is_integer(TotMem) -> + {skipped, "Not enough memory ("++integer_to_list(TotMem)++" MB)"}; + undefined -> + {skipped, "Could not retrieve memory information"} + end. + + +total_memory() -> + %% Totat memory in MB. + try + MemoryData = memsup:get_system_memory_data(), + case lists:keysearch(total_memory, 1, MemoryData) of + {value, {total_memory, TM}} -> + TM div (1024*1024); + false -> + {value, {system_total_memory, STM}} = + lists:keysearch(system_total_memory, 1, MemoryData), + STM div (1024*1024) + end + catch + _ : _ -> + undefined + end. diff --git a/erts/emulator/test/unique_SUITE.erl b/erts/emulator/test/unique_SUITE.erl new file mode 100644 index 0000000000..cfc37bd44f --- /dev/null +++ b/erts/emulator/test/unique_SUITE.erl @@ -0,0 +1,375 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(unique_SUITE). + +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). +-export([unique_monotonic_integer_white_box/1, + unique_integer_white_box/1]). + +-include_lib("common_test/include/ct.hrl"). + +%-define(P(V), V). +-define(P(V), print_ret_val(?FILE, ?LINE, V)). + +-define(PRINT(V), print_ret_val(?FILE, ?LINE, V)). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. + +all() -> + [unique_monotonic_integer_white_box, + unique_integer_white_box]. + +init_per_suite(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + Config. + +end_per_suite(_Config) -> + erts_debug:set_internal_state(available_internal_state, false), + ok. + +%% +%% +%% Unique counter white box test case +%% +%% + +unique_monotonic_integer_white_box(Config) when is_list(Config) -> + {ok, Node} = start_node(Config), + TestServer = self(), + Success = make_ref(), + %% Run this in a separate node, so we don't mess up + %% the system when moving the strict monotonic counter + %% around in a non-strict monotonic way... + Test = spawn(Node, + fun () -> + unique_monotonic_integer_white_box_test(TestServer, Success) + end), + Mon = erlang:monitor(process, Test), + receive + {'DOWN', Mon, process, Test, Error} -> + ct:fail(Error); + Success -> + ok + end, + erlang:demonitor(Mon, [flush]), + stop_node(Node), + ok. + +set_unique_monotonic_integer_state(MinCounter, NextValue) -> + true = erts_debug:set_internal_state(unique_monotonic_integer_state, + NextValue-MinCounter-1). + + + +unique_monotonic_integer_white_box_test(TestServer, Success) -> + erts_debug:set_internal_state(available_internal_state, true), + + WordSize = erlang:system_info({wordsize, internal}), + SmallBits = WordSize*8 - 4, + + MinSmall = -1*(1 bsl (SmallBits-1)), + MaxSmall = (1 bsl (SmallBits-1))-1, + %% Make sure we got small sizes correct... + 0 = erts_debug:size(MinSmall), + false = 0 =:= erts_debug:size(MinSmall-1), + 0 = erts_debug:size(MaxSmall), + false = 0 =:= erts_debug:size(MaxSmall+1), + + ?PRINT({min_small, MinSmall}), + ?PRINT({max_small, MaxSmall}), + + MinSint64 = -1*(1 bsl 63), + MaxSint64 = (1 bsl 63)-1, + + ?PRINT({min_Sint64, MinSint64}), + ?PRINT({max_Sint64, MaxSint64}), + + MinCounter = erts_debug:get_internal_state(min_unique_monotonic_integer), + MaxCounter = MinCounter + (1 bsl 64) - 1, + + ?PRINT({min_counter, MinCounter}), + ?PRINT({max_counter, MaxCounter}), + + case WordSize of + 4 -> + MinCounter = MinSint64; + 8 -> + MinCounter = MinSmall + end, + + StartState = erts_debug:get_internal_state(unique_monotonic_integer_state), + + %% Verify that we get expected results over all internal limits... + + case MinCounter < MinSmall of + false -> + 8 = WordSize, + ok; + true -> + 4 = WordSize, + ?PRINT(over_min_small), + set_unique_monotonic_integer_state(MinCounter, MinSmall-2), + true = (?P(erlang:unique_integer([monotonic])) == MinSmall - 2), + true = (?P(erlang:unique_integer([monotonic])) == MinSmall - 1), + true = (?P(erlang:unique_integer([monotonic])) == MinSmall), + true = (?P(erlang:unique_integer([monotonic])) == MinSmall + 1), + true = (?P(erlang:unique_integer([monotonic])) == MinSmall + 2), + garbage_collect(), + ok + end, + + ?PRINT(over_zero), %% Not really an interesting limit, but... + set_unique_monotonic_integer_state(MinCounter, -2), + true = (?P(erlang:unique_integer([monotonic])) == -2), + true = (?P(erlang:unique_integer([monotonic])) == -1), + true = (?P(erlang:unique_integer([monotonic])) == 0), + true = (?P(erlang:unique_integer([monotonic])) == 1), + true = (?P(erlang:unique_integer([monotonic])) == 2), + garbage_collect(), + + ?PRINT(over_max_small), + set_unique_monotonic_integer_state(MinCounter, MaxSmall-2), + true = (?P(erlang:unique_integer([monotonic])) == MaxSmall - 2), + true = (?P(erlang:unique_integer([monotonic])) == MaxSmall - 1), + true = (?P(erlang:unique_integer([monotonic])) == MaxSmall), + true = (?P(erlang:unique_integer([monotonic])) == MaxSmall + 1), + true = (?P(erlang:unique_integer([monotonic])) == MaxSmall + 2), + garbage_collect(), + + case MaxCounter > MaxSint64 of + false -> + 4 = WordSize, + ok; + true -> + 8 = WordSize, + ?PRINT(over_max_sint64), + set_unique_monotonic_integer_state(MinCounter, MaxSint64-2), + true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 - 2), + true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 - 1), + true = (?P(erlang:unique_integer([monotonic])) == MaxSint64), + true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 + 1), + true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 + 2), + garbage_collect() + end, + + ?PRINT(over_max_min_counter), + set_unique_monotonic_integer_state(MinCounter, if MaxCounter == MaxSint64 -> + MaxCounter-2; + true -> + MinCounter-3 + end), + true = (?P(erlang:unique_integer([monotonic])) == MaxCounter - 2), + true = (?P(erlang:unique_integer([monotonic])) == MaxCounter - 1), + true = (?P(erlang:unique_integer([monotonic])) == MaxCounter), + true = (?P(erlang:unique_integer([monotonic])) == MinCounter), + true = (?P(erlang:unique_integer([monotonic])) == MinCounter + 1), + true = (?P(erlang:unique_integer([monotonic])) == MinCounter + 2), + garbage_collect(), + + %% Restore initial state and hope we didn't mess it up for the + %% system... + true = erts_debug:set_internal_state(unique_monotonic_integer_state, + StartState), + + TestServer ! Success. + +%% +%% +%% Unique integer white box test case +%% +%% + +-record(uniqint_info, {min_int, + max_int, + max_small, + schedulers, + sched_bits}). + +unique_integer_white_box(Config) when is_list(Config) -> + UinqintInfo = init_uniqint_info(), + #uniqint_info{min_int = MinInt, + max_int = MaxInt, + max_small = MaxSmall} = UinqintInfo, + io:format("****************************************************~n", []), + io:format("*** Around MIN_UNIQ_INT ~p ***~n", [MinInt]), + io:format("****************************************************~n", []), + check_unique_integer_around(MinInt, UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around 0 ***~n", []), + io:format("****************************************************~n", []), + check_unique_integer_around(0, UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around MAX_SMALL ~p ***~n", [MaxSmall]), + io:format("****************************************************~n", []), + check_unique_integer_around(MaxSmall, UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around 2^64+MIN_UNIQ_INT ~p ***~n", [(1 bsl 64)+MinInt]), + io:format("****************************************************~n", []), + check_unique_integer_around((1 bsl 64)+MinInt, UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around 2^64 ~p~n", [(1 bsl 64)]), + io:format("****************************************************~n", []), + check_unique_integer_around((1 bsl 64), UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around 2^64-MIN_UNIQ_INT ~p ***~n", [(1 bsl 64)-MinInt]), + io:format("****************************************************~n", []), + check_unique_integer_around((1 bsl 64)-MinInt, UinqintInfo), + io:format("****************************************************~n", []), + io:format("*** Around MAX_UNIQ_INT ~p ***~n", [MaxInt]), + io:format("****************************************************~n", []), + check_unique_integer_around(MaxInt, UinqintInfo), + ok. + + +%%% Internal unique_integer_white_box/1 test case + +calc_sched_bits(NoScheds, Shift) when NoScheds < 1 bsl Shift -> + Shift; +calc_sched_bits(NoScheds, Shift) -> + calc_sched_bits(NoScheds, Shift+1). + +schedulers() -> + S = erlang:system_info(schedulers), + try + DCPUS = erlang:system_info(dirty_cpu_schedulers), + DIOS = erlang:system_info(dirty_io_schedulers), + S+DCPUS+DIOS + catch + _ : _ -> + S + end. + +init_uniqint_info() -> + SmallBits = erlang:system_info({wordsize, internal})*8-4, + io:format("SmallBits=~p~n", [SmallBits]), + Schedulers = schedulers(), + io:format("Schedulers=~p~n", [Schedulers]), + MinSmall = -1*(1 bsl (SmallBits-1)), + io:format("MinSmall=~p~n", [MinSmall]), + MaxSmall = (1 bsl (SmallBits-1))-1, + io:format("MaxSmall=~p~n", [MaxSmall]), + SchedBits = calc_sched_bits(Schedulers, 0), + io:format("SchedBits=~p~n", [SchedBits]), + MaxInt = ((((1 bsl 64) - 1) bsl SchedBits) bor Schedulers) + MinSmall, + io:format("MaxInt=~p~n", [MaxInt]), + #uniqint_info{min_int = MinSmall, + max_int = MaxInt, + max_small = MaxSmall, + schedulers = Schedulers, + sched_bits = SchedBits}. + +valid_uniqint(Int, #uniqint_info{min_int = MinInt} = UinqintInfo) when Int < MinInt -> + valid_uniqint(MinInt, UinqintInfo); +valid_uniqint(Int, #uniqint_info{min_int = MinInt, + sched_bits = SchedBits, + schedulers = Scheds}) -> + Int1 = Int - MinInt, + {Inc, ThreadNo} = case Int1 band ((1 bsl SchedBits) - 1) of + TN when TN > Scheds -> + {1, Scheds}; + TN -> + {0, TN} + end, + Counter = ((Int1 bsr SchedBits) + Inc) rem (1 bsl 64), + ((Counter bsl SchedBits) bor ThreadNo) + MinInt. + +smaller_valid_uniqint(Int, UinqintInfo) -> + Cand = Int-1, + case valid_uniqint(Cand, UinqintInfo) of + RI when RI < Int -> + RI; + _ -> + smaller_valid_uniqint(Cand, UinqintInfo) + end. + +mk_uniqint(Int, #uniqint_info {min_int = MinInt, + sched_bits = SchedBits} = _UinqintInfo) -> + Int1 = Int - MinInt, + ThrId = Int1 band ((1 bsl SchedBits) - 1), + Value = (Int1 bsr SchedBits) band ((1 bsl 64) - 1), + 0 = Int1 bsr (SchedBits + 64), + Make = {make_unique_integer, ThrId, Value}, + %% erlang:display(Make), + Res = erts_debug:get_internal_state(Make), + %% erlang:display({uniq_int, Res}), + Res. + +check_uniqint(Int, UinqintInfo) -> + UniqInt = mk_uniqint(Int, UinqintInfo), + io:format("UniqInt=~p ", [UniqInt]), + case UniqInt =:= Int of + true -> + io:format("OK~n~n", []); + false -> + io:format("result Int=~p FAILED~n", [Int]), + exit(badres) + end. + +check_unique_integer_around(Int, #uniqint_info{min_int = MinInt, + max_int = MaxInt} = UinqintInfo) -> + {Start, End} = case {Int =< MinInt+100, Int >= MaxInt-100} of + {true, false} -> + {MinInt, MinInt+100}; + {false, false} -> + {smaller_valid_uniqint(Int-100, UinqintInfo), + valid_uniqint(Int+100, UinqintInfo)}; + {false, true} -> + {MaxInt-100, MaxInt} + end, + lists:foldl(fun (I, OldRefInt) -> + RefInt = valid_uniqint(I, UinqintInfo), + case OldRefInt =:= RefInt of + true -> + ok; + false -> + check_uniqint(RefInt, UinqintInfo) + end, + RefInt + end, + none, + lists:seq(Start, End)). + + +%% helpers + +print_ret_val(File, Line, Value) -> + io:format("~s:~p: ~p~n", [File, Line, Value]), + Value. + +start_node(Config) -> + start_node(Config, []). +start_node(Config, Opts) when is_list(Config), is_list(Opts) -> + Pa = filename:dirname(code:which(?MODULE)), + A = erlang:monotonic_time(1) + erlang:time_offset(1), + B = erlang:unique_integer([positive]), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B)), + test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + +stop_node(Node) -> + test_server:stop_node(Node). diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index 4b3075a164..ac3df8bfbf 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2017. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,148 +30,121 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -%-compile(export_all). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, init_per_testcase/2, - end_per_testcase/2]). +-export([all/0, suite/0]). -export([schedulers_alive/1, node_container_refc_check/1, long_timers/1, pollset_size/1, - check_io_debug/1]). + check_io_debug/1, get_check_io_info/0, + leaked_processes/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(5)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> [schedulers_alive, node_container_refc_check, - long_timers, pollset_size, check_io_debug]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. + long_timers, pollset_size, check_io_debug, + %% Make sure that the leaked_processes/1 is always + %% run last. + leaked_processes]. %%% %%% The test cases ------------------------------------------------------------- %%% -schedulers_alive(doc) -> ["Tests that all schedulers are actually used"]; -schedulers_alive(suite) -> []; +%% Tests that all schedulers are actually used schedulers_alive(Config) when is_list(Config) -> - ?line Master = self(), - ?line NoSchedulersOnline = erlang:system_flag( - schedulers_online, - erlang:system_info(schedulers)), - ?line NoSchedulers = erlang:system_info(schedulers), + Master = self(), + NoSchedulersOnline = erlang:system_flag( + schedulers_online, + erlang:system_info(schedulers)), + NoSchedulers = erlang:system_info(schedulers), UsedScheds = - try - ?line ?t:format("Number of schedulers configured: ~p~n", [NoSchedulers]), - ?line case erlang:system_info(multi_scheduling) of - blocked -> - ?line ?t:fail(multi_scheduling_blocked); - disabled -> - ?line ok; - enabled -> - ?t:format("Testing blocking process exit~n"), - BF = fun () -> - blocked = erlang:system_flag(multi_scheduling, - block), - Master ! {self(), blocking}, - receive after infinity -> ok end - end, - ?line Blocker = spawn_link(BF), - ?line Mon = erlang:monitor(process, Blocker), - ?line receive {Blocker, blocking} -> ok end, - ?line [Blocker] - = erlang:system_info(multi_scheduling_blockers), - ?line unlink(Blocker), - ?line exit(Blocker, kill), - ?line receive {'DOWN', Mon, _, _, _} -> ok end, - ?line enabled = erlang:system_info(multi_scheduling), - ?line [] = erlang:system_info(multi_scheduling_blockers), - ?line ok - end, - ?t:format("Testing blocked~n"), - ?line erlang:system_flag(multi_scheduling, block), - ?line case erlang:system_info(multi_scheduling) of - enabled -> - ?line ?t:fail(multi_scheduling_enabled); - blocked -> - ?line [Master] = erlang:system_info(multi_scheduling_blockers); - disabled -> ?line ok - end, - ?line Ps = lists:map( - fun (_) -> - spawn_link(fun () -> - run_on_schedulers(none, - [], - Master) - end) - end, - lists:seq(1,NoSchedulers)), - ?line receive after 1000 -> ok end, - ?line {_, 1} = verify_all_schedulers_used({[],0}, 1), - ?line lists:foreach(fun (P) -> - unlink(P), - exit(P, bang) - end, - Ps), - ?line case erlang:system_flag(multi_scheduling, unblock) of - blocked -> ?line ?t:fail(multi_scheduling_blocked); - disabled -> ?line ok; - enabled -> ?line ok - end, - erts_debug:set_internal_state(available_internal_state, true), - %% node_and_dist_references will use emulator interal thread blocking... - erts_debug:get_internal_state(node_and_dist_references), - erts_debug:set_internal_state(available_internal_state, false), - ?t:format("Testing not blocked~n"), - ?line Ps2 = lists:map( - fun (_) -> - spawn_link(fun () -> - run_on_schedulers(none, - [], - Master) - end) - end, - lists:seq(1,NoSchedulers)), - ?line receive after 1000 -> ok end, - ?line {_, NoSIDs} = verify_all_schedulers_used({[],0},NoSchedulers), - ?line lists:foreach(fun (P) -> - unlink(P), - exit(P, bang) - end, - Ps2), - NoSIDs - after - NoSchedulers = erlang:system_flag(schedulers_online, - NoSchedulersOnline), - NoSchedulersOnline = erlang:system_info(schedulers_online) - end, - ?line {comment, "Number of schedulers " ++ integer_to_list(UsedScheds)}. + try + io:format("Number of schedulers configured: ~p~n", [NoSchedulers]), + case erlang:system_info(multi_scheduling) of + blocked -> + ct:fail(multi_scheduling_blocked); + disabled -> + ok; + enabled -> + io:format("Testing blocking process exit~n"), + BF = fun () -> + blocked_normal = erlang:system_flag(multi_scheduling, + block_normal), + Master ! {self(), blocking}, + receive after infinity -> ok end + end, + Blocker = spawn_link(BF), + Mon = erlang:monitor(process, Blocker), + receive {Blocker, blocking} -> ok end, + [Blocker] + = erlang:system_info(normal_multi_scheduling_blockers), + unlink(Blocker), + exit(Blocker, kill), + receive {'DOWN', Mon, _, _, _} -> ok end, + enabled = erlang:system_info(multi_scheduling), + [] = erlang:system_info(normal_multi_scheduling_blockers), + ok + end, + io:format("Testing blocked~n"), + erlang:system_flag(multi_scheduling, block_normal), + case erlang:system_info(multi_scheduling) of + enabled -> + ct:fail(multi_scheduling_enabled); + blocked_normal -> + [Master] = erlang:system_info(normal_multi_scheduling_blockers); + disabled -> ok + end, + Ps = lists:map( + fun (_) -> + spawn_link(fun () -> + run_on_schedulers(none, + [], + Master) + end) + end, + lists:seq(1,NoSchedulers)), + receive after 1000 -> ok end, + {_, 1} = verify_all_schedulers_used({[],0}, 1), + lists:foreach(fun (P) -> + unlink(P), + exit(P, bang) + end, Ps), + case erlang:system_flag(multi_scheduling, unblock_normal) of + blocked_normal -> ct:fail(multi_scheduling_blocked); + disabled -> ok; + enabled -> ok + end, + erts_debug:set_internal_state(available_internal_state, true), + %% node_and_dist_references will use emulator interal thread blocking... + erts_debug:get_internal_state(node_and_dist_references), + erts_debug:set_internal_state(available_internal_state, false), + io:format("Testing not blocked~n"), + Ps2 = lists:map( + fun (_) -> + spawn_link(fun () -> + run_on_schedulers(none, + [], + Master) + end) + end, + lists:seq(1,NoSchedulers)), + receive after 1000 -> ok end, + {_, NoSIDs} = verify_all_schedulers_used({[],0},NoSchedulers), + lists:foreach(fun (P) -> + unlink(P), + exit(P, bang) + end, Ps2), + NoSIDs + after + NoSchedulers = erlang:system_flag(schedulers_online, + NoSchedulersOnline), + NoSchedulersOnline = erlang:system_info(schedulers_online) + end, + {comment, "Number of schedulers " ++ integer_to_list(UsedScheds)}. run_on_schedulers(LastSID, SIDs, ReportTo) -> @@ -197,105 +171,149 @@ wait_on_used_scheduler({SIDs, SIDsLen} = State) -> true -> wait_on_used_scheduler(State); false -> - ?t:format("Scheduler ~p used~n", [SID]), + io:format("Scheduler ~p used~n", [SID]), {[SID|SIDs], SIDsLen+1} end end. verify_all_schedulers_used({UsedSIDs, UsedSIDsLen} = State, NoSchedulers) -> - ?line case NoSchedulers of + case NoSchedulers of UsedSIDsLen -> - ?line State; + State; NoSchdlrs when NoSchdlrs < UsedSIDsLen -> - ?line ?t:fail({more_schedulers_used_than_exist, + ct:fail({more_schedulers_used_than_exist, {existing_schedulers, NoSchdlrs}, {used_schedulers, UsedSIDsLen}, {used_scheduler_ids, UsedSIDs}}); _ -> - ?line NewState = wait_on_used_scheduler(State), - ?line verify_all_schedulers_used(NewState, NoSchedulers) + NewState = wait_on_used_scheduler(State), + verify_all_schedulers_used(NewState, NoSchedulers) end. -node_container_refc_check(doc) -> []; -node_container_refc_check(suite) -> []; node_container_refc_check(Config) when is_list(Config) -> - ?line node_container_SUITE:node_container_refc_check(node()), - ?line ok. + node_container_SUITE:node_container_refc_check(node()), + ok. -long_timers(doc) -> - []; -long_timers(suite) -> - []; long_timers(Config) when is_list(Config) -> - ?line ok = long_timers_test:check_result(). + case long_timers_test:check_result() of + ok -> ok; + high_cpu -> {comment, "Ignored failures due to high CPU utilization"}; + missing_cpu_info -> {comment, "Ignored failures due to missing CPU utilization information"}; + Fail -> ct:fail(Fail) + end. + -pollset_size(doc) -> - []; -pollset_size(suite) -> - []; pollset_size(Config) when is_list(Config) -> - ?line Name = pollset_size_testcase_initial_state_holder, - ?line Mon = erlang:monitor(process, Name), - ?line (catch Name ! {get_initial_check_io_result, self()}), - ?line InitChkIo = receive + Name = pollset_size_testcase_initial_state_holder, + Mon = erlang:monitor(process, Name), + (catch Name ! {get_initial_check_io_result, self()}), + InitChkIo = receive {initial_check_io_result, ICIO} -> - ?line erlang:demonitor(Mon, [flush]), - ?line ICIO; + erlang:demonitor(Mon, [flush]), + ICIO; {'DOWN', Mon, _, _, Reason} -> - ?line ?t:fail({non_existing, Name, Reason}) + ct:fail({non_existing, Name, Reason}) end, - ?line FinChkIo = get_check_io_info(), - ?line io:format("Initial: ~p~nFinal: ~p~n", [InitChkIo, FinChkIo]), - ?line InitPollsetSize = lists:keysearch(total_poll_set_size, 1, InitChkIo), - ?line FinPollsetSize = lists:keysearch(total_poll_set_size, 1, FinChkIo), - ?line case InitPollsetSize =:= FinPollsetSize of + FinChkIo = get_check_io_info(), + io:format("Initial: ~p~nFinal: ~p~n", [InitChkIo, FinChkIo]), + InitPollsetSize = lists:keysearch(total_poll_set_size, 1, InitChkIo), + FinPollsetSize = lists:keysearch(total_poll_set_size, 1, FinChkIo), + HasGethost = case has_gethost() of true -> 1; _ -> 0 end, + case InitPollsetSize =:= FinPollsetSize of true -> case InitPollsetSize of {value, {total_poll_set_size, Size}} -> - ?line {comment, + {comment, "Pollset size: " ++ integer_to_list(Size)}; _ -> - ?line {skipped, + {skipped, "Pollset size information not available"} end; false -> - %% Somtimes we have fewer descriptors in the + %% Sometimes we have fewer descriptors in the %% pollset at the end than when we started, but %% that is ok as long as there are at least 2 %% descriptors (dist listen socket and %% epmd socket) in the pollset. - ?line {value, {total_poll_set_size, InitSize}} + {value, {total_poll_set_size, InitSize}} = InitPollsetSize, - ?line {value, {total_poll_set_size, FinSize}} + {value, {total_poll_set_size, FinSize}} = FinPollsetSize, - ?line true = FinSize < InitSize, - ?line true = 2 =< FinSize, - ?line {comment, + true = FinSize < (InitSize + HasGethost), + true = 2 =< FinSize, + {comment, "Start pollset size: " ++ integer_to_list(InitSize) ++ " End pollset size: " ++ integer_to_list(FinSize)} end. -check_io_debug(doc) -> - []; -check_io_debug(suite) -> - []; check_io_debug(Config) when is_list(Config) -> - ?line case lists:keysearch(name, 1, erlang:system_info(check_io)) of - {value, {name, erts_poll}} -> ?line check_io_debug_test(); - _ -> ?line {skipped, "Not implemented in this emulator"} + case lists:keysearch(name, 1, erlang:system_info(check_io)) of + {value, {name, erts_poll}} -> check_io_debug_test(); + _ -> {skipped, "Not implemented in this emulator"} end. check_io_debug_test() -> - ?line erts_debug:set_internal_state(available_internal_state, true), - ?line erlang:display(erlang:system_info(check_io)), - ?line NoOfErrorFds = erts_debug:get_internal_state(check_io_debug), - ?line erts_debug:set_internal_state(available_internal_state, false), - ?line 0 = NoOfErrorFds, - ?line ok. - + erlang:display(get_check_io_info()), + erts_debug:set_internal_state(available_internal_state, true), + {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug + = erts_debug:get_internal_state(check_io_debug), + erts_debug:set_internal_state(available_internal_state, false), + HasGetHost = has_gethost(), + ct:log("check_io_debug: ~p~n" + "HasGetHost: ~p",[CheckIoDebug, HasGetHost]), + 0 = NoErrorFds, + if + NoUsedFds == NoDrvSelStructs -> + ok; + HasGetHost andalso (NoUsedFds == (NoDrvSelStructs - 1)) -> + %% If the inet_gethost port is alive, we may have + %% one extra used fd that is not selected on. + %% This happens when the initial setup of the + %% port returns an EAGAIN + ok + end, + 0 = NoDrvEvStructs, + ok. +has_gethost() -> + has_gethost(erlang:ports()). +has_gethost([P|T]) -> + case erlang:port_info(P, name) of + {name,"inet_gethost"++_} -> + true; + _ -> + has_gethost(T) + end; +has_gethost([]) -> + false. + +leaked_processes(Config) when is_list(Config) -> + %% Replace the defualt timetrap with a timetrap with + %% known pid. + test_server:timetrap_cancel(), + Dog = test_server:timetrap(test_server:minutes(5)), + + Name = leaked_processes__process_holder, + Name ! {get_initial_processes, self()}, + receive + {initial_processes, Initial0} -> ok + end, + Initial = ordsets:from_list(Initial0), + + KnownPids = ordsets:from_list([self(),Dog]), + Now0 = ordsets:from_list(processes()), + Now = ordsets:subtract(Now0, KnownPids), + Leaked = ordsets:subtract(Now, Initial), + + _ = [begin + Info = process_info(P) ++ process_info(P, [current_stacktrace]), + io:format("~p: ~p\n", [P,Info]) + end || P <- Leaked], + Comment = lists:flatten(io_lib:format("~p process(es)", + [length(Leaked)])), + {comment, Comment}. %% %% Internal functions... @@ -305,24 +323,26 @@ display_check_io(ChkIo) -> catch erlang:display('--- CHECK IO INFO ---'), catch erlang:display(ChkIo), catch erts_debug:set_internal_state(available_internal_state, true), - NoOfErrorFds = (catch erts_debug:get_internal_state(check_io_debug)), + NoOfErrorFds = (catch element(1, erts_debug:get_internal_state(check_io_debug))), catch erlang:display({'NoOfErrorFds', NoOfErrorFds}), catch erts_debug:set_internal_state(available_internal_state, false), catch erlang:display('--- CHECK IO INFO ---'), ok. get_check_io_info() -> - ChkIo = erlang:system_info(check_io), - case lists:keysearch(pending_updates, 1, ChkIo) of - {value, {pending_updates, 0}} -> + ChkIo = driver_SUITE:get_check_io_total(erlang:system_info(check_io)), + PendUpdNo = case lists:keysearch(pending_updates, 1, ChkIo) of + {value, {pending_updates, PendNo}} -> + PendNo; + false -> + 0 + end, + {value, {active_fds, ActFds}} = lists:keysearch(active_fds, 1, ChkIo), + case {PendUpdNo, ActFds} of + {0, 0} -> display_check_io(ChkIo), ChkIo; - false -> - ChkIo; _ -> - receive after 10 -> ok end, + receive after 100 -> ok end, get_check_io_info() end. - - - |