diff options
Diffstat (limited to 'erts/emulator/test')
138 files changed, 12620 insertions, 3719 deletions
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 2e48c475d5..6a064ec8d4 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2016. All Rights Reserved. +# 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. @@ -33,6 +33,7 @@ MODULES= \ after_SUITE \ alloc_SUITE \ async_ports_SUITE \ + atomics_SUITE \ beam_SUITE \ beam_literals_SUITE \ bif_SUITE \ @@ -50,12 +51,15 @@ MODULES= \ call_trace_SUITE \ code_SUITE \ code_parallel_load_SUITE \ + counters_SUITE \ 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 \ @@ -65,14 +69,15 @@ 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 \ @@ -85,8 +90,11 @@ MODULES= \ num_bif_SUITE \ message_queue_data_SUITE \ op_SUITE \ + os_signal_SUITE \ port_SUITE \ port_bif_SUITE \ + prim_eval_SUITE \ + persistent_term_SUITE \ process_SUITE \ pseudoknot_SUITE \ receive_SUITE \ @@ -115,11 +123,9 @@ MODULES= \ 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 \ @@ -154,7 +160,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 diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl index 880c5a5821..5b04a15b85 100644 --- a/erts/emulator/test/a_SUITE.erl +++ b/erts/emulator/test/a_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-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. @@ -29,25 +29,55 @@ -include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0, - 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]}]. -all() -> - [long_timers, pollset_size]. +all() -> + [leaked_processes, long_timers, pollset_size]. + +%% Start some system servers now to avoid having them +%% reported as leaks. + +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"), + + %% Start the timer server. + timer:start(), + + 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(Config) when is_list(Config) -> 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 testcase."}. + "erts testsuite and ends in the z_SUITE:long_timers/1 testcase."}. 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"), Parent = self(), Go = make_ref(), spawn(fun () -> @@ -63,21 +93,11 @@ pollset_size(Config) when is_list(Config) -> 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 testcase."}. + "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 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() -> z_SUITE:get_check_io_info(). diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl index b1f7e06bf5..8a34195e8d 100644 --- a/erts/emulator/test/after_SUITE.erl +++ b/erts/emulator/test/after_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% 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. @@ -45,13 +45,15 @@ all() -> %% Tests for an old round-off error in 'receive after'." t_after(Config) when is_list(Config) -> - spawn(fun frequent_process/0), + Frequent = spawn_link(fun frequent_process/0), Period = test_server:minutes(1), Before = erlang:monotonic_time(), receive after Period -> - After = erlang:monotonic_time(), - report(Period, Before, After) + After = erlang:monotonic_time(), + unlink(Frequent), + exit(Frequent, die), + report(Period, Before, After) end. report(Period, Before, After) -> diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 3a721095e2..343afe85e6 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. +%% Copyright Ericsson AB 2003-2018. 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. @@ -31,6 +31,7 @@ mseg_clear_cache/1, erts_mmap/1, cpool/1, + set_dyn_param/1, migration/1]). -include_lib("common_test/include/ct.hrl"). @@ -41,6 +42,7 @@ suite() -> all() -> [basic, coalesce, threads, realloc_copy, bucket_index, + set_dyn_param, bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool, migration]. init_per_testcase(Case, Config) when is_list(Config) -> @@ -65,12 +67,11 @@ mseg_clear_cache(Cfg) -> drv_case(Cfg). cpool(Cfg) -> drv_case(Cfg). migration(Cfg) -> - case erlang:system_info(smp_support) of - true -> - drv_case(Cfg, concurrent, "+MZe true"); - false -> - {skipped, "No smp"} - end. + %% Enable test_alloc. + %% Disable driver_alloc to avoid recursive alloc_util calls + %% through enif_mutex_create() in my_creating_mbc(). + drv_case(Cfg, concurrent, "+MZe true +MRe false"), + drv_case(Cfg, concurrent, "+MZe true +MRe false +MZas ageffcbf"). erts_mmap(Config) when is_list(Config) -> case {os:type(), mmsc_flags()} of @@ -94,10 +95,11 @@ mmsc_flags() -> mmsc_flags(Env) -> case os:getenv(Env) of false -> false; - V -> case string:str(V, "+MMsc") of - 0 -> false; - P -> Env ++ "=" ++ string:substr(V, P) - end + V -> + case string:find(V, "+MMsc") of + nomatch -> false; + SubStr -> Env ++ "=" ++ SubStr + end end. erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> @@ -114,7 +116,7 @@ erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> 0 -> O1; _ -> O1 ++ " +MMscrfsd"++integer_to_list(SCRFSD) end, - {ok, Node} = start_node(Config, Opts), + {ok, Node} = start_node(Config, Opts, []), Self = self(), Ref = make_ref(), F = fun() -> @@ -144,6 +146,82 @@ erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> Result. +%% Test erlang:system_flag(erts_alloc, ...) +set_dyn_param(_Config) -> + {_, _, _, AlcList} = erlang:system_info(allocator), + + {Enabled, Disabled, Others} = + lists:foldl(fun({sys_alloc,_}, {Es, Ds, Os}) -> + {Es, [sys_alloc | Ds], Os}; + + ({AT, Opts}, {Es, Ds, Os}) when is_list(Opts) -> + case lists:keyfind(e, 1, Opts) of + {e, true} -> + {[AT | Es], Ds, Os}; + {e, false} -> + {Es, [AT | Ds], Os}; + false -> + {Es, Ds, [AT | Os]} + end; + + (_, Acc) -> Acc + end, + {[], [], []}, + AlcList), + + Param = sbct, + lists:foreach(fun(AT) -> set_dyn_param_enabled(AT, Param) end, + Enabled), + + lists:foreach(fun(AT) -> + Tpl = {AT, Param, 12345}, + io:format("~p\n", [Tpl]), + notsup = erlang:system_flag(erts_alloc, Tpl) + end, + Disabled), + + lists:foreach(fun(AT) -> + Tpl = {AT, Param, 12345}, + io:format("~p\n", [Tpl]), + {'EXIT',{badarg,_}} = + (catch erlang:system_flag(erts_alloc, Tpl)) + end, + Others), + ok. + +set_dyn_param_enabled(AT, Param) -> + OldVal = get_alc_param(AT, Param), + + Val1 = OldVal div 2, + Tuple = {AT, Param, Val1}, + io:format("~p\n", [Tuple]), + ok = erlang:system_flag(erts_alloc, Tuple), + Val1 = get_alc_param(AT, Param), + + ok = erlang:system_flag(erts_alloc, {AT, Param, OldVal}), + OldVal = get_alc_param(AT, Param), + ok. + +get_alc_param(AT, Param) -> + lists:foldl(fun({instance,_,Istats}, Acc) -> + {options,Opts} = lists:keyfind(options, 1, Istats), + {Param,Val} = lists:keyfind(Param, 1, Opts), + {as,Strategy} = lists:keyfind(as, 1, Opts), + + case {param_for_strat(Param, Strategy), Acc} of + {false, _} -> Acc; + {true, undefined} -> Val; + {true, _} -> + Val = Acc + end + end, + undefined, + erlang:system_info({allocator, AT})). + +param_for_strat(sbct, gf) -> false; +param_for_strat(_, _) -> true. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% %% Internal functions %% @@ -155,7 +233,9 @@ drv_case(Config) -> drv_case(Config, Mode, NodeOpts) when is_list(Config) -> case os:type() of {Family, _} when Family == unix; Family == win32 -> - {ok, Node} = start_node(Config, NodeOpts), + %%Prog = {prog,"/my/own/otp/bin/cerl -debug"}, + Prog = [], + {ok, Node} = start_node(Config, NodeOpts, Prog), Self = self(), Ref = make_ref(), spawn_link(Node, @@ -221,19 +301,35 @@ 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})), - + IFun = fun({instance,Inr,Istats}, {Bacc,Cacc,Pacc}) -> + {mbcs,MBCS} = lists:keyfind(mbcs, 1, Istats), + Btup = lists:keyfind(blocks, 1, MBCS), + Ctup = lists:keyfind(carriers, 1, MBCS), + + Ptup = case lists:keyfind(mbcs_pool, 1, Istats) of + {mbcs_pool,POOL} -> + {blocks, Bpool} = lists:keyfind(blocks, 1, POOL), + {carriers, Cpool} = lists:keyfind(carriers, 1, POOL), + {pool, Bpool, Cpool}; + false -> + {pool, 0, 0} + end, + io:format("{instance,~p,~p,~p,~p}}\n", + [Inr, Btup, Ctup, Ptup]), + {tuple_add(Bacc,Btup),tuple_add(Cacc,Ctup), + tuple_add(Pacc,Ptup)}; + (_, Acc) -> Acc + end, + + {Btot,Ctot,Ptot} = lists:foldl(IFun, + {{blocks,0,0,0},{carriers,0,0,0},{pool,0,0}}, + erlang:system_info({allocator,test_alloc})), + + {pool, PBtot, PCtot} = Ptot, io:format("Number of blocks : ~p\n", [Btot]), - io:format("Number of carriers: ~p\n", [Ctot]); + io:format("Number of carriers: ~p\n", [Ctot]), + io:format("Number of pooled blocks : ~p\n", [PBtot]), + io:format("Number of pooled carriers: ~p\n", [PCtot]); print_stats(_) -> ok. tuple_add(T1, T2) -> @@ -330,13 +426,13 @@ handle_result(_State, Result0) -> continue end. -start_node(Config, Opts) when is_list(Config), is_list(Opts) -> +start_node(Config, Opts, Prog) when is_list(Config), is_list(Opts) -> case proplists:get_value(debug,Config) of true -> {ok, node()}; - _ -> start_node_1(Config, Opts) + _ -> start_node_1(Config, Opts, Prog) end. -start_node_1(Config, Opts) -> +start_node_1(Config, Opts, Prog) -> Pa = filename:dirname(code:which(?MODULE)), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" @@ -345,7 +441,11 @@ start_node_1(Config, Opts) -> ++ integer_to_list(erlang:system_time(second)) ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), - test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + ErlArg = case Prog of + [] -> []; + _ -> [{erl,[Prog]}] + end, + test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa} | ErlArg]). stop_node(Node) when Node =:= node() -> ok; stop_node(Node) -> diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h index 97ee58cdad..5272f86c98 100644 --- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h +++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h @@ -156,7 +156,8 @@ typedef void* erts_cond; #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)) +#define REALLOC_TEST(P,S) ((void*) ALC_TEST2(0xf16, (P), (S))) +#define SET_TEST_MBC_USER_HEADER(SZ,CMBC,DMBC) ((int)ALC_TEST3(0xf17, (SZ), (CMBC), (DMBC))) +#define GET_TEST_MBC_SIZE() ((int) ALC_TEST0(0xf18)) #endif diff --git a/erts/emulator/test/alloc_SUITE_data/migration.c b/erts/emulator/test/alloc_SUITE_data/migration.c index b9a4de03b3..78f3a633e8 100644 --- a/erts/emulator/test/alloc_SUITE_data/migration.c +++ b/erts/emulator/test/alloc_SUITE_data/migration.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2014-2016. All Rights Reserved. + * Copyright Ericsson AB 2014-2018. 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 @@ -223,6 +223,42 @@ static int rand_int(MigrationState* state, int low, int high) return low + (x % (high+1-low)); } +enum Operation +{ + ALLOCATE_OP, + FREE_OP, + REALLOC_OP, + CLEANUP_OP +}; + +static enum Operation rand_op(MigrationState* state) +{ + int r = rand_int(state, 1, 100); + switch (state->phase) { + case GROWING: + FATAL_ASSERT(state->nblocks < state->max_nblocks); + if (r > 10 || state->nblocks == 0) + return ALLOCATE_OP; + else if (r > 5) + return FREE_OP; + else + return REALLOC_OP; + + case SHRINKING: + FATAL_ASSERT(state->nblocks > 0); + if (r > 10 || state->nblocks == state->max_nblocks) + return FREE_OP; + else if (r > 5) + return ALLOCATE_OP; + else + return REALLOC_OP; + + case CLEANUP: + return CLEANUP_OP; + default: + FATAL_ASSERT(!"Invalid op phase"); + } +} static void do_cleanup(TestCaseState_t *tcs, MigrationState* state) { @@ -275,53 +311,75 @@ testcase_run(TestCaseState_t *tcs) state->goal_nblocks = rand_int(state, 1, state->max_nblocks); } - switch (state->phase) { - case GROWING: { + switch (rand_op(state)) { + case ALLOCATE_OP: { MyBlock* p; FATAL_ASSERT(!state->blockv[state->nblocks]); - p = ALLOC_TEST(rand_int(state, state->block_size/2, state->block_size)); + 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]); + state->blockv[state->nblocks++] = p; break; } - case SHRINKING: { + case FREE_OP: { 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 REALLOC_OP: { + int ix = rand_int(state, 0, state->nblocks-1); + MyBlock* p; + FATAL_ASSERT(state->blockv[ix]); + remove_block(state->blockv[ix]); + p = REALLOC_TEST(state->blockv[ix], rand_int(state, state->block_size/2, state->block_size)); + FATAL_ASSERT(p); + add_block(p, state); + state->blockv[ix] = p; + break; + } + case CLEANUP_OP: + do_cleanup(tcs, state); + break; + default: + FATAL_ASSERT(!"Invalid operation"); + } + + switch (state->phase) { + case GROWING: { + 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: { + 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; + case DONE: + break; default: FATAL_ASSERT(!"Invalid phase"); } - if (state->phase == DONE) { - } - else { + if (state->phase != DONE) { testcase_continue(tcs); } } diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h index f0ca91bd06..2b742dd7e3 100644 --- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h +++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h @@ -20,7 +20,7 @@ #ifndef TESTCASE_DRIVER_H__ #define TESTCASE_DRIVER_H__ -#include "erl_nif.h" +#include <erl_nif.h> #include <stdlib.h> typedef struct { diff --git a/erts/emulator/test/atomics_SUITE.erl b/erts/emulator/test/atomics_SUITE.erl new file mode 100644 index 0000000000..8c42354770 --- /dev/null +++ b/erts/emulator/test/atomics_SUITE.erl @@ -0,0 +1,147 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. 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(atomics_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-compile(export_all). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [signed, unsigned, bad, signed_limits, unsigned_limits]. + +signed(Config) when is_list(Config) -> + Size = 10, + Ref = atomics:new(Size,[]), + #{size:=Size, memory:=Memory} = atomics:info(Ref), + {_,true} = {Memory, Memory > Size*8}, + {_,true} = {Memory, Memory < Size*max_atomic_sz() + 100}, + [signed_do(Ref, Ix) || Ix <- lists:seq(1, Size)], + ok. + +signed_do(Ref, Ix) -> + 0 = atomics:get(Ref, Ix), + ok = atomics:put(Ref, Ix, 3), + ok = atomics:add(Ref, Ix, 14), + 17 = atomics:get(Ref, Ix), + 20 = atomics:add_get(Ref, Ix, 3), + -3 = atomics:add_get(Ref, Ix, -23), + 17 = atomics:add_get(Ref, Ix, 20), + ok = atomics:sub(Ref, Ix, 4), + 13 = atomics:get(Ref, Ix), + -7 = atomics:sub_get(Ref, Ix, 20), + 3 = atomics:sub_get(Ref, Ix, -10), + 3 = atomics:exchange(Ref, Ix, 666), + ok = atomics:compare_exchange(Ref, Ix, 666, 777), + 777 = atomics:compare_exchange(Ref, Ix, 666, -666), + ok. + +unsigned(Config) when is_list(Config) -> + Size = 10, + Ref = atomics:new(Size,[{signed, false}]), + #{size:=Size, memory:=Memory} = atomics:info(Ref), + true = Memory > Size*8, + true = Memory < Size*max_atomic_sz() + 100, + [unsigned_do(Ref, Ix) || Ix <- lists:seq(1, Size)], + ok. + +unsigned_do(Ref, Ix) -> + 0 = atomics:get(Ref, Ix), + ok = atomics:put(Ref, Ix, 3), + ok = atomics:add(Ref, Ix, 14), + 17 = atomics:get(Ref, Ix), + 20 = atomics:add_get(Ref, Ix, 3), + ok = atomics:sub(Ref, Ix, 7), + 13 = atomics:get(Ref, Ix), + 3 = atomics:sub_get(Ref, Ix, 10), + 3 = atomics:exchange(Ref, Ix, 666), + ok = atomics:compare_exchange(Ref, Ix, 666, 777), + 777 = atomics:compare_exchange(Ref, Ix, 666, 888), + ok. + +bad(Config) when is_list(Config) -> + {'EXIT',{badarg,_}} = (catch atomics:new(0,[])), + {'EXIT',{badarg,_}} = (catch atomics:new(10,[bad])), + {'EXIT',{badarg,_}} = (catch atomics:new(10,[{signed,bad}])), + {'EXIT',{badarg,_}} = (catch atomics:new(10,[{signed,true}, bad])), + {'EXIT',{badarg,_}} = (catch atomics:new(10,[{signed,false} | bad])), + Ref = atomics:new(10,[]), + {'EXIT',{badarg,_}} = (catch atomics:get(1742, 7)), + {'EXIT',{badarg,_}} = (catch atomics:get(make_ref(), 7)), + {'EXIT',{badarg,_}} = (catch atomics:get(Ref, -1)), + {'EXIT',{badarg,_}} = (catch atomics:get(Ref, 0)), + {'EXIT',{badarg,_}} = (catch atomics:get(Ref, 11)), + {'EXIT',{badarg,_}} = (catch atomics:get(Ref, 7.0)), + ok. + + +signed_limits(Config) when is_list(Config) -> + Bits = 64, + Max = (1 bsl (Bits-1)) - 1, + Min = -(1 bsl (Bits-1)), + + Ref = atomics:new(1,[{signed, true}]), + #{max:=Max, min:=Min} = atomics:info(Ref), + 0 = atomics:get(Ref, 1), + ok = atomics:add(Ref, 1, Max), + Min = atomics:add_get(Ref, 1, 1), + Max = atomics:sub_get(Ref, 1, 1), + + IncrMax = (Max bsl 1) bor 1, + ok = atomics:put(Ref, 1, 0), + ok = atomics:add(Ref, 1, IncrMax), + -1 = atomics:get(Ref, 1), + {'EXIT',{badarg,_}} = (catch atomics:add(Ref, 1, IncrMax+1)), + {'EXIT',{badarg,_}} = (catch atomics:add(Ref, 1, Min-1)), + + ok. + +unsigned_limits(Config) when is_list(Config) -> + Bits = 64, + Max = (1 bsl Bits) - 1, + Min = 0, + + Ref = atomics:new(1,[{signed,false}]), + #{max:=Max, min:=Min} = atomics:info(Ref), + 0 = atomics:get(Ref, 1), + ok = atomics:add(Ref, 1, Max), + Min = atomics:add_get(Ref, 1, 1), + Max = atomics:sub_get(Ref, 1, 1), + + {'EXIT',{badarg,_}} = (catch atomics:add(Ref, 1, Max+1)), + IncrMin = -(1 bsl (Bits-1)), + ok = atomics:put(Ref, 1, -IncrMin), + ok = atomics:add(Ref, 1, IncrMin), + 0 = atomics:get(Ref, 1), + {'EXIT',{badarg,_}} = (catch atomics:add(Ref, 1, IncrMin-1)), + + ok. + +max_atomic_sz() -> + case erlang:system_info({wordsize, external}) of + 4 -> 16; + 8 -> + EI = erlang:system_info(ethread_info), + case lists:keyfind("64-bit native atomics", 1, EI) of + {_, "no", _} -> 16; + _ -> 8 + end + end. diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index 6a54fa87e0..d3b3b96b14 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2018. 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. @@ -113,20 +113,41 @@ packed_registers(Config) when is_list(Config) -> 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]).\n" + "id([_@Vars,_@NewVars,_@MoreNewVars]).\n" "id(I) -> I.\n"]), merl:compile_and_load(Code), - CombinedSeq = Seq ++ Seq, + + %% 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, + + CombinedSeq = Seq ++ Seq ++ Seq, CombinedSeq = Mod:f(), %% Clean up. diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl index 09761263e2..82a5e2b172 100644 --- a/erts/emulator/test/beam_literals_SUITE.erl +++ b/erts/emulator/test/beam_literals_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -248,35 +248,58 @@ literal_type_tests(Config) when is_list(Config) -> ok. make_test([{is_function=T,L}|Ts]) -> - [test(T, L),test(T, 0, L)|make_test(Ts)]; + [guard_test(T, L),guard_test(T, 0, L),body_test(T, L),body_test(T, 0, L)|make_test(Ts)]; make_test([{T,L}|Ts]) -> - [test(T, L)|make_test(Ts)]; + [guard_test(T, L),body_test(T, L)|make_test(Ts)]; make_test([]) -> []. -test(T, L) -> - S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L])), - {ok,Toks,_Line} = erl_scan:string(S), - {ok,E} = erl_parse:parse_exprs(Toks), - {value,Val,_Bs} = erl_eval:exprs(E, []), +guard_test(_, L) when is_function(L) -> + %% Skip guard tests with exports - they are not literals + {atom,erl_anno:new(0),true}; +guard_test(T, L) -> + S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L]), + {Val,Expr} = eval_string(S), + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},Expr}. + +guard_test(_, _, L) when is_function(L) -> + %% Skip guard tests with exports - they are not literals + {atom,erl_anno:new(0),true}; +guard_test(T, A, L) -> + S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", [T,L,A,T,L,A]), + {Val,Expr} = eval_string(S), + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},Expr}. + +body_test(T, L) -> + S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), ~w(~w) end. ", [T,L,T,L]), + {Val,Expr} = eval_string(S), Anno = erl_anno:new(0), - {match,Anno,{atom,Anno,Val},hd(E)}. + {match,Anno,{atom,Anno,Val},Expr}. -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. ", - [T,L,A,T,L,A])), - {ok,Toks,_Line} = erl_scan:string(S), +body_test(T, A, L) -> + S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), ~w(~w,~w) end. ", [T,L,A,T,L,A]), + {Val,Expr} = eval_string(S), + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},Expr}. + +eval_string(S) -> + {ok,Toks,_Line} = erl_scan:string(lists:flatten(S)), {ok,E} = erl_parse:parse_exprs(Toks), {value,Val,_Bs} = erl_eval:exprs(E, []), - Anno = erl_anno:new(0), - {match,Anno,{atom,Anno,Val},hd(E)}. - + {Val,hd(E)}. + literals() -> [42, 3.14, -3, 32982724987789283473473838474, [], - xxxx]. + "abc", + <<"abc">>, + {}, + xxxx, + fun erlang:erase/0]. type_tests() -> [is_boolean, diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index d31399e4af..9e7bcd5255 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. +%% Copyright Ericsson AB 2005-2018. 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. @@ -24,14 +24,20 @@ -include_lib("kernel/include/file.hrl"). -export([all/0, suite/0, - display/1, display_huge/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, - is_builtin/1]). + erl_crash_dump_bytes/1, + is_builtin/1, error_stacktrace/1, + error_stacktrace_during_call_trace/1, + group_leader_prio/1, group_leader_prio_dirty/1, + is_process_alive/1, + process_info_blast/1, + os_env_case_sensitivity/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -41,9 +47,12 @@ 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, is_builtin]. + erl_crash_dump_bytes, min_max, erlang_halt, is_builtin, + error_stacktrace, error_stacktrace_during_call_trace, + group_leader_prio, group_leader_prio_dirty, + is_process_alive, process_info_blast, os_env_case_sensitivity]. %% Uses erlang:display to test that erts_printf does not do deep recursion display(Config) when is_list(Config) -> @@ -65,6 +74,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(), @@ -336,6 +367,38 @@ check_stub({_,F,A}, B) -> 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) -> all = list_to_existing_atom("all"), ?MODULE = list_to_existing_atom(?MODULE_STRING), @@ -381,6 +444,17 @@ os_env_long(Min, Max, Value) -> true = os:unsetenv(EnvVar), os_env_long(Min+1, Max, Value). +os_env_case_sensitivity(Config) when is_list(Config) -> + %% The keys in os:getenv/putenv must be case-insensitive on Windows, and + %% case-sensitive elsewhere. + true = os:putenv("os_env_gurka", "gaffel"), + Expected = case os:type() of + {win32, _} -> "gaffel"; + _ -> false + end, + Expected = os:getenv("OS_ENV_GURKA"), + ok. + %% Test that string:to_integer does not Halloc in wrong order. otp_7526(Config) when is_list(Config) -> ok = test_7526(256). @@ -426,6 +500,8 @@ 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 '' = test_binary_to_atom(<<>>, latin1), @@ -437,12 +513,17 @@ binary_to_atom(Config) when is_list(Config) -> '' = 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. fail_binary_to_atom(atom), fail_binary_to_atom(42), @@ -461,10 +542,8 @@ binary_to_atom(Config) when is_list(Config) -> ?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. - [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(256, 16#D7FF)], - [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#E000, 16#FFFD)], - [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#10000, 16#8FFFF)], - [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#90000, 16#10FFFF)], + <<B:1/binary, _/binary>> = id(<<194, 163>>), %Truncated character ERL-474 + ?BADARG(binary_to_atom(B, utf8)), %% system_limit failures. ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)), @@ -653,6 +732,9 @@ erlang_halt(Config) when is_list(Config) -> {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. @@ -664,12 +746,14 @@ erlang_halt(Config) when is_list(Config) -> [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,_} = wait_until_stable_size(CrashDump,-1), {ok, Bin} = file:read_file(CrashDump), - case {string:str(binary_to_list(Bin),"\n=end\n"), - string:str(binary_to_list(Bin),"\r\n=end\r\n")} of - {0,0} -> ct:fail("Could not find end marker in crash dump"); - _ -> ok + 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) -> @@ -681,29 +765,424 @@ wait_until_stable_size(File,PrevSz) -> 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; + {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), - %% erlang:apply/3 is considered to be built-in, but is not - %% implemented as other BIFs. + %% Built-ins implemented as special instructions. + Instructions = [{erlang,apply,2},{erlang,apply,3},{erlang,yield,0}], - Builtins0 = [{erlang,apply,3}|erlang:system_info(snifs)], + Builtins0 = Instructions ++ erlang:system_info(snifs), Builtins = ordsets:from_list(Builtins0), - NotBuiltin = ordsets:subtract(Exp, Builtins), - _ = [true = erlang:is_builtin(M, F, A) || {M,F,A} <- Builtins], - _ = [false = erlang:is_builtin(M, F, A) || {M,F,A} <- NotBuiltin], + + 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. -%% Helpers +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)). + + +group_leader_prio(Config) when is_list(Config) -> + group_leader_prio_test(false). + +group_leader_prio_dirty(Config) when is_list(Config) -> + group_leader_prio_test(true). + +group_leader_prio_test(Dirty) -> + %% + %% Unfortunately back in the days node local group_leader/2 was not + %% implemented as sending an asynchronous signal to the process to change + %% group leader for. Instead it has always been synchronously changed, and + %% nothing in the documentation have hinted otherwise... Therefore I do not + %% dare the change this. + %% + %% In order to prevent priority inversion, the priority of the receiver of + %% the group leader signal is elevated while handling incoming signals if + %% the sender has a higher priority than the receiver. This test tests that + %% the priority elevation actually works... + %% + Tester = self(), + Init = erlang:whereis(init), + GL = erlang:group_leader(), + process_flag(priority, max), + {TestProcFun, NTestProcs} + = case Dirty of + false -> + %% These processes will handle all incoming signals + %% by them selves... + {fun () -> + Tester ! {alive, self()}, + receive after infinity -> ok end + end, + 100}; + true -> + %% These processes wont handle incoming signals by + %% them selves since they are stuck on dirty schedulers + %% when we try to change group leader. A dirty process + %% signal handler process (system process) will be notified + %% of the need to handle incoming signals for these processes, + %% and will instead handle the signal for these processes... + {fun () -> + %% The following sends the message '{alive, self()}' + %% to Tester once on a dirty io scheduler, then wait + %% there until the process terminates... + erts_debug:dirty_io(alive_waitexiting, Tester) + end, + erlang:system_info(dirty_io_schedulers)} + end, + TPs = lists:map(fun (_) -> + spawn_opt(TestProcFun, + [link, {priority, normal}]) + end, lists:seq(1, NTestProcs)), + lists:foreach(fun (TP) -> receive {alive, TP} -> ok end end, TPs), + TLs = lists:map(fun (_) -> + spawn_opt(fun () -> tok_loop() end, + [link, {priority, high}]) + end, + lists:seq(1, 2*erlang:system_info(schedulers))), + %% Wait to ensure distribution of high prio processes over schedulers... + receive after 1000 -> ok end, + %% + %% Test that we can get group-leader signals through to normal prio + %% processes from a max prio process even though all schedulers are filled + %% with executing high prio processes. + %% + lists:foreach(fun (_) -> + lists:foreach(fun (TP) -> + erlang:yield(), + %% whitebox -- Enqueue some signals on it + %% preventing us from hogging its main lock + %% and set group-leader directly.... + erlang:demonitor(erlang:monitor(process, TP)), + true = erlang:group_leader(Init, TP), + {group_leader, Init} = process_info(TP, group_leader), + erlang:demonitor(erlang:monitor(process, TP)), + true = erlang:group_leader(GL, TP), + {group_leader, GL} = process_info(TP, group_leader) + end, + TPs) + end, + lists:seq(1,100)), + %% + %% Also test when it is exiting... + %% + lists:foreach(fun (TP) -> + erlang:yield(), + M = erlang:monitor(process, TP), + unlink(TP), + exit(TP, bang), + badarg = try + true = erlang:group_leader(Init, TP) + catch + error : What -> What + end, + receive + {'DOWN', M, process, TP, Reason} -> + bang = Reason + end + end, + TPs), + lists:foreach(fun (TL) -> + M = erlang:monitor(process, TL), + unlink(TL), + exit(TL, bang), + receive + {'DOWN', M, process, TL, Reason} -> + bang = Reason + end + end, + TLs), + ok. + +is_process_alive(Config) when is_list(Config) -> + process_flag(priority, max), + Ps = lists:map(fun (_) -> + spawn_opt(fun () -> tok_loop() end, + [{priority, high}, link]) + end, + lists:seq(1, 2*erlang:system_info(schedulers))), + receive after 1000 -> ok end, %% Wait for load to spread + lists:foreach(fun (P) -> + %% Ensure that signal order is preserved + %% and that we are not starved due to + %% priority inversion + true = erlang:is_process_alive(P), + unlink(P), + true = erlang:is_process_alive(P), + exit(P, kill), + false = erlang:is_process_alive(P) + end, + Ps), + ok. + +process_info_blast(Config) when is_list(Config) -> + Tester = self(), + NoAttackers = 1000, + NoAL = lists:seq(1, NoAttackers), + Consume = make_ref(), + Victim = spawn_link(fun () -> + receive + Consume -> + ok + end, + consume_msgs() + end), + AFun = fun () -> + Victim ! hej, + Res = process_info(Victim, message_queue_len), + Tester ! {self(), Res} + end, + Attackers0 = lists:map(fun (_) -> + spawn_link(AFun) + end, + NoAL), + lists:foreach(fun (A) -> + receive + {A, Res} -> + case Res of + {message_queue_len, Len} when Len > 0, Len =< NoAttackers -> + Len; + Error -> + exit({unexpected, Error}) + end + end + end, + Attackers0), + Attackers1 = lists:map(fun (_) -> + spawn_link(AFun) + end, + NoAL), + Victim ! Consume, + lists:foreach(fun (A) -> + receive + {A, Res} -> + case Res of + {message_queue_len, Len} when Len >= 0, Len =< 2*NoAttackers+1 -> + ok; + undefined -> + ok; + Error -> + exit({unexpected, Error}) + end + end + end, + Attackers1), + KillFun = fun (P) -> + unlink(P), + exit(P, kill), + false = erlang:is_process_alive(P) + end, + lists:foreach(fun (A) -> KillFun(A) end, Attackers0), + lists:foreach(fun (A) -> KillFun(A) end, Attackers1), + KillFun(Victim), + ok. + +consume_msgs() -> + receive + _ -> + consume_msgs() + after 0 -> + ok + end. + +%% helpers id(I) -> I. @@ -743,3 +1222,11 @@ hostname([$@ | Hostname]) -> list_to_atom(Hostname); hostname([_C | Cs]) -> hostname(Cs). + +tok_loop() -> + tok_loop(hej). + +tok_loop(hej) -> + tok_loop(hopp); +tok_loop(hopp) -> + tok_loop(hej). diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl index 402751393a..0a42b09903 100644 --- a/erts/emulator/test/big_SUITE.erl +++ b/erts/emulator/test/big_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -24,6 +24,7 @@ -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, + bxor_2pow/1, shift_limit_1/1, powmod/1, system_limit/1, toobig/1, otp_6692/1]). %% Internal exports. @@ -42,6 +43,7 @@ suite() -> all() -> [t_div, eq_28, eq_32, eq_big, eq_math, big_literals, borders, negative, {group, big_float}, shift_limit_1, + bxor_2pow, powmod, system_limit, toobig, otp_6692]. groups() -> @@ -337,6 +339,13 @@ system_limit(Config) when is_list(Config) -> {'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() -> @@ -396,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/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 1c7d278bb0..23c675733c 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -19,7 +19,6 @@ %% -module(binary_SUITE). --compile({nowarn_deprecated_function, {erlang,hash,2}}). %% Tests binaries and the BIFs: %% list_to_binary/1 @@ -49,6 +48,7 @@ bad_list_to_binary/1, bad_binary_to_list/1, t_split_binary/1, bad_split/1, terms/1, terms_float/1, float_middle_endian/1, + b2t_used_big/1, external_size/1, t_iolist_size/1, t_hash/1, bad_size/1, @@ -58,7 +58,9 @@ otp_5484/1,otp_5933/1, 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_6817/1,deep/1, + term2bin_tuple_fallbacks/1, + robustness/1,otp_8117/1, otp_8180/1, trapping/1, large/1, error_after_yield/1, cmp_old_impl/1]). @@ -73,12 +75,14 @@ all() -> t_split_binary, bad_split, bad_list_to_binary, bad_binary_to_list, terms, terms_float, float_middle_endian, external_size, t_iolist_size, + b2t_used_big, bad_binary_to_term_2, safe_binary_to_term2, bad_binary_to_term, bad_terms, t_hash, bad_size, bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep, - obsolete_funs, robustness, otp_8180, trapping, large, + term2bin_tuple_fallbacks, + robustness, otp_8180, trapping, large, error_after_yield, cmp_old_impl]. groups() -> @@ -258,6 +262,7 @@ test_deep_bitstr(List) -> {Bin,bitstring_to_list(Bin)}. bad_list_to_binary(Config) when is_list(Config) -> + test_bad_bin(<<1:1>>), test_bad_bin(atom), test_bad_bin(42), test_bad_bin([1|2]), @@ -392,7 +397,6 @@ test_hash(List) -> Bin = list_to_binary(List), Sbin = make_sub_binary(List), Unaligned = make_unaligned_sub_binary(Sbin), - test_hash_1(Bin, Sbin, Unaligned, fun erlang:hash/2), test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash/2), test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash2/2). @@ -427,40 +431,77 @@ bad_term_to_binary(Config) when is_list(Config) -> terms(Config) when is_list(Config) -> TestFun = fun(Term) -> - try - S = io_lib:format("~p", [Term]), - io:put_chars(S) - catch - error:badarg -> - io:put_chars("bit sized binary") - end, + S = io_lib:format("~p", [Term]), + io:put_chars(S), Bin = term_to_binary(Term), case erlang:external_size(Bin) of Sz when is_integer(Sz), size(Bin) =< Sz -> ok end, - Bin1 = term_to_binary(Term, [{minor_version, 1}]), - case erlang:external_size(Bin1, [{minor_version, 1}]) of - Sz1 when is_integer(Sz1), size(Bin1) =< Sz1 -> - ok - end, + Bin1 = term_to_binary(Term, [{minor_version, 1}]), + case erlang:external_size(Bin1, [{minor_version, 1}]) of + Sz1 when is_integer(Sz1), size(Bin1) =< Sz1 -> + ok + end, Term = binary_to_term_stress(Bin), Term = binary_to_term_stress(Bin, [safe]), - Unaligned = make_unaligned_sub_binary(Bin), - Term = binary_to_term_stress(Unaligned), - Term = binary_to_term_stress(Unaligned, []), - Term = binary_to_term_stress(Bin, [safe]), + Bin_sz = byte_size(Bin), + {Term,Bin_sz} = binary_to_term_stress(Bin, [used]), + + BinE = <<Bin/binary, 1, 2, 3>>, + {Term,Bin_sz} = binary_to_term_stress(BinE, [used]), + + BinU = make_unaligned_sub_binary(Bin), + Term = binary_to_term_stress(BinU), + Term = binary_to_term_stress(BinU, []), + Term = binary_to_term_stress(BinU, [safe]), + {Term,Bin_sz} = binary_to_term_stress(BinU, [used]), + + BinUE = make_unaligned_sub_binary(BinE), + {Term,Bin_sz} = binary_to_term_stress(BinUE, [used]), + BinC = erlang:term_to_binary(Term, [compressed]), + BinC_sz = byte_size(BinC), + true = BinC_sz =< size(Bin), Term = binary_to_term_stress(BinC), - true = size(BinC) =< size(Bin), + {Term, BinC_sz} = binary_to_term_stress(BinC, [used]), + Bin = term_to_binary(Term, [{compressed,0}]), terms_compression_levels(Term, size(Bin), 1), - UnalignedC = make_unaligned_sub_binary(BinC), - Term = binary_to_term_stress(UnalignedC) + + BinUC = make_unaligned_sub_binary(BinC), + Term = binary_to_term_stress(BinUC), + {Term,BinC_sz} = binary_to_term_stress(BinUC, [used]), + + BinCE = <<BinC/binary, 1, 2, 3>>, + {Term,BinC_sz} = binary_to_term_stress(BinCE, [used]), + + BinUCE = make_unaligned_sub_binary(BinCE), + Term = binary_to_term_stress(BinUCE), + {Term,BinC_sz} = binary_to_term_stress(BinUCE, [used]) end, test_terms(TestFun), ok. +%% Test binary_to_term(_, [used]) returning a big Used integer. +b2t_used_big(_Config) -> + case erlang:system_info(wordsize) of + 8 -> + {skipped, "This is not a 32-bit machine"}; + 4 -> + %% Use a long utf8 atom for large external format but compact on heap. + BigAtom = binary_to_atom(<< <<16#F0908D88:32>> || _ <- lists:seq(1,255) >>, + utf8), + Atoms = (1 bsl 17) + (1 bsl 9), + BigAtomList = lists:duplicate(Atoms, BigAtom), + BigBin = term_to_binary(BigAtomList), + {BigAtomList, Used} = binary_to_term(BigBin, [used]), + 2 = erts_debug:size(Used), + Used = byte_size(BigBin), + Used = 1 + 1 + 4 + Atoms*(1+2+4*255) + 1, + ok + end. + terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 -> BinC = erlang:term_to_binary(Term, [{compressed,Level}]), Term = binary_to_term_stress(BinC), @@ -601,6 +642,9 @@ bad_binary_to_term(Config) when is_list(Config) -> %% Bad float. 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) -> @@ -1010,7 +1054,7 @@ ordering(Config) when is_list(Config) -> 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], @@ -1159,7 +1203,7 @@ very_big_num(0, Result) -> Result. make_port() -> - open_port({spawn, efile}, [eof]). + hd(erlang:ports()). make_pid() -> spawn_link(?MODULE, sleeper, []). @@ -1260,40 +1304,28 @@ deep_roundtrip(T) -> B = term_to_binary(T), T = binary_to_term(B). -obsolete_funs(Config) when is_list(Config) -> +term2bin_tuple_fallbacks(Config) when is_list(Config) -> erts_debug:set_internal_state(available_internal_state, true), - X = id({1,2,3}), - Y = id([a,b,c,d]), - Z = id({x,y,z}), - 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), - - obsolete_fun(fun ?MODULE:all/1), + term2bin_tf(fun ?MODULE:all/1), + term2bin_tf(<<1:1>>), + term2bin_tf(<<90,80:7>>), erts_debug:set_internal_state(available_internal_state, false), ok. -obsolete_fun(Fun) -> - Tuple = case erlang:fun_info(Fun, type) of - {type,external} -> - {module,M} = erlang:fun_info(Fun, module), - {name,F} = erlang:fun_info(Fun, name), - {M,F}; - {type,local} -> - {module,M} = erlang:fun_info(Fun, module), - {index,I} = erlang:fun_info(Fun, index), - {uniq,U} = erlang:fun_info(Fun, uniq), - {env,E} = erlang:fun_info(Fun, env), - {'fun',M,I,U,list_to_tuple(E)} - end, - Tuple = no_fun_roundtrip(Fun). - -no_fun_roundtrip(Term) -> - binary_to_term_stress(erts_debug:get_internal_state({term_to_binary_no_funs,Term})). +term2bin_tf(Term) -> + Tuple = case Term of + Fun when is_function(Fun) -> + {type, external} = erlang:fun_info(Fun, type), + {module,M} = erlang:fun_info(Fun, module), + {name,F} = erlang:fun_info(Fun, name), + {M,F}; + BS when bit_size(BS) rem 8 =/= 0 -> + Bits = bit_size(BS) rem 8, + {<<BS/bitstring, 0:(8-Bits)>>, Bits} + end, + Tuple = binary_to_term_stress(erts_debug:get_internal_state({term_to_binary_tuple_fallbacks,Term})). %% Test non-standard encodings never generated by term_to_binary/1 %% but recognized by binary_to_term/1. @@ -1360,17 +1392,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). @@ -1439,13 +1473,13 @@ error_after_yield(Type, M, F, AN, AFun, TrapFunc) -> apply(M, F, A), exit({unexpected_success, {M, F, A}}) catch - error:Type -> + error:Type:Stk -> 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() + [{M, F, A, _} | _] = Stk end end), receive diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index 95042ac802..ce50bcdd86 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% 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. @@ -35,7 +35,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 10}}]. + {timetrap, {minutes, 1}}]. all() -> [test1, test2, test3, test4, test5, testf, not_used, @@ -537,6 +537,8 @@ huge_binary(Config) when is_list(Config) -> 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 -> %% This test has to be inlined inside the case to @@ -552,10 +554,14 @@ huge_binary(Config) when is_list(Config) -> 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"} + {30,"Limit huge binary to 128 Mb"}; + _ -> + garbage_collect(), + id(<<0:((1 bsl 29)-1)>>), + {29,"Limit huge binary to 64 Mb"} end, garbage_collect(), id(<<0:((1 bsl Shift)-1)>>), @@ -567,13 +573,14 @@ huge_binary(Config) when is_list(Config) -> Comment -> {comment, Comment} end. +%% Return the amount of free memory in Mb. free_mem() -> {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 + Val -> Val div (1024*1024) end. system_limit(Config) when is_list(Config) -> @@ -898,14 +905,28 @@ bs_add_overflow(_Config) -> _ when Memsize < (2 bsl 30) -> {skip, "Less then 2 GB of memory"}; 4 -> - Large = <<0:((1 bsl 30)-1)>>, - {'EXIT',{system_limit,_}} = - (catch <<Large/bits, Large/bits, Large/bits, Large/bits, - Large/bits, Large/bits, Large/bits, Large/bits, - Large/bits>>), + {'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() -> diff --git a/erts/emulator/test/bs_match_int_SUITE.erl b/erts/emulator/test/bs_match_int_SUITE.erl index a7bd4b8ac3..e913dc98b0 100644 --- a/erts/emulator/test/bs_match_int_SUITE.erl +++ b/erts/emulator/test/bs_match_int_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% 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. @@ -247,7 +247,7 @@ match_huge_int(Config) when is_list(Config) -> 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, diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl index 7094cee992..4e7004a424 100644 --- a/erts/emulator/test/busy_port_SUITE.erl +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% 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. @@ -20,18 +20,19 @@ -module(busy_port_SUITE). --export([all/0, suite/0, 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("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]}, @@ -44,6 +45,11 @@ all() -> scheduling_delay_busy,scheduling_delay_busy_nosuspend, scheduling_busy_link]. +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) -> case whereis(busy_drv_server) of undefined -> @@ -57,8 +63,38 @@ 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. @@ -134,7 +170,7 @@ message_order(Config) when is_list(Config) -> 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")), @@ -343,7 +379,7 @@ multiple_writers(Config) when is_list(Config) -> 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. @@ -712,6 +748,7 @@ 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) -> @@ -807,7 +844,9 @@ 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 diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 6ba6301c7c..d19f7f81ad 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% 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. @@ -43,9 +43,9 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 30}}]. + {timetrap, {minutes, 2}}]. -all() -> +all() -> Common = [errors, on_load], NotHipe = [process_specs, basic, flags, pam, change_pam, upgrade, @@ -60,7 +60,7 @@ all() -> init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Config. -end_per_testcase(_Func, 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. @@ -233,7 +233,7 @@ basic() -> trace_func({'_','_','_'}, false), [b,a] = lists:reverse([a,b]), - %% Read out the remaing trace messages. + %% Read out the remaining trace messages. ?MODULE:expect({trace,Self,call,{lists,seq,[1,10]}}), ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["777"]}}), @@ -1090,8 +1090,7 @@ exception_nocatch() -> {trace,t2,exception_from,{erlang,throw,1}, {error,{nocatch,Q2}}}], exception_from, {error,{nocatch,Q2}}), - expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]}, - {?MODULE,deep_4,1, + expect({trace,T2,exit,{{nocatch,Q2},[{?MODULE,deep_4,1, Deep4LocThrow}]}}), Q3 = {dump,[dump,{dump}]}, T3 = @@ -1100,8 +1099,7 @@ exception_nocatch() -> {trace,t3,exception_from,{erlang,error,1}, {error,Q3}}], exception_from, {error,Q3}), - expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]}, - {?MODULE,deep_4,1,Deep4LocError}]}}), + expect({trace,T3,exit,{Q3,[{?MODULE,deep_4,1,Deep4LocError}]}}), T4 = exception_nocatch(?LINE, '=', [17,4711], 5, [], exception_from, {error,{badmatch,4711}}), @@ -1118,8 +1116,8 @@ get_deep_4_loc(Arg) -> deep_4(Arg), ct:fail(should_not_return_to_here) catch - _:_ -> - [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(), + _:_:Stk -> + [{?MODULE,deep_4,1,Loc0}|_] = Stk, Loc0 end. diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 34515efa3d..0444ba4f89 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -22,12 +22,13 @@ -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, - 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, + 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, + fake_literals/1, false_dependency/1,coverage/1,fun_confusion/1, - t_copy_literals/1, t_copy_literals_frags/1]). + t_copy_literals/1, t_copy_literals_frags/1, + erl_544/1, max_heap_size/1]). -define(line_trace, 1). -include_lib("common_test/include/ct.hrl"). @@ -36,11 +37,13 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [versions, new_binary_types, call_purged_fun_code_gone, - call_purged_fun_code_reload, call_purged_fun_code_there, t_check_process_code, - t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, - module_md5, make_stub, make_stub_many_funs, - constant_pools, constant_refc_binaries, false_dependency, - coverage, fun_confusion, t_copy_literals, t_copy_literals_frags]. + 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, fake_literals, + false_dependency, + coverage, fun_confusion, t_copy_literals, t_copy_literals_frags, + erl_544, max_heap_size]. init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), @@ -66,9 +69,9 @@ 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 end, @@ -154,307 +157,82 @@ call_purged_fun_code_there(Config) when is_list(Config) -> ok. call_purged_fun_test(Priv, Data, Type) -> - 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), - - {ok,my_code_test2} = c:c(File, [{outdir,Priv}]), - - 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()}), - - spawn(fun () -> - [{my_fun2,F2}] = ets:lookup(T, my_fun2), - F2(fun () -> - receive after infinity -> ok end - end, - fun () -> ok end), - exit(completed) - end), - - PurgeType = case Type of - code_gone -> - ok = file:delete(Code++".beam"), - true; - code_reload -> - true; - code_there -> - false - end, - - true = erlang:delete_module(my_code_test2), - - Purge = start_purge(my_code_test2, PurgeType), - - {P0, M0} = spawn_monitor(fun () -> - [{my_fun,F}] = ets:lookup(T, my_fun), - 4712 = F(1), - exit(completed) - end), - - wait_until(fun () -> - {status, suspended} - == process_info(P0, status) - end), - - ok = continue_purge(Purge), - - {P1, M1} = spawn_monitor(fun () -> - [{my_fun,F}] = ets:lookup(T, my_fun), - 4713 = F(2), - exit(completed) - end), - {P2, M2} = spawn_monitor(fun () -> - [{my_fun,F}] = ets:lookup(T, my_fun), - 4714 = F(3), - exit(completed) - end), - - wait_until(fun () -> - {status, suspended} - == process_info(P1, status) - end), - wait_until(fun () -> - {status, suspended} - == process_info(P2, status) - end), - - {current_function, - {erts_code_purger, - pending_purge_lambda, - 3}} = process_info(P0, current_function), - {current_function, - {erts_code_purger, - pending_purge_lambda, - 3}} = process_info(P1, current_function), - {current_function, - {erts_code_purger, - pending_purge_lambda, - 3}} = process_info(P2, current_function), - - case Type of - code_there -> - false = complete_purge(Purge); - _ -> - {true, true} = complete_purge(Purge) - end, - - case Type of - code_gone -> - receive - {'DOWN', M0, process, P0, Reason0} -> - {undef, _} = Reason0 - end, - receive - {'DOWN', M1, process, P1, Reason1} -> - {undef, _} = Reason1 - end, - receive - {'DOWN', M2, process, P2, Reason2} -> - {undef, _} = Reason2 - end; - _ -> - receive - {'DOWN', M0, process, P0, Reason0} -> - completed = Reason0 - end, - receive - {'DOWN', M1, process, P1, Reason1} -> - completed = Reason1 - end, - receive - {'DOWN', M2, process, P2, Reason2} -> - completed = Reason2 - end, - catch erlang:purge_module(my_code_test2), - catch erlang:delete_module(my_code_test2), - catch erlang:purge_module(my_code_test2) - end, - ok. - -t_check_process_code(Config) when is_list(Config) -> - case check_process_code_handle(indirect_references) of - false -> {skipped, "check_process_code() ignores funs"}; - true -> t_check_process_code_test(Config) - end. - -t_check_process_code_test(Config) -> - Priv = proplists:get_value(priv_dir, Config), - Data = proplists:get_value(data_dir, Config), - File = filename:join(Data, "my_code_test"), - Code = filename:join(Priv, "my_code_test"), - - catch erlang:purge_module(my_code_test), - catch erlang:delete_module(my_code_test), - catch erlang:purge_module(my_code_test), + 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]. - {ok,my_code_test} = c:c(File, [{outdir,Priv}]), - MyFun = fun(X, Y) -> X + Y end, %Confuse things. - F = my_code_test:make_fun(42), - 2 = fun_refc(F), - MyFun2 = fun(X, Y) -> X * Y end, %Confuse things. - 44 = F(2), - - %% Delete the module and call the fun again. - true = erlang:delete_module(my_code_test), - 2 = fun_refc(F), - 45 = F(3), - {'EXIT',{undef,_}} = (catch my_code_test:make_fun(33)), - - %% The fun should still be there, preventing purge. - true = erlang:check_process_code(self(), my_code_test), - gc(), - gc(), %Place funs on the old heap. - true = erlang:check_process_code(self(), my_code_test), - - %% Using the funs here guarantees that they will not be prematurely garbed. - 48 = F(6), - 3 = MyFun(1, 2), - 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) -> - MyFun = fun(X, Y) -> X + Y + 1 end, %Confuse things. - false = erlang:check_process_code(self(), my_code_test), - 4 = MyFun(1, 2), - t_check_process_code2(Code, Fakes). - -t_check_process_code2(Code, _) -> - false = erlang:check_process_code(self(), my_code_test), - true = erlang:purge_module(my_code_test), - - %% In the next test we will load the same module twice. - {module,my_code_test} = code:load_abs(Code), - F = my_code_test:make_fun(37), - 2 = fun_refc(F), - false = erlang:check_process_code(self(), my_code_test), - {module,my_code_test} = code:load_abs(Code), - 2 = fun_refc(F), - - %% Still false because the fun with the same identify is found - %% in the current code. - false = erlang:check_process_code(self(), my_code_test), - - %% Some fake funs in the same module should not do any difference. - 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), - true = erlang:purge_module(my_code_test), - false = erlang:check_process_code(self(), my_code_test), - false = erlang:check_process_code(Pid, my_code_test), - - true = erlang:delete_module(my_code_test), - true = erlang:check_process_code(self(), my_code_test), - 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, - false = erlang:check_process_code(Pid, my_code_test), - ok. - -body(F, Fakes) -> - receive - jog -> - 40 = F(3), - erlang:garbage_collect(), - body(F, Fakes); - drop_funs -> - dropped_body() - end. +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), -dropped_body() -> - receive - X -> exit(X) - end. + call_purged_fun_tester:do(Priv, Data, Type, FunOpts). -gc() -> - erlang:garbage_collect(), - gc1(). -gc1() -> ok. - -%% 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 check_process_code_handle(indirect_references) of - false -> - {skipped, "check_process_code() ignores funs"}; - true -> - case test_server:is_native(?MODULE) of - true -> - {skip,"Native code"}; - false -> - do_check_process_code_ets(Config) - end - end. -do_check_process_code_ets(Config) -> +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), - File = filename:join(Data, "my_code_test"), - - catch erlang:purge_module(my_code_test), - catch erlang:delete_module(my_code_test), - catch erlang:purge_module(my_code_test), - {ok,my_code_test} = c:c(File, [{outdir,Priv}]), - - T = ets:new(my_code_test, []), - ets:insert(T, {7,my_code_test:make_fun(107)}), - ets:insert(T, {8,my_code_test:make_fun(108)}), + 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), - 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, - Pid = spawn_link(Body), - receive after 1 -> ok end, - true = erlang:check_process_code(Pid, my_code_test), - Pid ! call, - Pid ! {drop_funs,self()}, + erlang:delete_module(my_code_test2), - receive - funs_dropped -> ok; - Other -> ct:fail({unexpected,Other}) - after 10000 -> - ct:fail(no_funs_dropped_answer) - end, + Self = self(), - false = erlang:check_process_code(Pid, my_code_test), + 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, + + 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) -> Data = proplists:get_value(data_dir, Config), @@ -501,16 +279,16 @@ get_chunk(Config) when is_list(Config) -> {ok,my_code_test,Code} = compile:file(File, [binary]), %% Should work. - Chunk = get_chunk_ok("Atom", Code), - Chunk = get_chunk_ok("Atom", make_sub_binary(Code)), - 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. - {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "Atom")), + {'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'. - undefined = code:get_chunk(<<"not a beam module">>, "Atom"), + undefined = code:get_chunk(<<"not a beam module">>, "AtU8"), undefined = code:get_chunk(Code, "XXXX"), ok. @@ -543,67 +321,6 @@ module_md5_ok(Code) -> end. -make_stub(Config) when is_list(Config) -> - catch erlang:purge_module(my_code_test), - MD5 = erlang:md5(<<>>), - - Data = proplists:get_value(data_dir, Config), - File = filename:join(Data, "my_code_test"), - {ok,my_code_test,Code} = compile:file(File, [binary]), - - my_code_test = code:make_stub_module(my_code_test, Code, {[],[],MD5}), - true = erlang:delete_module(my_code_test), - true = erlang:purge_module(my_code_test), - - my_code_test = code:make_stub_module(my_code_test, - make_unaligned_sub_binary(Code), - {[],[],MD5}), - true = erlang:delete_module(my_code_test), - true = erlang:purge_module(my_code_test), - - my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code), - {[],[],MD5}), - true = erlang:delete_module(my_code_test), - true = erlang:purge_module(my_code_test), - - %% Should fail. - {'EXIT',{badarg,_}} = - (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[],MD5})), - {'EXIT',{badarg,_}} = - (catch code:make_stub_module(my_code_test, - bit_sized_binary(Code), - {[],[],MD5})), - {'EXIT',{badarg,_}} = - (catch code:make_stub_module(my_code_test_with_wrong_name, - Code, {[],[],MD5})), - ok. - -make_stub_many_funs(Config) when is_list(Config) -> - catch erlang:purge_module(many_funs), - MD5 = erlang:md5(<<>>), - - Data = proplists:get_value(data_dir, Config), - File = filename:join(Data, "many_funs"), - {ok,many_funs,Code} = compile:file(File, [binary]), - - many_funs = code:make_stub_module(many_funs, Code, {[],[],MD5}), - true = erlang:delete_module(many_funs), - true = erlang:purge_module(many_funs), - many_funs = code:make_stub_module(many_funs, - make_unaligned_sub_binary(Code), - {[],[],MD5}), - true = erlang:delete_module(many_funs), - true = erlang:purge_module(many_funs), - - %% Should fail. - {'EXIT',{badarg,_}} = - (catch code:make_stub_module(many_funs, <<"bad">>, {[],[],MD5})), - {'EXIT',{badarg,_}} = - (catch code:make_stub_module(many_funs, - bit_sized_binary(Code), - {[],[],MD5})), - ok. - constant_pools(Config) when is_list(Config) -> Data = proplists:get_value(data_dir, Config), File = filename:join(Data, "literals"), @@ -645,9 +362,40 @@ constant_pools(Config) when is_list(Config) -> erlang:purge_module(literals), OldHeap ! done, receive - {'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 -> - ok - end. + {'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 -> + ok + 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(), @@ -670,6 +418,13 @@ old_heap(Parent) -> 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 -> @@ -803,6 +558,62 @@ wait_for_memory_deallocations() -> wait_for_memory_deallocations() end. +fake_literals(_Config) -> + Mod = fake__literals__module, + try + do_fake_literals(Mod) + after + _ = code:purge(Mod), + _ = code:delete(Mod), + _ = code:purge(Mod), + _ = code:delete(Mod) + end, + ok. + +do_fake_literals(Mod) -> + Tid = ets:new(test, []), + ExtTerms = get_external_terms(), + Term0 = {self(),make_ref(),Tid,fun() -> ok end,ExtTerms}, + Terms = [begin + make_literal_module(Mod, Term0), + Mod:term() + end || _ <- lists:seq(1, 10)], + verify_lit_terms(Terms, Term0), + true = ets:delete(Tid), + ok. + +make_literal_module(Mod, Term) -> + Exp = [{term,0}], + Attr = [], + Fs = [{function,term,0,2, + [{label,1}, + {line,[]}, + {func_info,{atom,Mod},{atom,term},0}, + {label,2}, + {move,{literal,Term},{x,0}}, + return]}], + Asm = {Mod,Exp,Attr,Fs,2}, + {ok,Mod,Beam} = compile:forms(Asm, [from_asm,binary,report]), + code:load_binary(Mod, atom_to_list(Mod), Beam). + +verify_lit_terms([H|T], Term) -> + case H =:= Term of + true -> + verify_lit_terms(T, Term); + false -> + error({bad_term,H}) + end; +verify_lit_terms([], _) -> + ok. + +get_external_terms() -> + {ok,Node} = test_server:start_node(?FUNCTION_NAME, slave, []), + Ref = rpc:call(Node, erlang, make_ref, []), + Ports = rpc:call(Node, erlang, ports, []), + Pid = rpc:call(Node, erlang, self, []), + _ = test_server:stop_node(Node), + {Ref,hd(Ports),Pid}. + %% 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) -> @@ -1109,6 +920,86 @@ reloader(Mod,Code,Time) -> reloader(Mod,Code,Time) end. +erl_544(Config) when is_list(Config) -> + case file:native_name_encoding() of + utf8 -> + {ok, CWD} = file:get_cwd(), + try + Mod = erl_544, + FileName = atom_to_list(Mod) ++ ".erl", + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + {ok, FileContent} = file:read_file(filename:join(Data, + FileName)), + Dir = filename:join(Priv, [16#2620,16#2620,16#2620]), + File = filename:join(Dir, FileName), + io:format("~ts~n", [File]), + ok = file:make_dir(Dir), + ok = file:set_cwd(Dir), + ok = file:write_file(File, [FileContent]), + {ok, Mod} = compile:file(File), + Res1 = (catch Mod:err()), + io:format("~p~n", [Res1]), + {'EXIT', {err, [{Mod, err, 0, Info1}|_]}} = Res1, + File = proplists:get_value(file, Info1), + Me = self(), + Go = make_ref(), + Tester = spawn_link(fun () -> + Mod:wait(Me, Go), + Mod:err() + end), + receive Go -> ok end, + Res2 = process_info(Tester, current_stacktrace), + io:format("~p~n", [Res2]), + {current_stacktrace, Stack} = Res2, + [{Mod, wait, 2, Info2}|_] = Stack, + File = proplists:get_value(file, Info2), + StackFun = fun(_, _, _) -> false end, + FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end, + Formated = + erl_error:format_stacktrace(1, Stack, StackFun, FormatFun), + true = is_list(Formated), + ok + after + ok = file:set_cwd(CWD) + end, + ok; + _Enc -> + {skipped, "Only run when native file name encoding is utf8"} + end. + +%% Test that the copying of literals to a process during purging of +%% literals will cause the process to be killed if the max heap size +%% is exceeded. +max_heap_size(_Config) -> + Mod = ?FUNCTION_NAME, + Value = [I || I <- lists:seq(1, 5000)], + Code = gen_lit(Mod, [{term,Value}]), + {module,Mod} = erlang:load_module(Mod, Code), + SpawnOpts = [monitor, + {max_heap_size, + #{size=>1024, + kill=>true, + error_logger=>true}}], + {Pid,Ref} = spawn_opt(fun() -> + max_heap_size_proc(Mod) + end, SpawnOpts), + receive + {'DOWN',Ref,process,Pid,Reason} -> + killed = Reason; + Other -> + ct:fail({unexpected_message,Other}) + after 10000 -> + ct:fail({process_did_not_die, Pid, erlang:process_info(Pid)}) + end. + +max_heap_size_proc(Mod) -> + Value = Mod:term(), + code:delete(Mod), + code:purge(Mod), + receive + _ -> Value + end. %% Utilities. @@ -1137,38 +1028,3 @@ flush() -> id(I) -> I. -check_process_code_handle(What) -> - lists:member(What, erlang:system_info(check_process_code)). - -wait_until(Fun) -> - case Fun() of - true -> - ok; - false -> - receive after 100 -> ok end, - wait_until(Fun) - 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/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/erl_544.erl b/erts/emulator/test/code_SUITE_data/erl_544.erl new file mode 100644 index 0000000000..c93f3ef5bc --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/erl_544.erl @@ -0,0 +1,35 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. 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(erl_544). + +-export([err/0, wait/2]). + +err() -> + erlang:error(err). + +wait(Pid, Msg) -> + erlang:yield(), + Pid ! Msg, + receive + after infinity -> + ok + end, + err(). diff --git a/erts/emulator/test/counters_SUITE.erl b/erts/emulator/test/counters_SUITE.erl new file mode 100644 index 0000000000..b3f0358c1e --- /dev/null +++ b/erts/emulator/test/counters_SUITE.erl @@ -0,0 +1,234 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. 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(counters_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-export([suite/0, all/0]). +-export([basic/1, bad/1, limits/1, indep/1, write_concurrency/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [basic, bad, limits, indep, write_concurrency]. + +basic(Config) when is_list(Config) -> + Size = 10, + [begin + Ref = counters:new(Size,[Type]), + #{size:=Size, memory:=Memory} = counters:info(Ref), + check_memory(Type, Memory, Size), + [basic_do(Ref, Ix) || Ix <- lists:seq(1, Size)] + end + || Type <- [atomics, write_concurrency]], + ok. + +basic_do(Ref, Ix) -> + 0 = counters:get(Ref, Ix), + ok = counters:add(Ref, Ix, 3), + 3 = counters:get(Ref, Ix), + ok = counters:add(Ref, Ix, 14), + 17 = counters:get(Ref, Ix), + ok = counters:add(Ref, Ix, -20), + -3 = counters:get(Ref, Ix), + ok = counters:add(Ref, Ix, 100), + 97 = counters:get(Ref, Ix), + ok = counters:sub(Ref, Ix, 20), + 77 = counters:get(Ref, Ix), + ok = counters:sub(Ref, Ix, -10), + 87 = counters:get(Ref, Ix), + ok = counters:put(Ref, Ix, 0), + 0 = counters:get(Ref, Ix), + ok = counters:put(Ref, Ix, 123), + 123 = counters:get(Ref, Ix), + ok = counters:put(Ref, Ix, -321), + -321 = counters:get(Ref, Ix), + ok. + +check_memory(atomics, Memory, Size) -> + {_,true} = {Memory, Memory > Size*8}, + {_,true} = {Memory, Memory < Size*max_atomic_sz() + 100}; +check_memory(write_concurrency, Memory, Size) -> + NWords = erlang:system_info(schedulers) + 1, + {_,true} = {Memory, Memory > NWords*Size*8}, + {_,true} = {Memory, Memory < NWords*(Size+7)*max_atomic_sz() + 100}. + +max_atomic_sz() -> + case erlang:system_info({wordsize, external}) of + 4 -> 16; + 8 -> + EI = erlang:system_info(ethread_info), + case lists:keyfind("64-bit native atomics", 1, EI) of + {_, "no", _} -> 16; + _ -> 8 + end + end. + +bad(Config) when is_list(Config) -> + {'EXIT',{badarg,_}} = (catch counters:new(0,[])), + {'EXIT',{badarg,_}} = (catch counters:new(10,[bad])), + {'EXIT',{badarg,_}} = (catch counters:new(10,[atomic, bad])), + {'EXIT',{badarg,_}} = (catch counters:new(10,[write_concurrency | bad])), + Ref = counters:new(10,[]), + {'EXIT',{badarg,_}} = (catch counters:get(1742, 7)), + {'EXIT',{badarg,_}} = (catch counters:get(make_ref(), 7)), + {'EXIT',{badarg,_}} = (catch counters:get(Ref, -1)), + {'EXIT',{badarg,_}} = (catch counters:get(Ref, 0)), + {'EXIT',{badarg,_}} = (catch counters:get(Ref, 11)), + {'EXIT',{badarg,_}} = (catch counters:get(Ref, 7.0)), + ok. + + +limits(Config) when is_list(Config) -> + limits_do(counters:new(1,[atomics])), + limits_do(counters:new(1,[write_concurrency])), + ok. + +limits_do(Ref) -> + Bits = 64, + Max = (1 bsl (Bits-1)) - 1, + Min = -(1 bsl (Bits-1)), + + 0 = counters:get(Ref, 1), + ok = counters:put(Ref, 1, Max), + Max = counters:get(Ref, 1), + ok = counters:add(Ref, 1, 1), + Min = counters:get(Ref, 1), + ok = counters:sub(Ref, 1, 1), + Max = counters:get(Ref, 1), + ok = counters:put(Ref, 1, Min), + Min = counters:get(Ref, 1), + + IncrMax = (Max bsl 1) bor 1, + ok = counters:put(Ref, 1, 0), + ok = counters:add(Ref, 1, IncrMax), + -1 = counters:get(Ref, 1), + {'EXIT',{badarg,_}} = (catch counters:add(Ref, 1, IncrMax+1)), + {'EXIT',{badarg,_}} = (catch counters:add(Ref, 1, Min-1)), + {'EXIT',{badarg,_}} = (catch counters:put(Ref, 1, Max+1)), + {'EXIT',{badarg,_}} = (catch counters:add(Ref, 1, Min-1)), + ok. + + +%% Verify that independent workers, using different counters +%% within the same array, do not interfere with each other. +indep(Config) when is_list(Config) -> + NScheds = erlang:system_info(schedulers), + Ref = counters:new(NScheds,[write_concurrency]), + Rounds = 100, + Papa = self(), + Pids = [spawn_opt(fun () -> + Val = I*197, + counters:put(Ref, I, Val), + indep_looper(Rounds, Ref, I, Val), + Papa ! {self(), done} + end, + [link, {scheduler, I}]) + || I <- lists:seq(1, NScheds)], + [receive {P,done} -> ok end || P <- Pids], + ok. + +indep_looper(0, _, _ , _) -> + ok; +indep_looper(N, Ref, I, Val0) -> + %%io:format("Val0 = ~p\n", [Val0]), + Val0 = counters:get(Ref, I), + Val1 = indep_adder(Ref, I, Val0), + indep_subber(Ref, I, Val1), + Val2 = N*7 + I, + counters:put(Ref, I, Val2), + indep_looper(N-1, Ref, I, Val2). + +indep_adder(Ref, I, Val) when Val < (1 bsl 62) -> + %%io:format("adder Val = ~p\n", [Val]), + Incr = abs(Val div 2) + I + 984735, + counters:add(Ref, I, Incr), + Res = Val + Incr, + Res = counters:get(Ref, I), + indep_adder(Ref, I, Res); +indep_adder(_Ref, _I, Val) -> + Val. + +indep_subber(Ref, I, Val) when Val > -(1 bsl 62) -> + %%io:format("subber Val = ~p\n", [Val]), + Decr = (abs(Val div 2) + I + 725634), + counters:sub(Ref, I, Decr), + Res = Val - Decr, + Res = counters:get(Ref, I), + indep_subber(Ref, I, Res); +indep_subber(_Ref, _I, Val) -> + Val. + + + +%% Verify write_concurrency yields correct results. +write_concurrency(Config) when is_list(Config) -> + rand:seed(exs1024s), + io:format("*** SEED: ~p ***\n", [rand:export_seed()]), + NScheds = erlang:system_info(schedulers), + Size = 100, + Ref = counters:new(Size,[write_concurrency]), + Rounds = 1000, + Papa = self(), + Pids = [spawn_opt(fun Worker() -> + receive + {go, Ix, Incr} -> + wc_looper(Rounds, Ref, Ix, Incr), + Papa ! {self(), done, Rounds*Incr}, + Worker(); + stop -> + ok + end + end, + [link, {scheduler, N}]) + || N <- lists:seq(1, NScheds)], + [begin + Base = rand_log64(), + counters:put(Ref, Index, Base), + SendList = [{P,{go, Index, rand_log64()}} || P <- Pids], + [P ! Msg || {P,Msg} <- SendList], + Added = lists:sum([receive {P,done,Contrib} -> Contrib end || P <- Pids]), + Result = mask_sint64(Base+Added), + {_,Result} = {Result, counters:get(Ref, Index)} + end + || Index <- lists:seq(1, Size)], + + [begin unlink(P), P ! stop end || P <- Pids], + ok. + +wc_looper(0, _, _, _) -> + ok; +wc_looper(N, Ref, Ix, Incr) -> + counters:add(Ref, Ix, Incr), + wc_looper(N-1, Ref, Ix, Incr). + +mask_sint64(X) -> + SMask = 1 bsl 63, + UMask = SMask - 1, + (X band UMask) - (X band SMask). + +%% A random signed 64-bit integer +%% with a uniformly distributed number of significant bits. +rand_log64() -> + Uint = round(math:pow(2, rand:uniform()*63)), + case rand:uniform(2) of + 1 -> -Uint; + 2 -> Uint + end. diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl index 93b6f2d956..4998fc08be 100644 --- a/erts/emulator/test/ddll_SUITE.erl +++ b/erts/emulator/test/ddll_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% 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. @@ -55,7 +55,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 10}}]. + {timetrap, {minutes, 1}}]. all() -> [ddll_test, errors, reference_count, kill_port, @@ -775,7 +775,7 @@ errors(Config) when is_list(Config) -> {error, bad_driver_name} = erl_ddll:load_driver(Path, wrongname_drv), %% We assume that there is a statically linked driver named "ddll": - {error, linked_in_driver} = erl_ddll:unload_driver(efile), + {error, linked_in_driver} = erl_ddll:unload_driver(ram_file_drv), {error, not_loaded} = erl_ddll:unload_driver("__pucko_driver__"), case os:type() of @@ -805,7 +805,7 @@ reference_count(Config) when is_list(Config) -> Pid1 ! {self(), die}, test_server:sleep(200), % Give time to unload. - % Verify that the driver was automaticly unloaded when the + % Verify that the driver was automatically unloaded when the % process died. {error, not_loaded}=erl_ddll:unload_driver(echo_drv), ok. diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index 54ee4d5567..ef13b515fb 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2018. 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. @@ -239,7 +239,7 @@ packet_size(Config) when is_list(Config) -> %% 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, {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = erlang:decode_packet(http, Pkt1, Opts), @@ -250,7 +250,7 @@ packet_size(Config) when is_list(Config) -> 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"]), + 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} = @@ -509,9 +509,9 @@ decode_line(Bin,MaxLen) -> 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(Config) when is_list(Config) -> @@ -562,7 +562,7 @@ decode_pkt(Type,Bin,Opts) -> 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} = diff --git a/erts/emulator/test/dgawd_handler.erl b/erts/emulator/test/dgawd_handler.erl index 52cdd26427..b66b5a073f 100644 --- a/erts/emulator/test/dgawd_handler.erl +++ b/erts/emulator/test/dgawd_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-2018. 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. @@ -42,10 +42,10 @@ %%==================================================================== install() -> - gen_event:add_handler(error_logger, ?MODULE, []). + error_logger:add_report_handler(?MODULE, []). restore() -> - gen_event:delete_handler(error_logger, ?MODULE, []). + error_logger:delete_report_handler(?MODULE). got_dgawd_report() -> gen_event:call(error_logger, ?MODULE, got_dgawd_report, 10*60*1000). diff --git a/erts/emulator/test/dirty_bif_SUITE.erl b/erts/emulator/test/dirty_bif_SUITE.erl new file mode 100644 index 0000000000..46eb0cba58 --- /dev/null +++ b/erts/emulator/test/dirty_bif_SUITE.erl @@ -0,0 +1,571 @@ +%% +%% %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:Stk1 -> + [{erts_debug,dirty_cpu,[error, Error],_}|_] = Stk1, + ok + end, + try + apply(erts_debug,dirty_cpu,[error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType:Stk2 -> + [{erts_debug,dirty_cpu,[error, Error],_}|_] = Stk2, + ok + end, + try + erts_debug:dirty_io(error, Error), + ct:fail(expected_exception) + catch + error:ErrorType:Stk3 -> + [{erts_debug,dirty_io,[error, Error],_}|_] = Stk3, + ok + end, + try + apply(erts_debug,dirty_io,[error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType:Stk4 -> + [{erts_debug,dirty_io,[error, Error],_}|_] = Stk4, + ok + end, + try + erts_debug:dirty(normal, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType:Stk5 -> + [{erts_debug,dirty,[normal, error, Error],_}|_] = Stk5, + ok + end, + try + apply(erts_debug,dirty,[normal, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType:Stk6 -> + [{erts_debug,dirty,[normal, error, Error],_}|_] = Stk6, + ok + end, + try + erts_debug:dirty(dirty_cpu, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType:Stk7 -> + [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_] = Stk7, + ok + end, + try + apply(erts_debug,dirty,[dirty_cpu, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType:Stk8 -> + [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_] = Stk8, + ok + end, + try + erts_debug:dirty(dirty_io, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType:Stk9 -> + [{erts_debug,dirty,[dirty_io, error, Error],_}|_] = Stk9, + ok + end, + try + apply(erts_debug,dirty,[dirty_io, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType:Stk10 -> + [{erts_debug,dirty,[dirty_io, error, Error],_}|_] = Stk10, + 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:Stk1 -> + [{erts_debug,dirty_cpu,[reschedule, 1001],_}|_] = Stk1, + ok + end, + try + erts_debug:dirty_io(reschedule,1001) + catch + error:badarg:Stk2 -> + [{erts_debug,dirty_io,[reschedule, 1001],_}|_] = Stk2, + ok + end, + try + erts_debug:dirty(normal,reschedule,1001) + catch + error:badarg:Stk3 -> + [{erts_debug,dirty,[normal,reschedule,1001],_}|_] = Stk3, + ok + end. + +dirty_scheduler_exit(Config) when is_list(Config) -> + {ok, Node} = start_node(Config, "+SDio 1"), + [ok] = mcall(Node, + [fun() -> + %% Perform a dry run to ensure that all required code + %% is loaded. Otherwise the test will fail since code + %% loading is done through dirty IO and it won't make + %% any progress during this test. + _DryRun = test_dirty_scheduler_exit(), + 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, 1000) end), + test_dse(N-1,[Pid|Pids]). + +kill_dse([],Killed) -> + wait_dse(Killed, ok); +kill_dse([Pid|Pids],AlreadyKilled) -> + exit(Pid,kill), + kill_dse(Pids,[Pid|AlreadyKilled]). + +wait_dse([], Result) -> + Result; +wait_dse([Pid|Pids], Result) -> + receive + {'EXIT', Pid, killed} -> wait_dse(Pids, Result); + {'EXIT', Pid, _Other} -> wait_dse(Pids, failed) + end. + +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 index 658bdc41b6..93d0ac392c 100644 --- a/erts/emulator/test/dirty_nif_SUITE.erl +++ b/erts/emulator/test/dirty_nif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% 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. @@ -34,7 +34,8 @@ 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]). + 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)). @@ -51,11 +52,13 @@ all() -> dirty_process_register, dirty_process_trace, code_purge, - dirty_nif_send_traced]. + dirty_nif_send_traced, + nif_whereis, + nif_whereis_parallel]. init_per_suite(Config) -> - try erlang:system_info(dirty_cpu_schedulers) of - N when is_integer(N), N > 0 -> + case erlang:system_info(dirty_cpu_schedulers) of + N when N > 0 -> case lib_loaded() of false -> ok = erlang:load_nif( @@ -64,8 +67,8 @@ init_per_suite(Config) -> true -> ok end, - Config - catch _:_ -> + Config; + _ -> {skipped, "No dirty scheduler support"} end. @@ -106,9 +109,8 @@ dirty_nif_exception(Config) when is_list(Config) -> call_dirty_nif_exception(1), ct:fail(expected_badarg) catch - error:badarg -> - [{?MODULE,call_dirty_nif_exception,[1],_}|_] = - erlang:get_stacktrace(), + error:badarg:Stk1 -> + [{?MODULE,call_dirty_nif_exception,[1],_}|_] = Stk1, ok end, try @@ -118,9 +120,8 @@ dirty_nif_exception(Config) when is_list(Config) -> call_dirty_nif_exception(0), ct:fail(expected_badarg) catch - error:badarg -> - [{?MODULE,call_dirty_nif_exception,[0],_}|_] = - erlang:get_stacktrace(), + error:badarg:Stk2 -> + [{?MODULE,call_dirty_nif_exception,[0],_}|_] = Stk2, ok end, %% this checks that a dirty NIF can raise various terms as @@ -135,8 +136,8 @@ nif_raise_exceptions(NifFunc) -> erlang:apply(?MODULE,NifFunc,[Term]), ct:fail({expected,Term}) catch - error:Term -> - [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(), + error:Term:Stk -> + [{?MODULE,NifFunc,[Term],_}|_] = Stk, ok end end, ok, ExcTerms). @@ -148,6 +149,11 @@ dirty_scheduler_exit(Config) when is_list(Config) -> [ok] = mcall(Node, [fun() -> ok = erlang:load_nif(NifLib, []), + %% Perform a dry run to ensure that all required code + %% is loaded. Otherwise the test will fail since code + %% loading is done through dirty IO and it won't make + %% any progress during this test. + _DryRun = test_dirty_scheduler_exit(), Start = erlang:monotonic_time(millisecond), ok = test_dirty_scheduler_exit(), End = erlang:monotonic_time(millisecond), @@ -168,19 +174,18 @@ test_dse(N,Pids) -> test_dse(N-1,[Pid|Pids]). kill_dse([],Killed) -> - wait_dse(Killed); + wait_dse(Killed, ok); kill_dse([Pid|Pids],AlreadyKilled) -> exit(Pid,kill), kill_dse(Pids,[Pid|AlreadyKilled]). -wait_dse([]) -> - ok; -wait_dse([Pid|Pids]) -> +wait_dse([], Result) -> + Result; +wait_dse([Pid|Pids], Result) -> receive - {'EXIT',Pid,Reason} -> - killed = Reason - end, - wait_dse(Pids). + {'EXIT', Pid, killed} -> wait_dse(Pids, Result); + {'EXIT', Pid, _Other} -> wait_dse(Pids, failed) + end. dirty_call_while_terminated(Config) when is_list(Config) -> Me = self(), @@ -214,7 +219,7 @@ dirty_call_while_terminated(Config) when is_list(Config) -> 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 + %% 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, @@ -284,9 +289,9 @@ access_dirty_heap(Dirty, RGL, N, R) -> %% 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 +%% it starts a 2 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 +%% process finishes its 2 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, @@ -350,7 +355,7 @@ dirty_process_trace(Config) when is_list(Config) -> error(missing_trace_return_message) end after - 6500 -> + 2500 -> error(missing_done_message) end, ok @@ -377,7 +382,7 @@ code_purge(Config) when is_list(Config) -> Start = erlang:monotonic_time(), {Pid1, Mon1} = spawn_monitor(fun () -> dirty_code_test:func(fun () -> - %% Sleep for 6 seconds + %% Sleep for 2 seconds %% in dirty nif... dirty_sleeper() end) @@ -385,7 +390,7 @@ code_purge(Config) when is_list(Config) -> {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 + %% Sleep for 2 seconds %% in dirty nif... dirty_sleeper() end) @@ -487,7 +492,7 @@ test_dirty_process_access(Start, Test, Finish) -> ok end after - 3000 -> + 1000 -> error(timeout) end, ok = Finish(NifPid). @@ -531,6 +536,137 @@ mcall(Node, Funs) -> 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. @@ -542,6 +678,8 @@ 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 index e9301753b0..4462afd815 100644 --- a/erts/emulator/test/dirty_nif_SUITE_data/Makefile.src +++ b/erts/emulator/test/dirty_nif_SUITE_data/Makefile.src @@ -1,6 +1,6 @@ NIF_LIBS = dirty_nif_SUITE@dll@ -all: $(NIF_LIBS) +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 index a0019e5d95..a94a2c0b02 100644 --- a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c +++ b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-2018. 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. @@ -17,7 +17,7 @@ * * %CopyrightEnd% */ -#include "erl_nif.h" +#include <erl_nif.h> #include <assert.h> #ifdef __WIN32__ #include <windows.h> @@ -25,8 +25,35 @@ #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; } @@ -85,15 +112,12 @@ static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_ { 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); + res = enif_send(env, &pid, NULL, result); if (!res) return enif_make_badarg(env); else @@ -104,15 +128,12 @@ static ERL_NIF_TERM send_wait_from_dirty_nif(ErlNifEnv* env, int argc, const ERL { 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); + res = enif_send(env, &pid, NULL, result); #ifdef __WIN32__ Sleep(2000); @@ -184,22 +205,17 @@ dirty_sleeper(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) /* 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")); - } + if (argc == 1 && enif_get_local_pid(env, argv[0], &pid)) + enif_send(env, &pid, NULL, enif_make_atom(env, "ready")); #ifdef __WIN32__ - Sleep(6000); + Sleep(2000); #else - sleep(6); + sleep(2); #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); - } + if (argc == 1) + enif_send(env, &pid, NULL, enif_make_atom(env, "done")); return enif_make_atom(env, "ok"); } @@ -220,8 +236,8 @@ static ERL_NIF_TERM dirty_call_while_terminated_nif(ErlNifEnv* env, int argc, co self_term = enif_make_pid(env, &self); - result = enif_make_tuple2(env, enif_make_atom(env, "dirty_alive"), self_term); menv = enif_alloc_env(); + result = enif_make_tuple2(menv, enif_make_atom(menv, "dirty_alive"), self_term); res = enif_send(env, &to, menv, result); enif_free_env(menv); if (!res) @@ -232,9 +248,7 @@ static ERL_NIF_TERM dirty_call_while_terminated_nif(ErlNifEnv* env, int argc, co ; 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); + res = enif_send(env, &to, NULL, result); #ifdef __WIN32__ Sleep(1000); @@ -257,6 +271,147 @@ static ERL_NIF_TERM dirty_heap_access_nif(ErlNifEnv* env, int argc, const ERL_NI 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[] = { @@ -269,7 +424,9 @@ static ErlNifFunc nif_funcs[] = {"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} + {"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 6994bfef83..885c66331c 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -19,7 +19,7 @@ %% -module(distribution_SUITE). --compile(r15). +-compile(r16). -define(VERSION_MAGIC, 131). @@ -35,20 +35,25 @@ -include_lib("common_test/include/ct.hrl"). +%-define(Line, erlang:display({line,?LINE}),). +-define(Line,). + -export([all/0, suite/0, groups/0, ping/1, bulk_send_small/1, + group_leader/1, + optimistic_dflags/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, + 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, + atom_roundtrip_r16b/1, contended_atom_cache_entry/1, contended_unicode_atom_cache_entry/1, bad_dist_structure/1, @@ -56,17 +61,19 @@ 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, + group_leader_1/1, + optimistic_dflags_echo/0, optimistic_dflags_sender/1, 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]). + dist_evil_parallel_receiver/0]). %% epmd_module exports --export([start_link/0, register_node/2, register_node/3, port_please/2]). +-export([start_link/0, register_node/2, register_node/3, port_please/2, address_please/3]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -74,11 +81,14 @@ suite() -> all() -> [ping, {group, bulk_send}, {group, local_send}, + group_leader, + optimistic_dflags, link_to_busy, exit_to_busy, lost_exit, link_to_dead, - link_to_dead_new_node, applied_monitor_node, + link_to_dead_new_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}, start_epmd_false, epmd_module]. @@ -92,6 +102,7 @@ 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]}]. %% Tests pinging a node in different ways. @@ -122,58 +133,149 @@ ping(Config) when is_list(Config) -> ok. +%% Test erlang:group_leader(_, ExternalPid), i.e. DOP_GROUP_LEADER +group_leader(Config) when is_list(Config) -> + ?Line Sock = start_relay_node(group_leader_1, []), + ?Line Sock2 = start_relay_node(group_leader_2, []), + try + ?Line Node2 = inet_rpc_nodename(Sock2), + ?Line {ok, ok} = do_inet_rpc(Sock, ?MODULE, group_leader_1, [Node2]) + after + ?Line stop_relay_node(Sock), + ?Line stop_relay_node(Sock2) + end, + ok. + +group_leader_1(Node2) -> + ?Line ExtPid = spawn(Node2, fun F() -> + receive {From, group_leader} -> + From ! {self(), group_leader, group_leader()} + end, + F() + end), + ?Line GL1 = self(), + ?Line group_leader(GL1, ExtPid), + ?Line ExtPid ! {self(), group_leader}, + ?Line {ExtPid, group_leader, GL1} = receive_one(), + + %% Kill connection and repeat test when group_leader/2 triggers auto-connect + ?Line net_kernel:monitor_nodes(true), + ?Line net_kernel:disconnect(Node2), + ?Line {nodedown, Node2} = receive_one(), + ?Line GL2 = spawn(fun() -> dummy end), + ?Line group_leader(GL2, ExtPid), + ?Line {nodeup, Node2} = receive_one(), + ?Line ExtPid ! {self(), group_leader}, + ?Line {ExtPid, group_leader, GL2} = receive_one(), + ok. + +%% Test optimistic distribution flags toward pending connections (DFLAG_DIST_HOPEFULLY) +optimistic_dflags(Config) when is_list(Config) -> + ?Line Sender = start_relay_node(optimistic_dflags_sender, []), + ?Line Echo = start_relay_node(optimistic_dflags_echo, []), + try + ?Line {ok, ok} = do_inet_rpc(Echo, ?MODULE, optimistic_dflags_echo, []), + + ?Line EchoNode = inet_rpc_nodename(Echo), + ?Line {ok, ok} = do_inet_rpc(Sender, ?MODULE, optimistic_dflags_sender, [EchoNode]) + after + ?Line stop_relay_node(Sender), + ?Line stop_relay_node(Echo) + end, + ok. + +optimistic_dflags_echo() -> + P = spawn(fun F() -> + receive {From, Term} -> + From ! {self(), Term} + end, + F() + end), + register(optimistic_dflags_echo, P), + optimistic_dflags_echo ! {self(), hello}, + {P, hello} = receive_one(), + ok. + +optimistic_dflags_sender(EchoNode) -> + ?Line net_kernel:monitor_nodes(true), + + optimistic_dflags_do(EchoNode, <<1:1>>), + optimistic_dflags_do(EchoNode, fun lists:map/2), + ok. + +optimistic_dflags_do(EchoNode, Term) -> + ?Line {optimistic_dflags_echo, EchoNode} ! {self(), Term}, + ?Line {nodeup, EchoNode} = receive_one(), + ?Line {EchoPid, Term} = receive_one(), + %% repeat with pid destination + ?Line net_kernel:disconnect(EchoNode), + ?Line {nodedown, EchoNode} = receive_one(), + ?Line EchoPid ! {self(), Term}, + ?Line {nodeup, EchoNode} = receive_one(), + ?Line {EchoPid, Term} = receive_one(), + + ?Line net_kernel:disconnect(EchoNode), + ?Line {nodedown, EchoNode} = receive_one(), + ok. + + +receive_one() -> + receive M -> M after 1000 -> timeout end. + + bulk_send_small(Config) when is_list(Config) -> bulk_send(64, 32). bulk_send_big(Config) when is_list(Config) -> bulk_send(32, 64). -bulk_send_bigbig(Config) when is_list(Config) -> - bulk_sendsend(32*5, 4). - bulk_send(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 = list_to_binary(lists:duplicate(BinSize*1024, 253)), + 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(trunc(Size/1024/max(1,Elapsed)+0.5)) ++ " K/s"}. + {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_sendsend(Terms, BinSize) -> +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), - ct: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) -> ct:timetrap({seconds, 30}), - io:format("Sending ~w binaries, each of size ~w K", + 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 = list_to_binary(lists:duplicate(BinSize*1024, 253)), - %%Size = Terms*size(Bin), + Bin = binary:copy(<<253>>, BinSize*1024), %% SLF LEFT OFF HERE. %% When the caller uses small hunks, like 4k via @@ -184,74 +286,62 @@ 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. - {ok, NodeSend} = start_node(bulk_sender, "+zdbbl " ++ integer_to_list(BusyBufSize)), - _Send = spawn(NodeSend, erlang, apply, [fun sendersender/4, [self(), Recv, Bin, Terms]]), + {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, + 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, stop_node(NodeRecv), stop_node(NodeSend), - {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). + {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) - end - end; -sendersender3(To, Bin, Left, SendDone, MonitorCount) -> - To ! {term, Bin}, - %%timer:sleep(50), - sendersender3(To, Bin, Left-1, SendDone, MonitorCount). + receive + {_,_}=Any -> + {Any,MonitorCount} + end + end. %% Receiver process to be run on a slave node. receiver(Terms, Size) -> receive {term, Bin} -> - receiver(Terms+1, Size+size(Bin)); + receiver(Terms+1, Size+byte_size(Bin)); {done, ReplyTo} -> ReplyTo ! {Terms, Size} end. @@ -429,18 +519,20 @@ 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) + 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; + 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), @@ -646,31 +738,11 @@ link_to_dead_new_node(Config) when is_list(Config) -> end, ok. -%% Test that monitor_node/2 works when applied. -applied_monitor_node(Config) when is_list(Config) -> - NonExisting = list_to_atom("__non_existing__@" ++ hostname()), - - %% Tail-recursive call to apply (since the node is non-existing, - %% there will be a trap). - - true = tail_apply(erlang, monitor_node, [NonExisting, true]), - [{nodedown, NonExisting}] = test_server:messages_get(), - - %% Ordinary call (with trap). - - true = apply(erlang, monitor_node, [NonExisting, true]), - [{nodedown, NonExisting}] = test_server:messages_get(), - - ok. - -tail_apply(M, F, A) -> - apply(M, F, A). - %% 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) -> process_flag(trap_exit, true), - Port = open_port({spawn, efile}, []), + Port = make_port(), Ref = make_ref(), {ok, Node} = start_node(ref_port_roundtrip), net_adm:ping(Node), @@ -691,6 +763,9 @@ ref_port_roundtrip(Config) when is_list(Config) -> end, ok. +make_port() -> + hd(erlang:ports()). + roundtrip(Term) -> exit(Term). @@ -722,7 +797,7 @@ show_term(Term) -> %% Tests behaviour after net_kernel:stop (OTP-2586). stop_dist(Config) when is_list(Config) -> - Str = os:cmd(atom_to_list(lib:progname()) + Str = os:cmd(ct:get_progname() ++ " -noshell -pa " ++ proplists:get_value(data_dir, Config) ++ " -s run"), @@ -793,8 +868,8 @@ dist_auto_connect_once(Config) when is_list(Config) -> {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:tokens(atom_to_list(NN),"@"), - [_,MyHostPart] = string:tokens(atom_to_list(node()),"@"), + [_,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. receive after 1000 -> ok end, case HostPartPeer of @@ -899,9 +974,9 @@ dist_auto_connect_start(Name, Value) when is_list(Name), is_atom(Value) -> ModuleDir = filename:dirname(code:which(?MODULE)), ValueStr = atom_to_list(Value), Cookie = atom_to_list(erlang:get_cookie()), - Cmd = lists:concat( + Cmd = lists:append( [%"xterm -e ", - atom_to_list(lib:progname()), + ct:get_progname(), % " -noinput ", " -detached ", long_or_short(), " ", Name, @@ -1032,21 +1107,21 @@ atom_roundtrip(Config) when is_list(Config) -> stop_node(Node), ok. -atom_roundtrip_r15b(Config) when is_list(Config) -> - case test_server:is_release_available("r15b") of +atom_roundtrip_r16b(Config) when is_list(Config) -> + case test_server:is_release_available("r16b") of true -> ct:timetrap({minutes, 6}), - AtomData = atom_data(), + AtomData = unicode_atom_data(), verify_atom_data(AtomData), - case start_node(Config, [], "r15b") of + case start_node(Config, [], "r16b") of {ok, Node} -> do_atom_roundtrip(Node, AtomData), stop_node(Node); {error, timeout} -> - {skip,"Unable to start OTP R15B release"} + {skip,"Unable to start OTP R16B release"} end; false -> - {skip,"No OTP R15B available"} + {skip,"No OTP R16B available"} end. unicode_atom_roundtrip(Config) when is_list(Config) -> @@ -1165,8 +1240,6 @@ contended_atom_cache_entry_test(Config, Type) -> spawn_link( SNode, fun () -> - erts_debug:set_internal_state(available_internal_state, - true), Master = self(), CIX = get_cix(), TestAtoms = case Type of @@ -1251,7 +1324,7 @@ get_cix(CIX) when is_integer(CIX), CIX < 0 -> get_cix(CIX) when is_integer(CIX) -> get_cix(CIX, unwanted_cixs(), - erts_debug:get_internal_state(max_atom_out_cache_index)). + get_internal_state(max_atom_out_cache_index)). get_cix(CIX, Unwanted, MaxCIX) when CIX > MaxCIX -> get_cix(0, Unwanted, MaxCIX); @@ -1263,8 +1336,8 @@ get_cix(CIX, Unwanted, MaxCIX) -> unwanted_cixs() -> lists:map(fun (Node) -> - erts_debug:get_internal_state({atom_out_cache_index, - Node}) + get_internal_state({atom_out_cache_index, + Node}) end, nodes()). @@ -1273,7 +1346,7 @@ get_conflicting_atoms(_CIX, 0) -> []; get_conflicting_atoms(CIX, N) -> Atom = list_to_atom("atom" ++ integer_to_list(erlang:unique_integer([positive]))), - case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of + case get_internal_state({atom_out_cache_index, Atom}) of CIX -> [Atom|get_conflicting_atoms(CIX, N-1)]; _ -> @@ -1284,7 +1357,7 @@ get_conflicting_unicode_atoms(_CIX, 0) -> []; get_conflicting_unicode_atoms(CIX, N) -> 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 + case get_internal_state({atom_out_cache_index, Atom}) of CIX -> [Atom|get_conflicting_unicode_atoms(CIX, N-1)]; _ -> @@ -1372,81 +1445,59 @@ bad_dist_structure(Config) when is_list(Config) -> 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 @@ -1683,6 +1734,61 @@ bad_dist_ext_connection_id(Config) when is_list(Config) -> 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]), + + Parent = self(), + P = spawn_opt(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, %% DID CRASH HERE + bad_dist_ext_check_msgs([one]), + Parent ! {self(), messages_checked} + end, + [link, + %% on_heap to force total_heap_size to inspect msg queue + {message_queue_data, on_heap}]), + + 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), + + %% Let process_info(P, total_heap_size) find bad msg and disconnect + rpc:call(Victim, erlang, process_info, [P, total_heap_size]), + + 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 @@ -1714,47 +1820,49 @@ bad_dist_ext_check_msgs([M|Ms]) -> 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, + spawn_link(Offender, fun () -> Node = node(Victim), pong = net_adm:ping(Node), - DPrt = dport(Node), + erlang:monitor_node(Node, true), + DCtrl = dctrl(Node), Bad1 = case WhereToPutSelf of 0 -> Bad; @@ -1767,7 +1875,16 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> [] -> []; _Other -> [dmsg_ext(PayLoad)] end, - port_command(DPrt, DData), + + receive {nodedown, Node} -> exit("premature nodedown") + after 10 -> ok + end, + + dctrl_send(DCtrl, DData), + + receive {nodedown, Node} -> ok + after 5000 -> exit("missing nodedown") + end, Parent ! {DData,Done} end), receive @@ -1786,20 +1903,23 @@ 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), + DCtrl = dctrl(Node), DData = [dmsg_hdr(), dmsg_ext({?DOP_SEND, ?COOKIE, To}), - dmsg_bad_atom_cache_ref()], - repeat(fun () -> port_command(DPrt, DData) end, Repeat), + BadTerm], + repeat(fun () -> dctrl_send(DCtrl, DData) end, Repeat), Parent ! Done end), receive Done -> ok end. @@ -1821,11 +1941,12 @@ send_bad_ctl(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> 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})]), + 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. @@ -1838,17 +1959,32 @@ send_bad_dhdr(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> spawn_link(BadNode, fun () -> pong = net_adm:ping(ToNode), - port_command(dport(ToNode), dmsg_bad_hdr()), + dctrl_send(dctrl(ToNode), dmsg_bad_hdr()), Parent ! Done end), receive Done -> ok end. -dport(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) - end, - erts_debug:get_internal_state({dist_port, Node}). +dctrl(Node) when is_atom(Node) -> + get_internal_state({dist_ctrl, Node}). + +get_internal_state(Op) -> + try erts_debug:get_internal_state(Op) of + R -> R + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:get_internal_state(Op) + end. + +set_internal_state(Op, Val) -> + try erts_debug:set_internal_state(Op, Val) of + R -> R + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(Op, Val) + end. + dmsg_hdr() -> [131, % Version Magic @@ -1885,6 +2021,9 @@ dmsg_ext(Term) -> 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"), @@ -1947,6 +2086,11 @@ port_please(_Name, _Ip) -> {port, Port, Version} end. +address_please(_Name, _Address, _AddressFamily) -> + %% Use localhost. + IP = {127,0,0,1}, + {ok, IP}. + %%% Utilities timestamp() -> @@ -1988,11 +2132,9 @@ freeze_node(Node, MS) -> Freezer = self(), spawn_link(Node, fun () -> - erts_debug:set_internal_state(available_internal_state, - true), - dport_send(Freezer, DoingIt), + dctrl_dop_send(Freezer, DoingIt), receive after Own -> ok end, - erts_debug:set_internal_state(block, MS+Own) + set_internal_state(block, MS+Own) end), receive DoingIt -> ok end, receive after Own -> ok end. @@ -2042,7 +2184,7 @@ start_relay_node(Node, Args) -> [{args, Args ++ " -setcookie "++Cookie++" -pa "++Pa++" "++ RunArg}]), - [N,H] = string:tokens(atom_to_list(NN),"@"), + [N,H] = string:lexemes(atom_to_list(NN),"@"), {ok, Sock} = gen_tcp:accept(LSock), pang = net_adm:ping(NN), {N,H,Sock}. @@ -2196,8 +2338,7 @@ forever(Fun) -> forever(Fun). abort(Why) -> - erts_debug:set_internal_state(available_internal_state, true), - erts_debug:set_internal_state(abort, Why). + set_internal_state(abort, Why). start_busy_dist_port_tracer() -> @@ -2266,52 +2407,6 @@ string_to_utf8_list([CP|CPs]) when is_integer(CP), 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); diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 2fbf6eae61..bd62708aa7 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -43,9 +43,9 @@ outputv_errors/1, driver_unloaded/1, io_ready_exit/1, + use_fallback_pollset/0, use_fallback_pollset/1, bad_fd_in_pollset/1, - driver_event/1, fd_change/1, steal_control/1, otp_6602/1, @@ -58,11 +58,9 @@ 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, @@ -82,10 +80,14 @@ async_blast/1, thr_msg_blast/1, consume_timeslice/1, + env/1, + poll_pipe/1, z_test/1]). -export([bin_prefix/2]). +-export([get_check_io_total/1]). % for z_SUITE.erl + -include_lib("common_test/include/ct.hrl"). @@ -119,17 +121,26 @@ -define(heap_binary_size, 64). init_per_testcase(Case, Config) when is_atom(Case), 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, + 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}), - 0 = element(1, erts_debug:get_internal_state(check_io_debug)), + 0 = element(1, CIOD), [{testcase, Case}|Config]. end_per_testcase(Case, Config) -> erlang:display({end_per_testcase, Case}), - 0 = element(1, erts_debug:get_internal_state(check_io_debug)), + CIOD = rpc(Config, + fun() -> + get_stable_check_io_info(), + erts_debug:get_internal_state(check_io_debug) + end), + 0 = element(1, CIOD), ok. suite() -> @@ -137,10 +148,13 @@ suite() -> {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, use_fallback_pollset, - bad_fd_in_pollset, driver_event, fd_change, - steal_control, otp_6602, driver_system_info_base_ver, + [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, @@ -148,24 +162,32 @@ all() -> %% Keep a_test first and z_test last... 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, + env, + poll_pipe, 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. @@ -173,10 +195,28 @@ 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. %% Test sending bad types to port with an outputv-capable driver. @@ -778,21 +818,23 @@ io_ready_exit(Config) when is_list(Config) -> -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() -> + [{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 -> + {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}) @@ -814,6 +856,7 @@ use_fallback_pollset(Config) when is_list(Config) -> 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 () -> @@ -825,27 +868,31 @@ use_fallback_pollset(Config) when is_list(Config) -> end. bad_fd_in_pollset(Config) when is_list(Config) -> - chkio_test_fini(chkio_test(chkio_test_init(Config), - ?CHKIO_BAD_FD_IN_POLLSET, - fun () -> sleep(1000) end)). - -driver_event(Config) when is_list(Config) -> - chkio_test_fini(chkio_test(chkio_test_init(Config), - ?CHKIO_DRIVER_EVENT, - fun () -> sleep(1000) end)). + 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) -> - chkio_test_fini(chkio_test(chkio_test_init(Config), - ?CHKIO_FD_CHANGE, - fun () -> 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(Config) when is_list(Config) -> - chkio_test_fini(case chkio_test_init(Config) of - {erts_poll_info, _} = Hndl -> - steal_control_test(Hndl); - Skip -> - 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}) -> Port = open_chkio_port(), @@ -887,7 +934,7 @@ chkio_test_init(Config) when is_list(Config) -> ChkIo = get_stable_check_io_info(), case catch lists:keysearch(name, 1, ChkIo) of {value, {name, erts_poll}} -> - io:format("Before test: ~p~n", [ChkIo]), + ct:log("Before test: ~p~n", [ChkIo]), Path = proplists:get_value(data_dir, Config), erl_ddll:start(), ok = load_driver(Path, 'chkio_drv'), @@ -948,8 +995,9 @@ chkio_test({erts_poll_info, Before}, "ok" -> chk_chkio_port(Port), Fun(), - During = erlang:system_info(check_io), + 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), @@ -1001,22 +1049,83 @@ verify_chkio_state(Before, After) -> ok. get_stable_check_io_info() -> - ChkIo = 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), + 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 10 -> ok end, - get_stable_check_io_info() + receive after 100 -> ok end, + get_stable_check_io_info(N-1) end. +%% 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. @@ -1087,9 +1196,9 @@ check_driver_system_info_result(Result) -> 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:tokens(Str, "=") + string:lexemes(Str, "=") end, - string:tokens(Result, " ")), + string:lexemes(Result, " ")), ?EXPECTED_SYSTEM_INFO_NAMES), case {DDVSN, drv_vsn_str2tup(erlang:system_info(driver_version))} of @@ -1144,8 +1253,6 @@ check_si_res(["thread", "false"]) -> false = erlang:system_info(threads); check_si_res(["smp", "true"]) -> true = erlang:system_info(smp_support); -check_si_res(["smp", "false"]) -> - false = erlang:system_info(smp_support); %% Data added in second version of driver_system_info() (driver version 1.1) check_si_res(["async_thrs", Value]) -> @@ -1338,11 +1445,9 @@ driver_monitor(Config) when is_list(Config) -> -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) -> Drv = ioq_exit_drv, @@ -1395,9 +1500,6 @@ ioq_exit_timeout(Config) when is_list(Config) -> ioq_exit_ready_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_ASYNC). -ioq_exit_event(Config) when is_list(Config) -> - ioq_exit_test(Config, ?IOQ_EXIT_EVENT). - ioq_exit_ready_input_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_INPUT_ASYNC). @@ -1407,9 +1509,6 @@ ioq_exit_ready_output_async(Config) when is_list(Config) -> ioq_exit_timeout_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_TIMEOUT_ASYNC). -ioq_exit_event_async(Config) when is_list(Config) -> - ioq_exit_test(Config, ?IOQ_EXIT_EVENT_ASYNC). - vsn_mismatch_test(Config, LoadResult) -> Path = proplists:get_value(data_dir, Config), @@ -1643,7 +1742,7 @@ missing_callbacks(Config) when is_list(Config) -> smp_select(Config) when is_list(Config) -> case os:type() of {win32,_} -> {skipped, "Test not implemented for this OS"}; - _ -> smp_select0(Config) + _ -> rpc(Config, fun() -> smp_select0(Config) end) end. smp_select0(Config) -> @@ -1655,7 +1754,7 @@ smp_select0(Config) -> ProcFun = fun()-> io:format("Worker ~p starting\n",[self()]), Port = open_port({spawn, DrvName}, []), smp_select_loop(Port, 100000), - sleep(1000), % wait for driver to handle pending events + smp_select_done(Port), true = erlang:port_close(Port), Master ! {ok,self()}, io:format("Worker ~p finished\n",[self()]) @@ -1673,7 +1772,10 @@ smp_select0(Config) -> smp_select_loop(_, 0) -> ok; smp_select_loop(Port, N) -> - "ok" = erlang:port_control(Port, ?CHKIO_SMP_SELECT, []), + case erlang:port_control(Port, ?CHKIO_SMP_SELECT, []) of + "yield" -> erlang:yield(); + "ok" -> ok + end, receive stop -> io:format("Worker ~p stopped with ~p laps left\n",[self(), N]), @@ -1682,6 +1784,21 @@ smp_select_loop(Port, N) -> smp_select_loop(Port, N-1) end. +smp_select_done(Port) -> + case erlang:port_control(Port, ?CHKIO_SMP_SELECT, "done") of + "wait" -> + receive + {Port, done} -> + ok + after 10*1000 -> + %% Seems we have a lost ready_input event. + %% Go ahead anyway, port will crash VM when closed. + ok + end; + + "ok" -> ok + end. + smp_select_wait([], _) -> ok; smp_select_wait(Pids, TimeoutMsg) -> @@ -1699,7 +1816,7 @@ smp_select_wait(Pids, TimeoutMsg) -> driver_select_use(Config) when is_list(Config) -> case os:type() of {win32,_} -> {skipped, "Test not implemented for this OS"}; - _ -> driver_select_use0(Config) + _ -> rpc(Config, fun() -> driver_select_use0(Config) end) end. driver_select_use0(Config) -> @@ -1750,12 +1867,6 @@ thread_mseg_alloc_cache_clean(Config) when is_list(Config) -> ok end. -mseg_alloc_cci(MsegAllocInfo) -> - {value,{options, OL}} - = lists:keysearch(options, 1, MsegAllocInfo), - {value,{cci,CCI}} = lists:keysearch(cci,1,OL), - CCI. - mseg_alloc_ccc() -> mseg_alloc_ccc(mseg_inst_info(0)). @@ -1950,44 +2061,39 @@ thr_msg_blast_receiver_proc(Port, Max, 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 = 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 - 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 @@ -2276,11 +2382,56 @@ count_proc_sched(Ps, PNs) -> PNs end. +%% +%% Tests whether erl_drv_putenv reflects in os:getenv and vice versa. +%% +env(Config) when is_list(Config) -> + ok = load_driver(proplists:get_value(data_dir, Config), env_drv), + Port = open_port({spawn_driver, env_drv}, []), + true = is_port(Port), + + Keys = ["env_drv_a_key", "env_drv_b_key", "env_drv_c_key"], + Values = ["a_value", "b_value", "c_value"], + + [env_put_test(Port, Key, Value) || Key <- Keys, Value <- Values], + [env_get_test(Port, Key, Value) || Key <- Keys, Value <- Values], + [env_oversize_test(Port, Key) || Key <- Keys], + [env_notfound_test(Port, Key) || Key <- Keys], + + true = port_close(Port), + erl_ddll:unload_driver(env_drv), + ok. + +env_control(Port, Command, Key, Value) -> + KeyBin = list_to_binary(Key), + ValueBin = list_to_binary(Value), + Header = <<(byte_size(KeyBin)), (byte_size(ValueBin))>>, + Payload = <<KeyBin/binary, ValueBin/binary>>, + port_control(Port, Command, <<Header/binary, Payload/binary>>). + +env_put_test(Port, Key, Value) -> + os:unsetenv(Key), + [0] = env_control(Port, 0, Key, Value), + Value = os:getenv(Key). + +env_get_test(Port, Key, ExpectedValue) -> + true = os:putenv(Key, ExpectedValue), + [0] = env_control(Port, 1, Key, ExpectedValue). + +env_oversize_test(Port, Key) -> + os:putenv(Key, [$A || _ <- lists:seq(1, 1024)]), + [127] = env_control(Port, 1, Key, ""). + +env_notfound_test(Port, Key) -> + true = os:unsetenv(Key), + [255] = env_control(Port, 1, Key, ""). + + a_test(Config) when is_list(Config) -> - check_io_debug(). + rpc(Config, fun check_io_debug/0). z_test(Config) when is_list(Config) -> - check_io_debug(). + rpc(Config, fun check_io_debug/0). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Utilities @@ -2288,8 +2439,8 @@ z_test(Config) when is_list(Config) -> check_io_debug() -> get_stable_check_io_info(), - {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug - = erts_debug:get_internal_state(check_io_debug), + {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]), @@ -2302,7 +2453,7 @@ check_io_debug() -> %% one extra used fd that is not selected on ok end, - 0 = NoDrvEvStructs, + 0 = NoEnifSelStructs, ok. has_gethost() -> @@ -2354,7 +2505,7 @@ 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. @@ -2455,8 +2606,18 @@ stop_driver(Port, Name) -> ok = erl_ddll:stop(). load_driver(Dir, Driver) -> + Before = erlang:system_info(taints), case erl_ddll:load_driver(Dir, Driver) of - ok -> ok; + ok -> + After = erlang:system_info(taints), + case lists:member(Driver, Before) of + true -> + After = Before; + false -> + true = lists:member(Driver, After), + Before = lists:delete(Driver, After) + end, + ok; {error, Error} = Res -> io:format("~s\n", [erl_ddll:format_error(Error)]), Res @@ -2472,15 +2633,19 @@ sleep(Ms) when is_integer(Ms), Ms >= 0 -> start_node(Config) when is_list(Config) -> + 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(proplists:get_value(testcase, Config)) + ++ 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, "-pa "++Pa}]). + test_server:start_node(Name, slave, [{args, Args ++ " -pa "++Pa}]). stop_node(Node) -> test_server:stop_node(Node). @@ -2494,14 +2659,6 @@ 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 -> @@ -2521,3 +2678,57 @@ driver_alloc_size() -> 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:Stk -> + {'EXIT',E,R,Stk} + 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. + +poll_pipe(Config) when is_list(Config) -> + %% ERL-647; we wouldn't see any events on EOF when polling a pipe using + %% kqueue(2). + case os:type() of + {unix, _} -> + Command = "erl -noshell -eval " + "'\"DATA\n\" = io:get_line(\"\")," + "eof = io:get_line(\"\")," + "halt()' <<< 'DATA'", + Ref = make_ref(), + Self = self(), + Pid = spawn(fun() -> os:cmd(Command), Self ! Ref end), + receive + Ref -> ok + after 5000 -> + exit(Pid, kill), + ct:fail("Stuck reading from stdin.") + end; + _ -> + {skipped, "Unix-only test"} + end. diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src index 1fedd72200..bcabaa689d 100644 --- a/erts/emulator/test/driver_SUITE_data/Makefile.src +++ b/erts/emulator/test/driver_SUITE_data/Makefile.src @@ -16,7 +16,8 @@ MISC_DRVS = outputv_drv@dll@ \ thr_free_drv@dll@ \ async_blast_drv@dll@ \ thr_msg_blast_drv@dll@ \ - consume_timeslice_drv@dll@ + consume_timeslice_drv@dll@ \ + env_drv@dll@ SYS_INFO_DRVS = sys_info_base_drv@dll@ \ sys_info_prev_drv@dll@ \ diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c index 614b68e865..b9ee155b4b 100644 --- a/erts/emulator/test/driver_SUITE_data/chkio_drv.c +++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c @@ -42,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 @@ -67,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; @@ -86,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; @@ -104,7 +90,7 @@ typedef struct chkio_smp_select { int next_read; int next_write; int first_write; - enum {Closed, Opened, Selected, Waiting} state; + enum {Closed, Opened, Selected, Waiting, WaitingDone} state; int wasSelected; unsigned rand_state; }ChkioSmpSelect; @@ -141,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); @@ -164,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, @@ -243,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) { @@ -305,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); } } @@ -327,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); } } @@ -338,29 +292,36 @@ stop_steal_aux(ChkioDrvData *cddp) static void free_smp_select(ChkioSmpSelect* pip, ErlDrvPort port) { switch (pip->state) { + case WaitingDone: case Waiting: { int word; - fprintf(stderr, "Closing pipe in state Waiting. Event lost?\n"); + fprintf(stderr, "Closing pipe in state Waiting*. Event lost?\r\n"); for (;;) { int bytes = read(pip->read_fd, &word, sizeof(word)); if (bytes != sizeof(word)) { if (bytes != 0) { - fprintf(stderr, "Failed to read from pipe, bytes=%d, errno=%d\n", bytes, errno); + fprintf(stderr, "Failed to read from pipe, bytes=%d, errno=%d\r\n", + bytes, errno); } break; } - fprintf(stderr, "Read from pipe: %d\n", word); + fprintf(stderr, "Read from pipe: %d\r\n", word); } 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; + case Closed: + break; } driver_free(pip); } @@ -426,6 +387,9 @@ chkio_drv_start(ErlDrvPort port, char *command) cddp->id = driver_mk_port(port); cddp->test = CHKIO_STOP; cddp->test_data = NULL; + + drv_use_singleton.fd_stop_select = -2; /* disable stop_select asserts */ + return (ErlDrvData) cddp; #endif } @@ -445,9 +409,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; @@ -557,6 +518,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: @@ -569,7 +533,7 @@ chkio_drv_ready_input(ErlDrvData drv_data, ErlDrvEvent event) printf("Read event on uninitiated pipe %d\n", fd); abort(); } - if (pip->state != Selected && pip->state != Waiting) { + if (pip->state != Selected && pip->state != Waiting && pip->state != WaitingDone) { printf("Read event on pipe in strange state %d\n", pip->state); abort(); } @@ -579,9 +543,9 @@ chkio_drv_ready_input(ErlDrvData drv_data, ErlDrvEvent event) inPipe = (pip->next_write - pip->next_read); if (inPipe == 0) { bytes = read(pip->read_fd, &word, sizeof(word)); - printf("Unexpected empty pipe, expected %u -> %u, bytes=%d, word=%d, written=%d\n", - pip->next_read, pip->next_write-1, bytes, word, - (pip->next_write - pip->first_write)); + printf("Unexpected empty pipe: ptr=%p, fds=%d->%d, read bytes=%d, word=%d, written=%d\n", + pip, pip->write_fd, pip->read_fd, + bytes, word, (pip->next_write - pip->first_write)); /*abort(); Allow unexpected events as it's been seen to be triggered by epoll on Linux. Most of the time the unwanted events are filtered by @@ -607,7 +571,20 @@ chkio_drv_ready_input(ErlDrvData drv_data, ErlDrvEvent event) TRACEF(("Read %d from fd=%d\n", word, fd)); pip->next_read++; } - pip->state = Selected; /* not Waiting anymore */ + if (pip->state == WaitingDone) { + if (pip->next_write == pip->next_read) { + /* All data read, send {Port, done} */ + ErlDrvTermData spec[] = {ERL_DRV_PORT, driver_mk_port(cddp->port), + ERL_DRV_ATOM, driver_mk_atom("done"), + ERL_DRV_TUPLE, 2}; + erl_drv_output_term(driver_mk_port(cddp->port), + spec, sizeof(spec) / sizeof(spec[0])); + pip->state = Selected; + } + } + else { + pip->state = Selected; /* not Waiting anymore */ + } break; } case CHKIO_DRV_USE: @@ -621,55 +598,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 @@ -779,25 +707,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) @@ -937,69 +846,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) @@ -1028,58 +874,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) { @@ -1109,37 +916,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 { @@ -1153,11 +940,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], @@ -1173,32 +957,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; @@ -1213,11 +971,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]); } } } @@ -1225,8 +981,17 @@ chkio_drv_control(ErlDrvData drv_data, break; } case CHKIO_SMP_SELECT: { - int rounds = 1; /*rand(); */ ChkioSmpSelect* pip = (ChkioSmpSelect*) cddp->test_data; + if (len == 4 && memcmp(buf, "done", 4) == 0) { + if (pip && pip->state == Waiting) { + pip->state = WaitingDone; + res_str = "wait"; + } + else + res_str = "ok"; + res_len = -1; + break; + } if (pip == NULL) { erl_drv_mutex_lock(smp_pipes_mtx); if (smp_pipes) { @@ -1242,7 +1007,8 @@ chkio_drv_control(ErlDrvData drv_data, } erl_drv_mutex_unlock(smp_pipes_mtx); } - while (rounds--) { + res_str = NULL; + { int op = rand_r(&pip->rand_state); switch (pip->state) { case Closed: { @@ -1252,12 +1018,11 @@ chkio_drv_control(ErlDrvData drv_data, fcntl(fds[0], F_SETFL, flags|O_NONBLOCK) < 0) { driver_failure_posix(cddp->port, errno); - rounds = 0; break; } 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; @@ -1267,7 +1032,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(); @@ -1276,8 +1042,11 @@ 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)); + 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(); } @@ -1285,8 +1054,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(); } @@ -1294,13 +1065,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) { @@ -1329,10 +1100,12 @@ 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: + case Waiting: + res_str = "yield"; + res_len = -1; break; default: fprintf(stderr, "Strange state %d\n", pip->state); @@ -1348,9 +1121,11 @@ chkio_drv_control(ErlDrvData drv_data, else { cddp->test_data = pip; } - } - res_str = "ok"; - res_len = -1; + } + if (!res_str) { + res_str = "ok"; + res_len = -1; + } break; } case CHKIO_DRV_USE: @@ -1397,10 +1172,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) \ @@ -1575,7 +1358,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/env_drv.c b/erts/emulator/test/driver_SUITE_data/env_drv.c new file mode 100644 index 0000000000..0e910eeb84 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/env_drv.c @@ -0,0 +1,108 @@ +/* + * %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% + */ + +/* Tests whether erl_drv_putenv/erl_drv_getenv work correctly and reflect + * changes to os:putenv/getenv. */ + +#include <string.h> +#include <stdio.h> + +#include "erl_driver.h" + +static ErlDrvSSizeT env_drv_ctl(ErlDrvData drv_data, unsigned int cmd, + char* buf, ErlDrvSizeT len, char** rbuf, ErlDrvSizeT rsize); + +static ErlDrvEntry env_drv_entry = { + NULL /* init */, + NULL /* start */, + NULL /* stop */, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + "env_drv", + NULL /* finish */, + NULL /* handle */, + env_drv_ctl, + NULL /* timeout */, + NULL /* outputv*/, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call*/, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(env_drv) { + return &env_drv_entry; +} + +static int test_putenv(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { + char key[256], value[256]; + int key_len, value_len; + + key_len = buf[0]; + value_len = buf[1]; + + sprintf(key, "%.*s", key_len, &buf[2]); + sprintf(value, "%.*s", value_len, &buf[2 + key_len]); + + return erl_drv_putenv(key, value); +} + +static int test_getenv(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { + char expected_value[256], stored_value[256], key[256]; + int expected_value_len, key_len; + size_t stored_value_len; + int res; + + key_len = buf[0]; + sprintf(key, "%.*s", key_len, &buf[2]); + + expected_value_len = buf[1]; + sprintf(expected_value, "%.*s", expected_value_len, &buf[2 + key_len]); + + stored_value_len = sizeof(stored_value); + res = erl_drv_getenv(key, stored_value, &stored_value_len); + + if(res == 0) { + return strcmp(stored_value, expected_value) != 0; + } else if(res == 1) { + return 127; + } + + return 255; +} + +static ErlDrvSSizeT env_drv_ctl(ErlDrvData drv_data, unsigned int cmd, + char* buf, ErlDrvSizeT len, char** rbuf, ErlDrvSizeT rsize) { + + if(cmd == 0) { + (**rbuf) = (char)test_putenv(drv_data, buf, len); + } else { + (**rbuf) = (char)test_getenv(drv_data, buf, len); + } + + return 1; +} 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 d87c2bec93..9e96923e17 100644 --- a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c +++ b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2016. All Rights Reserved. + * Copyright Ericsson AB 2007-2018. 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. @@ -25,8 +25,7 @@ * - ready_input(), * - ready_output(), * - timeout(), - * - driver_async() -> read_async(), and - * - event() + * - driver_async() -> read_async() */ #ifndef UNIX @@ -65,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 { @@ -80,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))) @@ -97,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 *); @@ -118,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, @@ -149,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; } @@ -192,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; @@ -266,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: @@ -302,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: @@ -395,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/missing_callback_drv.c b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c index e7480d2e00..14838f0377 100644 --- a/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c +++ b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c @@ -41,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); @@ -90,7 +86,6 @@ start(ErlDrvPort port, char *command) mcd->ofd = -1; mcd->ifd = -1; - mcd->efd = -1; #ifdef UNIX @@ -105,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); @@ -135,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/dump_SUITE.erl b/erts/emulator/test/dump_SUITE.erl new file mode 100644 index 0000000000..d0237b78cc --- /dev/null +++ b/erts/emulator/test/dump_SUITE.erl @@ -0,0 +1,125 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2018. 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(1000), + get_dump_when_done(Dump) + end. + +get_dump_when_done(Dump, Sz) -> + timer:sleep(1000), + 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 6bb8487c4e..7dcf302742 100644 --- a/erts/emulator/test/efile_SUITE.erl +++ b/erts/emulator/test/efile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -19,94 +19,17 @@ -module(efile_SUITE). -export([all/0, suite/0]). --export([iter_max_files/1, async_dist/1]). +-export([iter_max_files/1, proc_zero_sized_files/1]). --export([do_iter_max_files/2, do_async_dist/1]). +-export([do_iter_max_files/2]). -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]. - -do_async_dist(Dir) -> - X = 100, - AT = erlang:system_info(thread_pool_size), - Keys = file_keys(Dir,AT*X,[],[]), - Tab = ets:new(x,[ordered_set]), - [ ets:insert(Tab,{N,0}) || N <- lists:seq(0,AT-1) ], - [ ets:update_counter(Tab,(N rem AT),1) || N <- Keys ], - Res = [ V || {_,V} <- ets:tab2list(Tab) ], - ets:delete(Tab), - {Res, sdev(Res)/X}. - -sdev(List) -> - Len = length(List), - Mean = lists:sum(List)/Len, - math:sqrt(lists:sum([ (X - Mean) * (X - Mean) || X <- List ]) / Len). - -file_keys(_,0,FdList,FnList) -> - [ file:close(FD) || FD <- FdList ], - [ file:delete(FN) || FN <- FnList ], - []; -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 - end. - -%% Check that the distribution of files over async threads is fair -async_dist(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir,Config), - TestFile = filename:join(DataDir, "existing_file"), - 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. + [iter_max_files, proc_zero_sized_files]. %% %% Open as many files as possible. Do this several times and check @@ -114,17 +37,23 @@ async_dist(Config) when is_list(Config) -> %% iter_max_files(Config) when is_list(Config) -> + case os:type() of + {win32, _} -> {skip, "Windows lacks a hard limit on file handles"}; + _ -> iter_max_files_1(Config) + end. + +iter_max_files_1(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 + %% Run on a different node in order to make the test more stable. Dir = filename:dirname(code:which(?MODULE)), {ok,Node} = test_server:start_node(test_iter_max_files,slave, - [{args,"+Q 1524 -pa " ++ Dir}]), + [{args,"-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), + verify_max_files(L), Head = hd(L), if Head >= 2 -> ok; true -> ct:fail(too_few_files) @@ -136,12 +65,15 @@ do_iter_max_files(N, Name) when N > 0 -> do_iter_max_files(_, _) -> []. -all_equal([E, E| T]) -> - all_equal([E| T]); -all_equal([_]) -> - ok; -all_equal([]) -> - ok. +%% The attempts shouldn't vary too much; we used to require that they were all +%% exactly equal, but after we reimplemented the file driver as a NIF we +%% noticed that the only reason it was stable on Darwin was because the port +%% limit was hit before ulimit. +verify_max_files(Attempts) -> + N = length(Attempts), + Mean = lists:sum(Attempts) / N, + Variance = lists:sum([(X - Mean) * (X - Mean) || X <- Attempts]) / N, + true = math:sqrt(Variance) =< 1 + (Mean / 1000). max_files(Name) -> Fds = open_files(Name), @@ -163,3 +95,44 @@ open_files(Name) -> % 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_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_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl index 89e1aefb50..ed444f2599 100644 --- a/erts/emulator/test/erl_link_SUITE.erl +++ b/erts/emulator/test/erl_link_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2016. All Rights Reserved. +%% Copyright Ericsson AB 2001-2018. 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. @@ -53,26 +53,17 @@ -export([test_proc/0]). --define(LINK_UNDEF, 0). --define(LINK_PID, 1). --define(LINK_NODE, 3). - - -% These are to be kept in sync with erl_monitors.h --define(MON_ORIGIN, 1). --define(MON_TARGET, 3). - - --record(erl_link, {type = ?LINK_UNDEF, +-record(erl_link, {type, % process | port | dist_process pid = [], - targets = []}). + id}). % 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, +-record(erl_monitor, {type, % process | port | time_offset | dist_process | resource | node | nodes | suspend + dir, % origin | target + ref, % Reference | [] pid, % Process or nodename - name = []}). % registered name or [] + extra = []}). % registered name, integer or, [] suite() -> @@ -106,7 +97,7 @@ end_per_suite(_Config) -> links(Config) when is_list(Config) -> common_link_test(node(), node()), true = link(self()), - [] = find_erl_link(self(), ?LINK_PID, self()), + [] = find_erl_link(self(), process, self()), true = unlink(self()), ok. @@ -191,6 +182,7 @@ monitor_nodes(Config) when is_list(Config) -> monitor_node(A, false), monitor_node(B, true), monitor_node(C, true), + receive after 1000 -> ok end, monitor_node(C, false), monitor_node(C, true), monitor_node(B, true), @@ -200,13 +192,16 @@ monitor_nodes(Config) when is_list(Config) -> monitor_node(A, true), check_monitor_node(self(), A, 1), check_monitor_node(self(), B, 3), + ok = receive {nodedown, C} -> ok after 1000 -> timeout end, + %%OTP-21: monitor_node(_,false) does not trigger auto-connect anymore + %% and therefore no nodedown if it fails. + %%ok = receive {nodedown, C} -> ok after 1000 -> timeout end, + ok = receive {nodedown, C} -> ok after 1000 -> timeout end, + ok = receive {nodedown, D} -> ok after 1000 -> timeout end, + ok = receive {nodedown, D} -> ok after 1000 -> timeout end, 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), @@ -301,7 +296,8 @@ run_common_process_monitors(TP1, TP2) -> wait_until(fun () -> is_proc_dead(TP2) end), ok = tp_call(TP1, fun () -> receive - {'DOWN',R2,process,TP2O,bye} -> + {'DOWN',R2,process,TP2O,Reason1} -> + bye = Reason1, ok end end), @@ -310,7 +306,8 @@ run_common_process_monitors(TP1, TP2) -> R3 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), ok = tp_call(TP1, fun () -> receive - {'DOWN',R3,process,TP2O,noproc} -> + {'DOWN',R3,process,TP2O,Reason2} -> + noproc = Reason2, ok end end), @@ -533,7 +530,7 @@ freeze_node(Node, MS) -> fun () -> erts_debug:set_internal_state(available_internal_state, true), - dport_send(Freezer, DoingIt), + dctrl_dop_send(Freezer, DoingIt), receive after Own -> ok end, erts_debug:set_internal_state(block, MS+Own) end), @@ -544,20 +541,22 @@ 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) + 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 + 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), @@ -693,22 +692,10 @@ test_proc() -> 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); -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])]; -expand_link_list([#erl_link{targets = []} = Rec | T]) -> - [Rec | expand_link_list(T)]; -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; _ -> [] end. @@ -717,7 +704,7 @@ 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); + LL; _ -> [] end. @@ -771,82 +758,106 @@ get_monitor_list(undefined) -> find_erl_monitor(Pid, Ref) when is_reference(Ref) -> + MonitorList = get_monitor_list(Pid), + io:format("~p MonitorList: ~p~n", [Pid, MonitorList]), lists:foldl(fun (#erl_monitor{ref = R} = EL, Acc) when R == Ref -> [EL|Acc]; (_, Acc) -> Acc end, [], - get_monitor_list(Pid)). - -% find_erl_link(Obj, Ref) when is_reference(Ref) -> -% lists:foldl(fun (#erl_link{ref = R} = EL, Acc) when R == Ref -> -% [EL|Acc]; -% (_, Acc) -> -% Acc -% end, -% [], -% get_link_list(Obj)). - -find_erl_link(Obj, Type, [Item, Data]) when is_pid(Item); - is_port(Item); - is_atom(Item) -> - lists:foldl(fun (#erl_link{type = T, pid = I, targets = D} = EL, + MonitorList); +find_erl_monitor(Pid, Item) -> + MonitorList = get_monitor_list(Pid), + io:format("~p MonitorList: ~p~n", [Pid, MonitorList]), + lists:foldl(fun (#erl_monitor{pid = I} = EL, Acc) when I == Item -> + [EL|Acc]; + (_, Acc) -> + Acc + end, + [], + MonitorList). + + +find_erl_link(Obj, Type, Item) when is_pid(Item); is_port(Item) -> + LinkList = get_link_list(Obj), + io:format("~p LinkList: ~p~n", [Obj, LinkList]), + lists:foldl(fun (#erl_link{type = T, pid = I} = EL, Acc) when T == Type, I == Item -> - case Data of - D -> - [EL|Acc]; - [] -> - [EL|Acc]; - _ -> - Acc - end; + [EL|Acc]; (_, 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, []]). + LinkList); +find_erl_link(Obj, Type, Id) when is_integer(Id) -> + %% Find by Id + LinkList = get_link_list(Obj), + io:format("~p LinkList: ~p~n", [Obj, LinkList]), + lists:foldl(fun (#erl_link{type = T, id = I} = EL, + Acc) when T == Type, I == Id -> + [EL|Acc]; + (_, Acc) -> + Acc + end, + [], + LinkList). +get_link_type(A, B) when is_port(A); + is_port(B) -> + port; +get_link_type(A, B) when is_pid(A), + is_pid(B) -> + case node(A) == node(B) of + true -> + process; + false -> + dist_process + end. +check_link(A, B) when node(A) == node(B) -> + LinkType = get_link_type(A, B), + [#erl_link{type = LinkType, + pid = B, + id = Id}] = find_erl_link(A, LinkType, B), + [#erl_link{type = LinkType, + pid = A, + id = Id}] = find_erl_link(B, LinkType, A), + [] = find_erl_link({node(A), node(B)}, + LinkType, + A), + [] = find_erl_link({node(B), node(A)}, + LinkType, + B), + ok; check_link(A, B) -> - [#erl_link{type = ?LINK_PID, + [#erl_link{type = dist_process, pid = B, - targets = []}] = find_erl_link(A, ?LINK_PID, B), - [#erl_link{type = ?LINK_PID, + id = IdA}] = find_erl_link(A, dist_process, B), + [#erl_link{type = dist_process, 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, + id = IdA}] = find_erl_link({node(A), + node(B)}, + dist_process, + IdA), + [#erl_link{type = dist_process, + pid = A, + id = IdB}] = find_erl_link(B, dist_process, A), + [#erl_link{type = dist_process, + pid = B, + id = IdB}] = find_erl_link({node(B), + node(A)}, + dist_process, + IdB), ok. check_unlink(A, B) -> - [] = 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]]), + LinkType = get_link_type(A, B), + [] = find_erl_link(A, LinkType, B), + [] = find_erl_link(B, LinkType, A), + [] = find_erl_link({node(A), node(B)}, dist_process, A), + [] = find_erl_link({node(B), node(A)}, dist_process, B), ok. check_process_monitor(From, {Name, Node}, Ref) when is_pid(From), @@ -859,22 +870,26 @@ check_process_monitor(From, {Name, Node}, Ref) when is_pid(From), is_atom(Node), is_reference(Ref) -> MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), - [#erl_monitor{type = ?MON_ORIGIN, + [#erl_monitor{type = dist_process, + dir = origin, ref = Ref, pid = Node, - name = Name}] = find_erl_monitor(From, Ref), - [#erl_monitor{type = ?MON_TARGET, + extra = Name}] = find_erl_monitor(From, Ref), + [#erl_monitor{type = dist_process, + dir = target, ref = Ref, pid = From, - name = Name}] = find_erl_monitor({node(From), Node}, Ref), - [#erl_monitor{type = ?MON_ORIGIN, + extra = Name}] = find_erl_monitor({node(From), Node}, Ref), + [#erl_monitor{type = dist_process, + dir = origin, ref = Ref, pid = MonitoredPid, - name = Name}] = find_erl_monitor({Node, node(From)}, Ref), - [#erl_monitor{type = ?MON_TARGET, + extra = Name}] = find_erl_monitor({Node, node(From)}, Ref), + [#erl_monitor{type = dist_process, + dir = target, ref = Ref, pid = From, - name = Name}] = find_erl_monitor(MonitoredPid, Ref), + extra = Name}] = find_erl_monitor(MonitoredPid, Ref), ok; check_process_monitor(From, Name, Ref) when is_pid(From), is_atom(Name), @@ -882,27 +897,36 @@ check_process_monitor(From, Name, Ref) when is_pid(From), is_reference(Ref) -> MonitoredPid = rpc:call(node(From), erlang, whereis, [Name]), - [#erl_monitor{type = ?MON_ORIGIN, + [#erl_monitor{type = process, + dir = origin, ref = Ref, pid = MonitoredPid, - name = Name}] = find_erl_monitor(From, Ref), + extra = Name}] = find_erl_monitor(From, Ref), - [#erl_monitor{type = ?MON_TARGET, + [#erl_monitor{type = process, + dir = target, ref = Ref, pid = From, - name = Name}] = find_erl_monitor(MonitoredPid,Ref), + extra = Name}] = find_erl_monitor(MonitoredPid,Ref), ok; check_process_monitor(From, To, Ref) when is_pid(From), is_pid(To), is_reference(Ref) -> - OriMon = [#erl_monitor{type = ?MON_ORIGIN, + MonType = case node(From) == node(To) of + true -> process; + false -> dist_process + end, + + OriMon = [#erl_monitor{type = MonType, + dir = origin, ref = Ref, pid = To}], OriMon = find_erl_monitor(From, Ref), - TargMon = [#erl_monitor{type = ?MON_TARGET, + TargMon = [#erl_monitor{type = MonType, + dir = target, ref = Ref, pid = From}], TargMon = find_erl_monitor(To, Ref), @@ -910,7 +934,11 @@ check_process_monitor(From, To, Ref) when is_pid(From), case node(From) == node(To) of false -> - TargMon = find_erl_monitor({node(From), node(To)}, Ref), + DistTargMon = [#erl_monitor{type = dist_process, + dir = target, + ref = Ref, + pid = From}], + DistTargMon = 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) @@ -981,19 +1009,36 @@ check_process_demonitor(From, To, Ref) when is_pid(From), ok. no_of_monitor_node(From, Node) when is_pid(From), is_atom(Node) -> - length(find_erl_link(From, ?LINK_NODE, Node)). + case find_erl_monitor(From, Node) of + [] -> 0; + [#erl_monitor{type = node, + dir = origin, + pid = Node, + extra = N}] -> N + end. +check_monitor_node(From, Node, 0) when is_pid(From), + is_atom(Node) -> + [] = find_erl_monitor(From, Node), + [] = find_erl_monitor({node(From), Node}, From); check_monitor_node(From, Node, No) when is_pid(From), 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. - - + No > 0 -> + [#erl_monitor{type = node, + dir = origin, + pid = Node, + extra = No}] = find_erl_monitor(From, Node), + [#erl_monitor{type = node, + dir = target, + pid = From}] = find_erl_monitor({node(From), Node}, From). + +connection_id(Node) -> + try + erts_debug:get_internal_state({connection_id, Node}) + catch + _:_ -> -1 + end. hostname() -> from($@, atom_to_list(node())). @@ -1048,42 +1093,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) end, - erts_debug:get_internal_state({dist_port, Node}). + erts_debug:get_internal_state({dist_ctrl, Node}). dmsg_hdr() -> [131, % Version Magic diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index 23871585f7..6aa7a445b5 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. +%% 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. @@ -23,14 +23,15 @@ -export([all/0, suite/0, test_size/1,flat_size_big/1,df/1,term_type/1, - instructions/1]). + instructions/1, stack_check/1]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 2}}]. all() -> - [test_size, flat_size_big, df, instructions, term_type]. + [test_size, flat_size_big, df, instructions, term_type, + stack_check]. test_size(Config) when is_list(Config) -> ConsCell1 = id([a|b]), @@ -181,6 +182,15 @@ df(Config) when is_list(Config) -> 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), diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl index 3ce849b88e..c9c1867049 100644 --- a/erts/emulator/test/estone_SUITE.erl +++ b/erts/emulator/test/estone_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2016. All Rights Reserved. +%% Copyright Ericsson AB 2002-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. @@ -20,7 +20,7 @@ -module(estone_SUITE). %% Test functions -export([all/0, suite/0, groups/0, - estone/1, estone_bench/1]). + estone/1, estone_bench/1, pgo/0]). %% Internal exports for EStone tests -export([lists/1, @@ -44,9 +44,9 @@ links/1,lproc/1, run_micro/3,p1/1,ppp/3,macro/2,micros/0]). - --include_lib("common_test/include/ct.hrl"). +-ifndef(PGO). -include_lib("common_test/include/ct_event.hrl"). +-endif. %% EStone defines -define(TOTAL, (3000 * 1000 * 100)). %% 300 secs @@ -85,13 +85,28 @@ estone(Config) when is_list(Config) -> estone_bench(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 @@ -364,7 +379,7 @@ monotonic_time() -> try erlang:monotonic_time() catch error:undef -> erlang:now() end. subtr(Before, After) when is_integer(Before), is_integer(After) -> - erlang:convert_time_unit(After-Before, native, microsecond); + erlang:convert_time_unit(After-Before, native, 1000000); subtr({_,_,_}=Before, {_,_,_}=After) -> timer:now_diff(After, Before). @@ -708,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) -> diff --git a/erts/emulator/test/evil_SUITE.erl b/erts/emulator/test/evil_SUITE.erl index 9416ac7a02..fc4ac037ac 100644 --- a/erts/emulator/test/evil_SUITE.erl +++ b/erts/emulator/test/evil_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2016. All Rights Reserved. +%% Copyright Ericsson AB 2002-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. @@ -34,7 +34,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 30}}]. + {timetrap, {minutes, 1}}]. all() -> [heap_frag, encode_decode_ext, decode_integer_ext, diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index 76e3556bc4..aec66cb9a3 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -21,9 +21,10 @@ -module(exception_SUITE). -export([all/0, suite/0, - badmatch/1, pending_errors/1, nil_arith/1, + 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, backtrace_depth/1, + line_numbers/1]). -export([bad_guy/2]). -export([crash/1]). @@ -31,14 +32,18 @@ -include_lib("common_test/include/ct.hrl"). -import(lists, [foreach/2]). +%% 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, {seconds, 10}}]. + {timetrap, {minutes, 1}}]. all() -> - [badmatch, pending_errors, nil_arith, stacktrace, - nested_stacktrace, raise, gunilla, per, - exception_with_heap_frag, line_numbers]. + [badmatch, pending_errors, nil_arith, top_of_stacktrace, + stacktrace, nested_stacktrace, raise, gunilla, per, + exception_with_heap_frag, backtrace_depth, line_numbers]. -define(try_match(E), catch ?MODULE:bar(), @@ -241,7 +246,54 @@ 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(), @@ -253,9 +305,9 @@ stacktrace(Conf) when is_list(Conf) -> St1 = erase(stacktrace1), St1 = erase(stacktrace2), St1 = erlang:get_stacktrace(), - {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = + {caught2,{error,badarith},[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]=St2} = stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), - [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), + [{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} = @@ -308,13 +360,13 @@ nested_stacktrace(Conf) when is_list(Conf) -> nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, {void,void,void}), {caught1, - [{?MODULE,my_add,2,_}|_], + [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_], value2, - [{?MODULE,my_add,2,_}|_]} = + [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_]} = nested_stacktrace_1({{'add',{V,x1}},error,badarith}, {{value,{V,x2}},void,{V,x2}}), {caught1, - [{?MODULE,my_add,2,_}|_], + [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_], {caught2,[{erlang,abs,[V],_}|_]}, [{erlang,abs,[V],_}|_]} = nested_stacktrace_1({{'add',{V,x1}},error,badarith}, @@ -344,18 +396,18 @@ raise(Conf) when is_list(Conf) -> try try foo({'div',{1,0}}) catch - error:badarith -> + error:badarith:A0 -> put(raise, A0 = erlang:get_stacktrace()), erlang:raise(error, badarith, A0) end catch - error:badarith -> + error:badarith:A1 -> A1 = erlang:get_stacktrace(), A1 = get(raise) end, A = erlang:get_stacktrace(), A = get(raise), - [{?MODULE,my_div,2,_}|_] = A, + [{erlang,'div',[1, 0], _},{?MODULE,my_div,2,_}|_] = A, %% N = 8, % Must be even N = erlang:system_flag(backtrace_depth, N), @@ -404,11 +456,20 @@ 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_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_add(A, B) -> - A + B. +my_element(A, B) -> element(A, B). my_abs(X) -> abs(X). @@ -512,6 +573,57 @@ do_exception_with_heap_frag(Bin, [Sz|Sizes]) -> do_exception_with_heap_frag(Bin, Sizes); do_exception_with_heap_frag(_, []) -> ok. +backtrace_depth(Config) when is_list(Config) -> + _ = [do_backtrace_depth(D) || D <- lists:seq(0, 8)], + ok. + +do_backtrace_depth(D) -> + Old = erlang:system_flag(backtrace_depth, D), + try + Expected = max(1, D), + do_backtrace_depth_1(Expected) + after + _ = erlang:system_flag(backtrace_depth, Old) + end. + +do_backtrace_depth_1(D) -> + Exit = fun() -> + error(reason) + end, + HandCrafted = fun() -> + {'EXIT',{_,Stk0}} = (catch error(get_stacktrace)), + %% Fool the compiler to force a hand-crafted + %% stacktrace. + Stk = [hd(Stk0)|tl(Stk0)], + erlang:raise(error, reason, Stk) + end, + PassedOn = fun() -> + try error(get_stacktrace) + catch error:_:Stk -> + %% Just pass on the given stacktrace. + erlang:raise(error, reason, Stk) + end + end, + do_backtrace_depth_2(D, Exit), + do_backtrace_depth_2(D, HandCrafted), + do_backtrace_depth_2(D, PassedOn), + ok. + +do_backtrace_depth_2(D, Exc) -> + try + Exc() + catch + error:reason:Stk -> + if + length(Stk) =/= D -> + io:format("Expected depth: ~p\n", [D]), + io:format("~p\n", [Stk]), + error(bad_depth); + true -> + ok + end + end. + line_numbers(Config) when is_list(Config) -> {'EXIT',{{case_clause,bad_tag}, [{?MODULE,line1,2, @@ -606,6 +718,15 @@ line_numbers(Config) when is_list(Config) -> {?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. id(I) -> I. @@ -706,3 +827,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 36b1f9179f..4098aa9c6a 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% 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. @@ -208,7 +208,7 @@ 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 diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index 26fa955e3c..73fe9b0d8f 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -19,12 +19,12 @@ %% -module(fun_SUITE). --compile({nowarn_deprecated_function, {erlang,hash,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_mfa/1]). @@ -38,9 +38,10 @@ suite() -> {timetrap, {minutes, 1}}]. -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, t_fun_info_mfa]. @@ -108,6 +109,18 @@ bad_call_fc(Fun) -> 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) -> @@ -412,33 +425,6 @@ build_io_list(N) -> 1 -> [7,L|L] end. -%% Test the hash/2 BIF on funs. -t_hash(Config) when is_list(Config) -> - F1 = fun(_X) -> 1 end, - F2 = fun(_X) -> 2 end, - true = hash(F1) /= hash(F2), - - G1 = make_fun(1, 2, 3), - G2 = make_fun(1, 2, 3), - G3 = make_fun(1, 2, 4), - true = hash(G1) == hash(G2), - 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, - true = hash(FF0) =/= hash(FF1), - true = hash(FF0) =/= hash(FF2), - true = hash(FF0) =/= hash(FF3), - true = hash(FF1) =/= hash(FF2), - true = hash(FF1) =/= hash(FF3), - true = hash(FF2) =/= hash(FF3), - ok. - -hash(Term) -> - erlang:hash(Term, 16#7ffffff). - %% Test the phash/2 BIF on funs. t_phash(Config) when is_list(Config) -> F1 = fun(_X) -> 1 end, @@ -461,7 +447,6 @@ t_phash(Config) when is_list(Config) -> true = phash(FF1) =/= phash(FF2), true = phash(FF1) =/= phash(FF3), true = phash(FF2) =/= phash(FF3), - ok. phash(Term) -> diff --git a/erts/emulator/test/fun_r13_SUITE.erl b/erts/emulator/test/fun_r13_SUITE.erl deleted file mode 100644 index a45ed08b9d..0000000000 --- a/erts/emulator/test/fun_r13_SUITE.erl +++ /dev/null @@ -1,74 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-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(fun_r13_SUITE). --compile(r13). - --export([all/0, suite/0, - dist_old_release/1]). - --include_lib("common_test/include/ct.hrl"). - -suite() -> - [{ct_hooks,[ts_install_cth]}, - {timetrap, {minutes, 1}}]. - -all() -> - [dist_old_release]. - -dist_old_release(Config) when is_list(Config) -> - case test_server:is_release_available("r12b") of - true -> do_dist_old(Config); - false -> {skip,"No R12B found"} - end. - -do_dist_old(Config) when is_list(Config) -> - Pa = filename:dirname(code:which(?MODULE)), - Name = fun_dist_r12, - {ok,Node} = test_server:start_node(Name, peer, - [{args,"-pa "++Pa}, - {erl,[{release,"r12b"}]}]), - - 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, - Pid ! Fun, - receive - {ok,Fun,R12BFun} -> - [a,b,c] = R12BFun(a); - Other -> - ct:fail({bad_message,Other}) - end, - true = test_server:stop_node(Node), - ok. - -cons(H, T) -> - [H|T]. diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl index 8a600b7d9f..f3942ef416 100644 --- a/erts/emulator/test/gc_SUITE.erl +++ b/erts/emulator/test/gc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% 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. @@ -23,15 +23,26 @@ -module(gc_SUITE). -include_lib("common_test/include/ct.hrl"). +-include_lib("eunit/include/eunit.hrl"). + -export([all/0, suite/0]). --export([grow_heap/1, grow_stack/1, grow_stack_heap/1, max_heap_size/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]}]. all() -> - [grow_heap, grow_stack, grow_stack_heap, max_heap_size]. + [grow_heap, grow_stack, grow_stack_heap, max_heap_size, + minor_major_gc_option_self, + minor_major_gc_option_async]. %% Produce a growing list of elements, @@ -190,3 +201,92 @@ long_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 e155e5f49f..f2c1595392 100644 --- a/erts/emulator/test/guard_SUITE.erl +++ b/erts/emulator/test/guard_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% 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. @@ -317,6 +317,7 @@ guard_bifs(Config) when is_list(Config) -> 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), try_gbif('length/1', [a], 1), @@ -499,7 +500,7 @@ all_types() -> {atom, xxxx}, {ref, make_ref()}, {pid, self()}, - {port, open_port({spawn, efile}, [])}, + {port, make_port()}, {function, fun(_) -> "" end}, {function, fun erlang:abs/1}, {binary, list_to_binary([])}, @@ -550,4 +551,7 @@ type_test(bitstring, X) when is_bitstring(X) -> type_test(function, X) when is_function(X) -> function. +make_port() -> + hd(erlang:ports()). + id(I) -> I. diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index a39d101b0d..3cbb3c7d5f 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -34,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 @@ -130,24 +129,12 @@ test_hash_zero(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, @@ -166,11 +153,9 @@ 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. @@ -193,7 +178,6 @@ range_test() -> end, F(1,16#100000000,F). - spread_test(N) -> test_fun(N,{erlang,phash},16#50000000000,fun(X) -> @@ -419,7 +403,7 @@ phash2_test() -> {"abc"++[1009], 290369864}, {"abc"++[1009]++"de", 4134369195}, {"1234567890123456", 963649519}, - + %% tuple {{}, 221703996}, {{{}}, 2165044361}, @@ -452,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 @@ -496,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), @@ -535,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) -> @@ -555,7 +520,6 @@ hash_zero_test() -> 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(Zs,fun(T) -> erlang:hash(T, (1 bsl 27) - 1) end), ok. hash_zero_test([Z|Zs],F) -> diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl index 6f8ce02266..a20f306e04 100644 --- a/erts/emulator/test/hibernate_SUITE.erl +++ b/erts/emulator/test/hibernate_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. +%% Copyright Ericsson AB 2003-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. @@ -349,7 +349,7 @@ 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(Config) when is_list(Config) -> diff --git a/erts/emulator/test/hipe_SUITE.erl b/erts/emulator/test/hipe_SUITE.erl index a556b4ddc0..e62d4260f6 100644 --- a/erts/emulator/test/hipe_SUITE.erl +++ b/erts/emulator/test/hipe_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2016. All Rights Reserved. +%% 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. @@ -19,12 +19,19 @@ %% -module(hipe_SUITE). --export([all/0, t_copy_literals/1]). +-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_copy_literals + ,t_purge + ,t_trycatch + ] end. t_copy_literals(doc) -> @@ -65,3 +72,117 @@ t_copy_literals(Config) when is_list(Config) -> 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/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/iovec_SUITE.erl b/erts/emulator/test/iovec_SUITE.erl new file mode 100644 index 0000000000..d17a28d47f --- /dev/null +++ b/erts/emulator/test/iovec_SUITE.erl @@ -0,0 +1,188 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2018. 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, unaligned_sub_binaries/1, + direct_binary_arg/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, + unaligned_sub_binaries, direct_binary_arg]. + +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], ["gaffel" | <<1:1>>]], + + 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)]), + + Variations = gen_variations([IntBase, BinBase, MixBase], 16), + 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. + +unaligned_sub_binaries(Config) when is_list(Config) -> + UnalignedBins = [gen_unaligned_binary(I) || I <- lists:seq(32, 4 bsl 10, 512)], + UnalignedVariations = gen_variations(UnalignedBins), + + Optimized = erlang:iolist_to_iovec(UnalignedVariations), + + true = is_iolist_equal(Optimized, UnalignedVariations), + ok. + +direct_binary_arg(Config) when is_list(Config) -> + {'EXIT',{badarg, _}} = (catch erlang:iolist_to_iovec(<<1:1>>)), + [<<1>>] = erlang:iolist_to_iovec(<<1>>), + [] = erlang:iolist_to_iovec(<<>>), + 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). + +gen_unaligned_binary(Size) -> + Bin0 = << <<I>> || I <- lists:seq(1, Size) >>, + <<0:3,Bin:Size/binary,31:5>> = id(<<0:3,Bin0/binary,31:5>>), + Bin. + +id(I) -> I. + +%% 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, 12). +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]]). diff --git a/erts/emulator/test/lcnt_SUITE.erl b/erts/emulator/test/lcnt_SUITE.erl new file mode 100644 index 0000000000..87b97037d6 --- /dev/null +++ b/erts/emulator/test/lcnt_SUITE.erl @@ -0,0 +1,191 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2018. 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, + registered_processes/1, registered_db_tables/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. + +all() -> + [toggle_lock_counting, error_on_invalid_category, preserve_locks, + registered_processes, registered_db_tables]. + +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(), + [{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(), + case remove_untoggleable_locks(Locks) of + [] -> + 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(), + remove_untoggleable_locks(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. + +registered_processes(Config) when is_list(Config) -> + %% There ought to be at least one registered process (init/code_server) + erts_debug:lcnt_control(mask, [process]), + [_, {locks, ProcLocks}] = erts_debug:lcnt_collect(), + true = lists:any( + fun + ({proc_main, RegName, _, _}) when is_atom(RegName) -> true; + (_Lock) -> false + end, ProcLocks), + ok. + +registered_db_tables(Config) when is_list(Config) -> + %% There ought to be at least one registered table (code) + erts_debug:lcnt_control(mask, [db]), + [_, {locks, DbLocks}] = erts_debug:lcnt_collect(), + true = lists:any( + fun + ({db_tab, RegName, _, _}) when is_atom(RegName) -> true; + (_Lock) -> false + end, DbLocks), + ok. + +%% Not all locks can be toggled on or off due to technical limitations, so we +%% need to filter them out when checking whether we successfully disabled lock +%% counting. +remove_untoggleable_locks([]) -> + []; +remove_untoggleable_locks([{resource_monitors, _, _, _} | T]) -> + remove_untoggleable_locks(T); +remove_untoggleable_locks([H | T]) -> + [H | remove_untoggleable_locks(T)]. diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl index 514dd2f412..f95251943d 100644 --- a/erts/emulator/test/list_bif_SUITE.erl +++ b/erts/emulator/test/list_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% 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. @@ -23,7 +23,7 @@ -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() -> @@ -32,7 +32,7 @@ suite() -> 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]. %% Tests list_to_integer and string:to_integer @@ -47,9 +47,9 @@ t_list_to_integer(Config) when is_list(Config) -> {12373281903728109372810937209817320981321,"ABC"} = string:to_integer("12373281903728109372810937209817320981321ABC"), {-12373281903728109372810937209817320981321,"ABC"} = string:to_integer("-12373281903728109372810937209817320981321ABC"), {12,[345]} = string:to_integer([$1,$2,345]), - {12,[a]} = string:to_integer([$1,$2,a]), + {error, badarg} = string:to_integer([$1,$2,a]), {error,no_integer} = string:to_integer([$A]), - {error,not_a_list} = string:to_integer($A), + {error,badarg} = string:to_integer($A), ok. %% Test hd/1 with correct and incorrect arguments. @@ -106,10 +106,25 @@ t_list_to_pid(Config) when is_list(Config) -> {'EXIT', {badarg, _}} -> ok; Res -> - ct:fail("list_to_pid/1 with incorrect arg succeeded.~nResult: ~p", [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. diff --git a/erts/emulator/test/long_timers_test.erl b/erts/emulator/test/long_timers_test.erl index c9a380a229..de1a6e6d32 100644 --- a/erts/emulator/test/long_timers_test.erl +++ b/erts/emulator/test/long_timers_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-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. @@ -175,7 +175,7 @@ had_high_cpu_util(StartTime, ActTo = TargetTo + TimeoutDiff, hcpu(ActTo, TargetTo, UtilData). -hcpu(_ActTo, _TargetTo, [{UT, 0} | _] = UD) -> +hcpu(_ActTo, _TargetTo, [{_UT, 0} | _]) -> missing; %% Util is the integer zero when not supported... %% UT2 =:= UT1 hcpu(ActTo, TargetTo, [{UT, _}, {UT, _} | _] = UD) -> diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl index 6b7ad836f5..19c3844c40 100644 --- a/erts/emulator/test/lttng_SUITE.erl +++ b/erts/emulator/test/lttng_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% 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. @@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 10}}]. + {timetrap, {minutes, 1}}]. all() -> [t_lttng_list, @@ -81,7 +81,6 @@ end_per_testcase(Case, _Config) -> %% Not tested yet %% org_erlang_otp:driver_process_exit -%% org_erlang_otp:driver_event %% tracepoints %% @@ -100,7 +99,6 @@ end_per_testcase(Case, _Config) -> %% org_erlang_otp:driver_flush %% org_erlang_otp:driver_stop_select %% org_erlang_otp:driver_timeout -%% org_erlang_otp:driver_event %% org_erlang_otp:driver_ready_output %% org_erlang_otp:driver_ready_input %% org_erlang_otp:driver_output @@ -431,7 +429,6 @@ txt() -> "%% org_erlang_otp:driver_flush\n" "%% org_erlang_otp:driver_stop_select\n" "%% org_erlang_otp:driver_timeout\n" - "%% org_erlang_otp:driver_event\n" "%% org_erlang_otp:driver_ready_output\n" "%% org_erlang_otp:driver_ready_input\n" "%% org_erlang_otp:driver_output\n" diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 5af676c409..d0a6763fe5 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -18,7 +18,6 @@ %% -module(map_SUITE). -export([all/0, suite/0]). --compile({nowarn_deprecated_function, {erlang,hash,2}}). -export([t_build_and_match_literals/1, t_build_and_match_literals_large/1, t_update_literals/1, t_update_literals_large/1, @@ -37,7 +36,9 @@ t_map_equal/1, t_map_compare/1, t_map_size/1, + t_map_get/1, t_is_map/1, + t_is_map_key/1, %% Specific Map BIFs t_bif_map_get/1, @@ -53,6 +54,7 @@ t_bif_map_values/1, t_bif_map_to_list/1, t_bif_map_from_list/1, + t_bif_map_next/1, %% erlang t_erlang_hash/1, @@ -119,11 +121,12 @@ all() -> [t_build_and_match_literals, t_build_and_match_literals_large, t_bif_map_update, t_bif_map_values, t_bif_map_to_list, t_bif_map_from_list, + t_bif_map_next, %% erlang t_erlang_hash, t_map_encode_decode, t_gc_rare_map_overflow, - t_map_size, t_is_map, + t_map_size, t_map_get, t_is_map, %% non specific BIF related t_bif_build_and_check, @@ -679,6 +682,88 @@ t_map_size(Config) when is_list(Config) -> end), ok. +t_map_get(Config) when is_list(Config) -> + %% small map + 1 = map_get(a, id(#{a=>1})), + 2 = map_get(b, id(#{a=>1, b=>2})), + "hi" = map_get("hello", id(#{a=>1, "hello"=>"hi"})), + "tuple hi" = map_get({1,1.0}, id(#{a=>a, {1,1.0}=>"tuple hi"})), + + M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + "v4" = map_get(<<"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"}]), + 1 = map_get(a, M1), + 2 = map_get(b, M1), + "hi" = map_get("hello", M1), + "tuple hi" = map_get({1,1.0}, M1), + "v3" = map_get(<<"k2">>, M1), + + %% error cases + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{erlang,map_get,_,_}|_]}} = + (catch map_get(a, T)) + end), + + {'EXIT',{{badkey,{1,1}},[{erlang,map_get,_,_}|_]}} = + (catch map_get({1,1}, id(#{{1,1.0}=>"tuple"}))), + {'EXIT',{{badkey,a},[{erlang,map_get,_,_}|_]}} = (catch map_get(a, id(#{}))), + {'EXIT',{{badkey,a},[{erlang,map_get,_,_}|_]}} = + (catch map_get(a, id(#{b=>1, c=>2}))), + + %% in guards + M2 = id(#{a=>1}), + true = if map_get(a, M2) =:= 1 -> true; true -> false end, + false = if map_get(x, M2) =:= 1 -> true; true -> false end, + do_badmap(fun + (T) when map_get(x, T) =:= 1 -> ok; + (T) -> false = is_map(T) + end), + ok. + +t_is_map_key(Config) when is_list(Config) -> + %% small map + true = is_map_key(a, id(#{a=>1})), + true = is_map_key(b, id(#{a=>1, b=>2})), + true = is_map_key("hello", id(#{a=>1, "hello"=>"hi"})), + true = is_map_key({1,1.0}, id(#{a=>a, {1,1.0}=>"tuple hi"})), + + M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + true = is_map_key(<<"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"}]), + true = is_map_key(a, M1), + true = is_map_key(b, M1), + true = is_map_key("hello", M1), + true = is_map_key({1,1.0}, M1), + true = is_map_key(<<"k2">>, M1), + + %% error cases + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{erlang,is_map_key,_,_}|_]}} = + (catch is_map_key(a, T)) + end), + + false = is_map_key({1,1}, id(#{{1,1.0}=>"tuple"})), + false = is_map_key(a, id(#{})), + false = is_map_key(a, id(#{b=>1, c=>2})), + + %% in guards + M2 = id(#{a=>1}), + true = if is_map_key(a, M2) -> true; true -> false end, + false = if is_map_key(x, M2) -> true; true -> false end, + do_badmap(fun + (T) when is_map_key(T, x) =:= 1 -> ok; + (T) -> false = is_map(T) + end), + ok. + build_and_check_size([K|Ks],N,M0) -> N = map_size(M0), M1 = M0#{ K => K }, @@ -2130,8 +2215,6 @@ 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() -> @@ -2174,27 +2257,6 @@ t_bif_erlang_phash() -> 2620391445 = erlang:phash(M2,Sz), % 3590546636 ok. -t_bif_erlang_hash() -> - Sz = 1 bsl 27 - 1, - 39684169 = erlang:hash(#{},Sz), % 5158 - 33673142 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 71555838 - 95337869 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 5497225 - 108959561 = erlang:hash(#{ 1 => a },Sz), % 126071654 - 59623150 = erlang:hash(#{ a => 1 },Sz), % 126426236 - - 42775386 = erlang:hash(#{{} => <<>>},Sz), % 101655720 - 71692856 = erlang:hash(#{<<>> => {}},Sz), % 101655720 - - M0 = #{ a => 1, "key" => <<"value">> }, - M1 = maps:remove("key",M0), - M2 = M1#{ "key" => <<"value">> }, - - 70254632 = erlang:hash(M0,Sz), % 38260486 - 59623150 = erlang:hash(M1,Sz), % 126426236 - 70254632 = erlang:hash(M2,Sz), % 38260486 - ok. - - t_map_encode_decode(Config) when is_list(Config) -> <<131,116,0,0,0,0>> = erlang:term_to_binary(#{}), Pairs = [ @@ -2386,23 +2448,85 @@ t_bif_map_from_list(Config) when is_list(Config) -> {'EXIT', {badarg,_}} = (catch maps:from_list(id(42))), 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 - ]), +t_bif_map_next(Config) when is_list(Config) -> + + erts_debug:set_internal_state(available_internal_state, true), + + try + + none = maps:next(maps:iterator(id(#{}))), + + verify_iterator(#{}), + verify_iterator(#{a => 1, b => 2, c => 3}), + + %% Use fatmap in order to test iterating in very deep maps + FM = fatmap(43), + verify_iterator(FM), + + {'EXIT', {{badmap,[{a,b},b]},_}} = (catch maps:iterator(id([{a,b},b]))), + {'EXIT', {badarg,_}} = (catch maps:next(id(a))), + {'EXIT', {badarg,_}} = (catch maps:next(id([a|FM]))), + {'EXIT', {badarg,_}} = (catch maps:next(id([1|#{}]))), + {'EXIT', {badarg,_}} = (catch maps:next(id([-1|#{}]))), + {'EXIT', {badarg,_}} = (catch maps:next(id([-1|FM]))), + {'EXIT', {badarg,_}} = (catch maps:next(id([16#FFFFFFFFFFFFFFFF|FM]))), + {'EXIT', {badarg,_}} = (catch maps:next(id([-16#FFFFFFFFFFFFFFFF|FM]))), + + %% This us a whitebox test that the error code works correctly. + %% It uses a path for a tree of depth 4 and tries to do next on + %% each of those paths. + (fun F(0) -> ok; + F(N) -> + try maps:next([N|FM]) of + none -> + F(N-1); + {_K,_V,_I} -> + F(N-1) + catch error:badarg -> + F(N-1) + end + end)(16#FFFF), + + ok + after + erts_debug:set_internal_state(available_internal_state, false) + end. +verify_iterator(Map) -> + KVs = t_fold(fun(K, V, A) -> [{K, V} | A] end, [], Map), + + %% Verify that KVs created by iterating Map is of + %% correct size and contains all elements + true = length(KVs) == maps:size(Map), + [maps:get(K, Map) || {K, _} <- KVs], + ok. + + +t_fold(Fun, Init, Map) -> + t_fold_1(Fun, Init, maps:iterator(Map)). + +t_fold_1(Fun, Acc, Iter) -> + case maps:next(Iter) of + {K, V, NextIter} -> + t_fold_1(Fun, Fun(K,V,Acc), NextIter); + none -> + Acc + end. + +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; @@ -2956,8 +3080,19 @@ y_regs(Config) when is_list(Config) -> true = is_map(Map2) andalso is_map(Map4), + gurka = y_regs_literal(0), + gaffel = y_regs_literal(1), + ok. +y_regs_literal(Key) when is_integer(Key) -> + %% Forces the key to be placed in a Y register. + lists:seq(1, 2), + case is_map_key(Key, #{ 0 => 0 }) of + true -> gurka; + false -> gaffel + end. + y_regs_update(Map0, Val0) -> Val1 = {t,Val0}, K1 = id({key,1}), diff --git a/erts/emulator/test/map_SUITE_data/badmap_17.beam b/erts/emulator/test/map_SUITE_data/badmap_17.beam Binary files differindex 277fc34b94..6f79bb8c2c 100644 --- a/erts/emulator/test/map_SUITE_data/badmap_17.beam +++ 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 index 0ec65e0e33..887fc2e5e3 100644 --- a/erts/emulator/test/map_SUITE_data/badmap_17.erl +++ b/erts/emulator/test/map_SUITE_data/badmap_17.erl @@ -1,7 +1,7 @@ -module(badmap_17). -export([update/1]). -%% Compile this source file with OTP 17. +%% Compile this source file with OTP 17.0. update(Map) -> try @@ -17,10 +17,42 @@ update(Map) -> catch error:{badmap,Map} -> ok - end. + 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 6733237b20..21de6b1002 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -21,7 +21,7 @@ -module(match_spec_SUITE). -export([all/0, suite/0, not_run/1]). --export([test_1/1, test_2/1, test_3/1, bad_match_spec_bin/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, ms_trace_dead/1, boxed_and_small/1, destructive_in_test_bif/1, guard_exceptions/1, @@ -42,12 +42,12 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 30}}]. + {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, ms_trace_dead, boxed_and_small, destructive_in_test_bif, guard_exceptions, unary_plus, unary_minus, fpe, @@ -180,6 +180,50 @@ test_3(Config) when is_list(Config) -> 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(Config) when is_list(Config) -> Laps = 10000, Fun1 = fun() -> otp_9422_tracee() end, @@ -427,13 +471,13 @@ silent_no_ms(Config) when is_list(Config) -> %% [{trace,Tracee,call,{?MODULE,f1,[start]}}, {trace,Tracee,return_to, - {?MODULE,'-silent_no_ms/1-fun-2-',0}}, + {?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-2-',0}}, + {?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-2-',0}}, + {?MODULE,'-silent_no_ms/1-fun-3-',0}}, {trace,Tracee,call,{?MODULE,f2,[h,i]}}, {trace,Tracee,return_to,{?MODULE,f3,2}}] end). @@ -484,7 +528,7 @@ ms_trace2(Config) when is_list(Config) -> %% %% Expected: (no return_to for global call trace) %% - Origin = {match_spec_SUITE,'-ms_trace2/1-fun-0-',1}, + Origin = {match_spec_SUITE,'-ms_trace2/1-fun-1-',1}, [{trace_ts,Tracee,call, {?MODULE,fn, [[all],[call,return_to,{tracer,Tracer}]]}, @@ -574,7 +618,7 @@ ms_trace3(Config) when is_list(Config) -> %% %% Expected: (no return_to for global call trace) %% - Origin = {match_spec_SUITE,'-ms_trace3/1-fun-1-',2}, + Origin = {match_spec_SUITE,'-ms_trace3/1-fun-2-',2}, [{trace_ts,Controller,call, {?MODULE,fn,[TraceeName,[all], [call,return_to,send,'receive', @@ -646,7 +690,7 @@ destructive_in_test_bif(Config) when is_list(Config) -> ([],[{'_',[],[{message,{get_tcw}}]}],trace), ok. -%% Test that the comparision between boxed and small does not crash emulator +%% Test that the comparison between boxed and small does not crash emulator boxed_and_small(Config) when is_list(Config) -> {ok, Node} = start_node(match_spec_suite_other), ok = rpc:call(Node,?MODULE,do_boxed_and_small,[]), @@ -841,6 +885,26 @@ maps(Config) when is_list(Config) -> erlang:match_spec_test(#{<<"b">> =>"camembert","c"=>"cabécou", "wat"=>"hi", b=><<"other">>}, [{#{<<"b">> => '$1',"wat" => '$2'},[],[#{a=>'$1',b=>'$2'}]}], table), + + {ok,1,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{map_size,'$1'}]}],table), + {ok,'EXIT',[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[],[{map_size,'$1'}]}], table), + {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{map_size,'$1'}],['$_']}], table), + {ok,true,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[{'=:=',{map_size,'$1'},1}],[true]}], table), + + {ok,1,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{map_get,a,'$1'}]}], table), + {ok,'EXIT',[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{map_get,b,'$1'}]}], table), + {ok,'EXIT',[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[],[{map_get,b,'$1'}]}], table), + {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[{map_get,b,'$1'}],['$_']}], table), + {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{map_get,b,'$1'}],['$_']}], table), + {ok,true,[],[]} = erlang:match_spec_test(#{a => true}, [{'$1',[{map_get,a,'$1'}],[true]}], table), + + {ok,true,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{is_map_key,a,'$1'}]}], table), + {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{is_map_key,b,'$1'}]}], table), + {ok,'EXIT',[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[],[{is_map_key,a,'$1'}]}], table), + {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[{is_map_key,b,'$1'}],['$_']}], table), + {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{is_map_key,b,'$1'}],['$_']}], table), + {ok,true,[],[]} = erlang:match_spec_test(#{a => true}, [{'$1',[{is_map_key,a,'$1'}],[true]}], table), + %% large maps Ls0 = [{I,<<I:32>>}||I <- lists:seq(1,415)], diff --git a/erts/emulator/test/message_queue_data_SUITE.erl b/erts/emulator/test/message_queue_data_SUITE.erl index e084b9482d..7f0cbdd885 100644 --- a/erts/emulator/test/message_queue_data_SUITE.erl +++ b/erts/emulator/test/message_queue_data_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014-2016. All Rights Reserved. +%% 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. @@ -169,7 +169,7 @@ 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}]), + 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, @@ -178,7 +178,7 @@ total_heap_size(_Config) -> 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}]), + 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, @@ -192,8 +192,6 @@ total_heap_size(_Config) -> %% %% -start_node(Config) -> - start_node(Config, []). 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) diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl index ba9b564fdc..93f9de0c28 100644 --- a/erts/emulator/test/module_info_SUITE.erl +++ b/erts/emulator/test/module_info_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. +%% Copyright Ericsson AB 2005-2018. 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. @@ -23,7 +23,7 @@ -include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0, - exports/1,functions/1,deleted/1,native/1,info/1]). + exports/1,functions/1,deleted/1,native/1,info/1,nifs/1]). %%-compile(native). @@ -38,7 +38,7 @@ all() -> modules(). modules() -> - [exports, functions, deleted, native, info]. + [exports, functions, deleted, native, info, nifs]. %% Should return all functions exported from this module. (local) all_exported() -> @@ -62,12 +62,24 @@ exports(Config) when is_list(Config) -> All = lists:sort(?MODULE:module_info(exports)), ok. -%% Test that the list of exported functions from this module is correct. +%% Test that the list of local and exported functions from this module is +%% correct. functions(Config) when is_list(Config) -> All = all_functions(), All = lists:sort(?MODULE:module_info(functions)), ok. +nifs(Config) when is_list(Config) -> + [] = ?MODULE:module_info(nifs), + + %% erl_tracer is guaranteed to be present and contain these NIFs + TraceNIFs = erl_tracer:module_info(nifs), + true = lists:member({enabled, 3}, TraceNIFs), + true = lists:member({trace, 5}, TraceNIFs), + 2 = length(TraceNIFs), + + ok. + %% Test that deleted modules cause badarg deleted(Config) when is_list(Config) -> Data = proplists:get_value(data_dir, Config), diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl index 827ed817cc..27351dc5c1 100644 --- a/erts/emulator/test/monitor_SUITE.erl +++ b/erts/emulator/test/monitor_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -86,7 +86,7 @@ case_2(Config) when is_list(Config) -> R = erlang:monitor(process, B), B ! R, receive - {'EXIT', _} -> ok; + true -> ok; Other -> ct:fail({rec, Other}) end, @@ -98,7 +98,7 @@ case_2a(Config) when is_list(Config) -> {B,R} = spawn_monitor(?MODULE, y2, [self()]), B ! R, receive - {'EXIT', _} -> ok; + true -> ok; Other -> ct:fail({rec, Other}) end, @@ -182,7 +182,7 @@ demon_e_1(Config) when is_list(Config) -> end ), receive {P2, ref, R2} -> - demon_error(R2, badarg), + true = erlang:demonitor(R2), P2 ! {self(), stop}; Other2 -> ct:fail({rec, Other2}) @@ -314,7 +314,7 @@ local_remove_monitor(Config) when is_list(Config) -> remote_remove_monitor(Config) when is_list(Config) -> {ok, N} = test_server:start_node(demonitor_flush, slave, []), - Gs = generate(fun () -> start_remove_monitor_group(node()) end, + Gs = generate(fun () -> start_remove_monitor_group(N) end, ?RM_MON_GROUPS), {True, False} = lists:foldl(fun (G, {T, F}) -> receive @@ -729,8 +729,8 @@ named_down(Config) when is_list(Config) -> end), ?assertEqual(true, register(Name, NamedProc)), unlink(NamedProc), - exit(NamedProc, bang), Mon = erlang:monitor(process, Name), + exit(NamedProc, bang), receive {'DOWN',Mon, _, _, bang} -> ok after 3000 -> ?assert(false) end, ?assertEqual(true, register(Name, self())), @@ -974,9 +974,6 @@ generate(_Fun, 0) -> generate(Fun, N) -> [Fun() | generate(Fun, N-1)]. -start_node(Config) -> - start_node(Config, ""). - start_node(Config, Args) -> TestCase = proplists:get_value(testcase, Config), PA = filename:dirname(code:which(?MODULE)), diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl index 12928ed6d8..843e917dfc 100644 --- a/erts/emulator/test/mtx_SUITE.erl +++ b/erts/emulator/test/mtx_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% 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. @@ -97,7 +97,7 @@ init_per_testcase(_Case, Config) -> wait_deallocations(), Config. -end_per_testcase(_Func, Config) -> +end_per_testcase(_Func, _Config) -> ok. wait_deallocations() -> diff --git a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c index e011aadce9..46ee8b5540 100644 --- a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c +++ b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c @@ -24,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/nested_SUITE.erl b/erts/emulator/test/nested_SUITE.erl index 7af2873ce2..f1b4c03ae4 100644 --- a/erts/emulator/test/nested_SUITE.erl +++ b/erts/emulator/test/nested_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% 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. @@ -27,7 +27,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 10}}]. + {timetrap, {minutes, 1}}]. all() -> [case_in_case, case_in_after, catch_in_catch, diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 9c1694fa8a..a2f3489943 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-2018. 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. @@ -21,22 +21,33 @@ -module(nif_SUITE). %%-define(line_trace,true). --define(CHECK(Exp,Got), check(Exp,Got,?LINE)). +-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, +-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/1, upgrade/1, heap_frag/1, + 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, - is_checks/1, + threading/1, send/1, send2/1, send3/1, send_threaded/1, + send_trace/1, send_seq_trace/1, + neg/1, is_checks/1, get_length/1, make_atom/1, make_string/1, reverse_list_test/1, otp_9828/1, otp_9668/1, consume_timeslice/1, nif_schedule/1, @@ -47,32 +58,36 @@ 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_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, - t_on_load, +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_9828, @@ -83,12 +98,66 @@ all() -> nif_is_process_alive, nif_is_port_alive, nif_term_to_binary, nif_binary_to_term, nif_port_command, - nif_snprintf]. + 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) -> + %% 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) -> @@ -112,8 +181,8 @@ basic(Config) when is_list(Config) -> true = lists:member(?MODULE, erlang:system_info(taints)), ok. -%% Test reload callback in nif lib -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), @@ -127,20 +196,20 @@ reload(Config) when is_list(Config) -> 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(), - ok = nif_mod:load_nif_lib(Config, 2), - 2 = nif_mod:lib_version(), - [{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(), - ok = nif_mod:load_nif_lib(Config, 1), + {error, {reload, _}} = nif_mod:load_nif_lib(Config, 1), 1 = nif_mod:lib_version(), - [{reload,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(), + [{lib_version,1,4,104}] = nif_mod_call_history(), true = erlang:delete_module(nif_mod), [] = nif_mod_call_history(), %%false= check_process_code(Pid, nif_mod), true = erlang:purge_module(nif_mod), - [{unload,1,3,103}] = nif_mod_call_history(), + [{unload,1,5,105}] = nif_mod_call_history(), true = lists:member(?MODULE, erlang:system_info(taints)), true = lists:member(nif_mod, erlang:system_info(taints)), @@ -148,7 +217,7 @@ reload(Config) when is_list(Config) -> ok. %% Test upgrade callback in nif lib -upgrade(Config) when is_list(Config) -> +upgrade(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), @@ -299,6 +368,8 @@ t_on_load(Config) when is_list(Config) -> %% 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(), @@ -411,6 +482,451 @@ t_on_load(Config) when is_list(Config) -> verify_tmpmem(TmpMem), ok. +-define(ERL_NIF_SELECT_READ, (1 bsl 0)). +-define(ERL_NIF_SELECT_WRITE, (1 bsl 1)). +-define(ERL_NIF_SELECT_STOP, (1 bsl 2)). + +-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, _DirectCall}} = 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) -> @@ -655,6 +1171,13 @@ maps(Config) when is_list(Config) -> {1, M2} = make_map_remove_nif(M2, "key3"), {0, undefined} = make_map_remove_nif(self(), key), + M1 = maps_from_list_nif(maps:to_list(M1)), + M2 = maps_from_list_nif(maps:to_list(M2)), + M3 = maps_from_list_nif(maps:to_list(M3)), + + has_duplicate_keys = maps_from_list_nif([{1,1},{1,1}]), + + verify_tmpmem(TmpMem), ok. %% Test macros enif_make_list<N> and enif_make_tuple<N> @@ -714,7 +1237,7 @@ resource_hugo_do(Type) -> HugoBin = <<"Hugo Hacker">>, HugoPtr = alloc_resource(Type, HugoBin), Hugo = make_resource(HugoPtr), - <<>> = Hugo, + true = is_reference(Hugo), release_resource(HugoPtr), erlang:garbage_collect(), {HugoPtr,HugoBin} = get_resource(Type,Hugo), @@ -748,7 +1271,7 @@ resource_otto_do(Type) -> OttoBin = <<"Otto Ordonnans">>, OttoPtr = alloc_resource(Type, OttoBin), Otto = make_resource(OttoPtr), - <<>> = Otto, + true = is_reference(Otto), %% forget resource term but keep referenced by NIF {OttoPtr, OttoBin}. @@ -771,8 +1294,9 @@ resource_new_do2(Type) -> BinB = <<"NewB">>, ResA = make_new_resource(Type, BinA), ResB = make_new_resource(Type, BinB), - <<>> = ResA, - <<>> = ResB, + 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), @@ -828,7 +1352,7 @@ resource_binary_do() -> -define(RT_CREATE,1). -define(RT_TAKEOVER,2). -%% Test resource takeover by module reload and upgrade +%% Test resource takeover by module upgrade resource_takeover(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), @@ -893,6 +1417,7 @@ resource_takeover(Config) when is_list(Config) -> ok = forget_resource(NGX1), ?CHECK([], nif_mod_call_history()), % no dtor + {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}, @@ -911,7 +1436,9 @@ resource_takeover(Config) when is_list(Config) -> {resource_type, 4, ?RT_CREATE, "resource_type_null_goneY",null, ?RT_CREATE} ]), - ?CHECK([{reload,2,1,201}], nif_mod_call_history()), + ?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), @@ -924,8 +1451,8 @@ resource_takeover(Config) when is_list(Config) -> ?CHECK([], nif_mod_call_history()), % no dtor 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? + ?CHECK([{{resource_dtor_B_v1,BinBGX2},1,6,106}, {unload,1,7,107}], + nif_mod_call_history()), ok = forget_resource(NGX2), ?CHECK([], nif_mod_call_history()), % no dtor @@ -1140,7 +1667,7 @@ resource_takeover(Config) when is_list(Config) -> [{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(), @@ -1148,6 +1675,9 @@ resource_takeover(Config) when is_list(Config) -> ok = forget_resource(AN7), [] = nif_mod_call_history(), + 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), @@ -1221,11 +1751,19 @@ threading_do(Config) -> 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(), + erlang:load_module(tester,ModBin), + erlang:purge_module(tester), ok = tester:load_nif_lib(Config, "tsd"), - ok = tester:run(). + ok = tester:run(), + + erlang:delete_module(tester), + erlang:purge_module(tester). + %% Test NIF message sending send(Config) when is_list(Config) -> @@ -1252,6 +1790,59 @@ send(Config) when is_list(Config) -> {ok,0} = send_list_seq(7, DeadPid), ok. + +%% Test tracing of enif_send +send_trace(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + Papa = self(), + N = 1500, + List = lists:seq(1,N), + + Tracer = spawn_link(fun F() -> receive get -> Papa ! receive_any(), F() end end), + + erlang:trace(self(), true, [send,'receive',{tracer,Tracer}]), + {ok,1} = send_list_seq(N, self()), + List = receive_any(), + timeout = receive_any(0), + Tracer ! get, + {trace,Papa,send,List,Papa} = receive_any(), + Tracer ! get, + {trace,Papa,'receive',List} = receive_any(). + +%% Test that seq_trace works with nif trace +send_seq_trace(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + Papa = self(), + N = 1500, + List = lists:seq(1,N), + Label = make_ref(), + + Tracer = spawn_link(fun F() -> receive get -> Papa ! receive_any(), F() end end), + + seq_trace:set_system_tracer(Tracer), + seq_trace:set_token(label,Label), + seq_trace:set_token(send,true), + seq_trace:set_token('receive',true), + + {ok,1} = send_list_seq(N, self()), + List = receive_any(), + timeout = receive_any(0), + {ok,1} = send_list_seq(N, self()), + List = receive_any(), + timeout = receive_any(0), + + Tracer ! get, + {seq_trace,Label,{send,{0,1},Papa,Papa,List}} = receive_any(), + Tracer ! get, + {seq_trace,Label,{'receive',{0,1},Papa,Papa,List}} = receive_any(), + Tracer ! get, + {seq_trace,Label,{send,{1,2},Papa,Papa,List}} = receive_any(), + Tracer ! get, + {seq_trace,Label,{'receive',{1,2},Papa,Papa,List}} = receive_any(). + + %% More NIF message sending send2(Config) when is_list(Config) -> ensure_lib_loaded(Config), @@ -1261,14 +1852,9 @@ send2(Config) when is_list(Config) -> %% 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) -> @@ -1513,13 +2099,13 @@ send3_new_state(State, Blob) -> neg(Config) when is_list(Config) -> TmpMem = tmpmem(), {'EXIT',{badarg,_}} = (catch erlang:load_nif(badarg, 0)), - {error,{load_failed,_}} = erlang:load_nif("pink_unicorn", 0), 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. @@ -1620,7 +2206,7 @@ otp_9828(Config) -> ensure_lib_loaded(Config, 1), otp_9828_loop(<<"I'm alive!">>, 1000). -otp_9828_loop(Bin, 0) -> +otp_9828_loop(_Bin, 0) -> ok; otp_9828_loop(Bin, Val) -> WrtBin = <<Bin/binary, Val:32>>, @@ -1640,7 +2226,8 @@ consume_timeslice(Config) when is_list(Config) -> end. consume_timeslice_test(Config) when is_list(Config) -> - CONTEXT_REDS = 2000, + ensure_lib_loaded(Config), + CONTEXT_REDS = 4000, Me = self(), Go = make_ref(), RedDiff = make_ref(), @@ -1716,7 +2303,7 @@ consume_timeslice_test(Config) when is_list(Config) -> io:format("Reductions = ~p~n", [Reductions]), ok; {RedDiff, Reductions} -> - ct:fail({unexpected_reduction_count, Reductions}) + ct:fail({unexpected_reduction_count, Reductions, ExpReds}) end, none = next_msg(P), @@ -1730,9 +2317,8 @@ nif_schedule(Config) when is_list(Config) -> {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(), + error:badarg:Stk -> + [{?MODULE,call_nif_schedule,[1,2],_}|_] = Stk, ok end, ok. @@ -1861,6 +2447,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) -> @@ -1870,7 +2475,8 @@ 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. @@ -1882,8 +2488,8 @@ nif_raise_exceptions(NifFunc) -> erlang:apply(?MODULE,NifFunc,[Term]), ct:fail({expected,Term}) catch - error:Term -> - [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(), + error:Term:Stk -> + [{?MODULE,NifFunc,[Term],_}|_] = Stk, ok end end, ok, ExcTerms). @@ -1891,7 +2497,7 @@ nif_raise_exceptions(NifFunc) -> -define(ERL_NIF_TIME_ERROR, -9223372036854775808). -define(TIME_UNITS, [second, millisecond, microsecond, nanosecond]). -nif_monotonic_time(Config) -> +nif_monotonic_time(_Config) -> ?ERL_NIF_TIME_ERROR = monotonic_time(invalid_time_unit), mtime_loop(1000000). @@ -1916,7 +2522,7 @@ chk_mtime([TU|TUs]) -> end, chk_mtime(TUs). -nif_time_offset(Config) -> +nif_time_offset(_Config) -> ?ERL_NIF_TIME_ERROR = time_offset(invalid_time_unit), toffs_loop(1000000). @@ -1954,7 +2560,7 @@ chk_toffs([TU|TUs]) -> end, chk_toffs(TUs). -nif_convert_time_unit(Config) -> +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), @@ -2111,16 +2717,23 @@ nif_term_to_binary(Config) -> nif_binary_to_term(Config) -> ensure_lib_loaded(Config), - T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)}, + BigMap = maps:from_list([{I,-I} || I <- lists:seq(1,100)]), + [nif_binary_to_term_do(T) + || T <- [{#{ok => nok}, <<0:8096>>, lists:seq(1,100)}, + atom, 42, self(), BigMap]], + ok. + +nif_binary_to_term_do(T) -> + Dummy = [true|false], Bin = term_to_binary(T), Len = byte_size(Bin), - {Len,T} = binary_to_term_nif(Bin, undefined, 0), + {Len,T,Dummy} = binary_to_term_nif(Bin, undefined, 0), Len = binary_to_term_nif(Bin, self(), 0), - T = receive M -> M after 1000 -> timeout end, + {T,Dummy} = receive M -> M after 1000 -> timeout end, - {Len, T} = binary_to_term_nif(Bin, undefined, ?ERL_NIF_BIN2TERM_SAFE), + {Len,T,Dummy} = 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), + undefined, ?ERL_NIF_BIN2TERM_SAFE), false = binary_to_term_nif(Bin, undefined, 1), ok. @@ -2161,6 +2774,544 @@ nif_snprintf(Config) -> <<"{{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}, + {peek_head, a}, + {deq, a, 42}, + + %% Test enqv + {enqv, a, 2, 100}, + {peek_head, a}, + {deq, a, all}, + + %% This skips all elements but one in the iolist + {enqv, a, 5, iolist_size(nif_ioq_payload(5)) - 1}, + {peek_head, a}, + {peek, a}, + + %% Ensure that enqueued refc binaries are intact after a roundtrip. + %% + %% This test and the ones immediately following it does not go through + %% erlang:iolist_to_iovec/1 + {enqv, a, [nif_ioq_payload(refcbin) || _ <- lists:seq(1,20)], 0}, + {peek, a}, + + %% ... heap binaries + {enqv, a, [nif_ioq_payload(heapbin) || _ <- lists:seq(1,20)], 0}, + {peek, a}, + + %% ... plain sub-binaries + {enqv, a, [nif_ioq_payload(subbin) || _ <- lists:seq(1,20)], 0}, + {peek, a}, + + %% ... unaligned binaries + {enqv, a, [nif_ioq_payload(unaligned_bin) || _ <- lists:seq(1,20)], 0}, + {peek, a}, + + %% 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), + + false = ioq_nif(peek_head, Q), + + {'EXIT', {badarg, _}} = (catch ioq_nif(deq, Q, 1)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, 1, 1234)), + + false = ioq_nif(peek_head, Q), + + {'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)), + + false = ioq_nif(peek_head, Q), + + {'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([{peek_head, Name} = H|T], State) -> + #{ q := IOQ, b := B } = maps:get(Name, State), + RefData = iolist_to_binary(B), + + ct:log("~p", [H]), + + {true, QueueHead} = ioq_nif(peek_head, IOQ), + true = byte_size(QueueHead) > 0, + + {RefHead, _Tail} = split_binary(RefData, byte_size(QueueHead)), + + true = QueueHead =:= RefHead, + + 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), + nif_ioq_payload(unaligned_bin) | 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(unaligned_bin) -> + make_unaligned_binary(<< <<I>> || I <- lists:seq(1, 255) >>); +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. + +make_unaligned_binary(Bin0) -> + Size = byte_size(Bin0), + <<0:3,Bin:Size/binary,31:5>> = id(<<0:3,Bin0/binary,31:5>>), + Bin. + +id(I) -> I. %% The NIFs: lib_version() -> undefined. @@ -2172,6 +3323,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. @@ -2185,6 +3337,7 @@ 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. @@ -2223,6 +3376,29 @@ 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. diff --git a/erts/emulator/test/nif_SUITE_data/Makefile.src b/erts/emulator/test/nif_SUITE_data/Makefile.src index fbb8978771..de06026780 100644 --- a/erts/emulator/test/nif_SUITE_data/Makefile.src +++ b/erts/emulator/test/nif_SUITE_data/Makefile.src @@ -2,7 +2,13 @@ NIF_LIBS = nif_SUITE.1@dll@ \ nif_mod.1@dll@ \ nif_mod.2@dll@ \ - nif_mod.3@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@ 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 f2b1ef9d24..f2ce6dbe67 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2016. All Rights Reserved. + * Copyright Ericsson AB 2009-2018. 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. @@ -17,18 +17,50 @@ * * %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; @@ -42,7 +74,22 @@ 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 { @@ -102,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)); @@ -127,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, @@ -141,6 +236,23 @@ 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"); @@ -151,6 +263,22 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) 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; @@ -184,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; @@ -212,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[]) @@ -394,8 +515,7 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ErlNifSInt64 sint64; ErlNifUInt64 uint64; double d; - ERL_NIF_TERM atom, ref1, ref2, term; - size_t len; + ERL_NIF_TERM atom, ref1, ref2; sint = INT_MIN; do { @@ -602,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; @@ -836,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); } @@ -859,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 @@ -1024,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; @@ -1058,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); } } @@ -1111,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; @@ -1144,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) { @@ -1222,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, @@ -1246,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; @@ -1253,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; @@ -1280,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); @@ -1302,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"); @@ -1322,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); } @@ -1333,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); @@ -1367,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); } @@ -1374,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)) { @@ -1384,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); } @@ -1400,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; } @@ -1471,7 +1898,6 @@ static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ static ERL_NIF_TERM send_copy_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - ErlNifEnv* menv; ErlNifPid pid; int ret; if (!enif_get_local_pid(env, argv[0], &pid)) { @@ -1714,24 +2140,45 @@ static ERL_NIF_TERM make_map_remove_nif(ErlNifEnv* env, int argc, const ERL_NIF_ /* maps */ static ERL_NIF_TERM maps_from_list_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - ERL_NIF_TERM cell = argv[0]; - ERL_NIF_TERM map = enif_make_new_map(env); - ERL_NIF_TERM tuple; - const ERL_NIF_TERM *pair; - int arity = -1; + ERL_NIF_TERM *keys, *values; + ERL_NIF_TERM result, cell; + unsigned count; + + if (argc != 1 || !enif_get_list_length(env, argv[0], &count)) { + return enif_make_badarg(env); + } - if (argc != 1 && !enif_is_list(env, cell)) return enif_make_badarg(env); + keys = enif_alloc(sizeof(ERL_NIF_TERM) * count * 2); + values = keys + count; - /* assume sorted keys */ + cell = argv[0]; + count = 0; - while (!enif_is_empty_list(env,cell)) { - if (!enif_get_list_cell(env, cell, &tuple, &cell)) return enif_make_badarg(env); - if (enif_get_tuple(env,tuple,&arity,&pair)) { - enif_make_map_put(env, map, pair[0], pair[1], &map); - } + while (!enif_is_empty_list(env, cell)) { + const ERL_NIF_TERM *pair; + ERL_NIF_TERM tuple; + int arity; + + if (!enif_get_list_cell(env, cell, &tuple, &cell) + || !enif_get_tuple(env, tuple, &arity, &pair) + || arity != 2) { + enif_free(keys); + return enif_make_badarg(env); + } + + keys[count] = pair[0]; + values[count] = pair[1]; + + count++; } - return map; + if (!enif_make_map_from_arrays(env, keys, values, count, &result)) { + result = enif_make_atom(env, "has_duplicate_keys"); + } + + enif_free(keys); + + return result; } static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -1958,7 +2405,7 @@ static ERL_NIF_TERM term_to_binary(ErlNifEnv* env, int argc, const ERL_NIF_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; + ERL_NIF_TERM term, dummy, ret_term; ErlNifPid pid; ErlNifEnv *msg_env = env; unsigned int opts; @@ -1971,6 +2418,9 @@ static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM || !enif_get_uint(env, argv[2], &opts)) return enif_make_badarg(env); + /* build dummy heap term first to provoke OTP-15080 */ + dummy = enif_make_list_cell(msg_env, atom_true, atom_false); + ret = enif_binary_to_term(msg_env, bin.data, bin.size, &term, (ErlNifBinaryToTerm)opts); if (!ret) @@ -1978,11 +2428,12 @@ static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM ret_term = enif_make_uint64(env, ret); if (msg_env != env) { - enif_send(env, &pid, msg_env, term); + enif_send(env, &pid, msg_env, + enif_make_tuple2(msg_env, term, dummy)); enif_free_env(msg_env); return ret_term; } else { - return enif_make_tuple2(env, ret_term, term); + return enif_make_tuple3(env, ret_term, term, dummy); } } @@ -2014,6 +2465,1026 @@ static ERL_NIF_TERM format_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg 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; + volatile 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++) { + int state1 = r->monv[mix].state; + /* First do dirty access of pid and state without the lock */ + if (r->monv[mix].pid.pid == pid->pid && state1 >= MON_TRYING) { + int state2; + enif_mutex_lock(r->monv[mix].lock); + state2 = r->monv[mix].state; + if (state2 >= MON_ACTIVE) { + if (enif_compare_monitors(mon, &r->monv[mix].mon) == 0) { + r->monv[mix].state = MON_FREE_DOWN; + enif_mutex_unlock(r->monv[mix].lock); + return; + } + } + else { + assert(state2 != MON_TRYING); + assert(state1 == MON_TRYING || /* racing monitor failed */ + state2 == MON_FREE_DEMONITOR || /* racing demonitor */ + state2 == MON_FREE_DOWN); /* racing down */ + } + 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_head"))) { + ERL_NIF_TERM head_term; + + if(enif_ioq_peek_head(env, ioq->q, NULL, &head_term)) { + return enif_make_tuple2(env, + enif_make_atom(env, "true"), head_term); + } + + return enif_make_atom(env, "false"); + } 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[] = { @@ -2026,6 +3497,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}, @@ -2039,6 +3511,7 @@ 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}, @@ -2091,7 +3564,30 @@ static ErlNifFunc nif_funcs[] = {"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} + {"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 fd8a0d0595..885b8ebaf8 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.c +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2016. All Rights Reserved. + * 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. @@ -17,7 +17,7 @@ * * %CopyrightEnd% */ -#include "erl_nif.h" +#include <erl_nif.h> #include <string.h> #include <stdio.h> @@ -176,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; @@ -230,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[]) { @@ -237,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_uint64(env, (ErlNifUInt64)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[]) @@ -279,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 1fcc33faa4..8019cfcf82 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.erl +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.erl @@ -22,7 +22,7 @@ -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]). @@ -35,21 +35,32 @@ on_load() -> [{data_dir, Path}] = ets:lookup(nif_SUITE, data_dir), [{lib_version, Ver}] = ets:lookup(nif_SUITE, lib_version), - erlang:load_nif(filename:join(Path,libname(Ver)), []). + [{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) -> Path = proplists:get_value(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). + 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]). @@ -72,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 e32e63069a..feb10ecaea 100644 --- a/erts/emulator/test/nif_SUITE_data/testcase_driver.h +++ b/erts/emulator/test/nif_SUITE_data/testcase_driver.h @@ -20,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/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index af18545bff..300b4ed036 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2016. All Rights Reserved. +%% Copyright Ericsson AB 2002-2018. 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. @@ -45,12 +45,13 @@ 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]). + iter_max_procs/1, + magic_ref/1, + dist_entry_gc/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -58,11 +59,11 @@ suite() -> all() -> - [term_to_binary_to_term_eq, round_trip_eq, cmp, ref_eq, + [dist_entry_gc, 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]. + timer_refc, pid_wrap, port_wrap, bad_nc, + unique_pid, iter_max_procs, magic_ref]. init_per_suite(Config) -> Config. @@ -152,7 +153,7 @@ ttbtteq_do_remote(RNode) -> %% %% Test case: round_trip_eq %% -%% Tests that node containers that are sent beteen nodes stay equal to themselves. +%% Tests that node containers that are sent between nodes stay equal to themselves. round_trip_eq(Config) when is_list(Config) -> ThisNode = {node(), erlang:system_info(creation)}, NodeFirstName = get_nodefirstname(), @@ -405,6 +406,7 @@ node_table_gc(Config) when is_list(Config) -> 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]), @@ -683,35 +685,6 @@ timer_refc(Config) when is_list(Config) -> nc_refc_check(node()), ok. -otp_4715(Config) when is_list(Config) -> - case test_server: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 -> - run_otp_4715(Config); - _ -> - Pa = filename:dirname(code:which(?MODULE)), - test_server:run_on_shielded_node(fun () -> - run_otp_4715(Config) - end, - "+R9 -pa " ++ Pa) - end. - -run_otp_4715(Config) when is_list(Config) -> - erts_debug:set_internal_state(available_internal_state, true), - 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)], - - R9Sorted = old_mod:sort_on_old_node(PidList), - R9Sorted = lists:sort(PidList). - pid_wrap(Config) when is_list(Config) -> pp_wrap(pid). port_wrap(Config) when is_list(Config) -> @@ -889,10 +862,69 @@ chk_max_proc_line_until(NoMoreTests, Res) -> 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. + + +lost_pending_connection(Node) -> + _ = (catch erts_internal:new_connection(Node)), + ok. + +dist_entry_gc(Config) when is_list(Config) -> + Me = self(), + {ok, Node} = start_node(get_nodefirstname(), "+zdntgc 0"), + P = spawn_link(Node, + fun () -> + LostNode = list_to_atom("lost_pending_connection@" ++ hostname()), + lost_pending_connection(LostNode), + garbage_collect(), %% Could crash... + Me ! {self(), ok} + end), + receive + {P, ok} -> ok + end, + unlink(P), + stop_node(Node), + 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) -> @@ -958,6 +990,8 @@ check_refc(ThisNodeName,ThisCreation,Table,EntryList) when is_list(EntryList) -> {case Referrer of {system,delayed_delete_timer} -> true; + {system,thread_progress_delete_timer} -> + true; _ -> DDT end, diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index d1c9648017..f15217814a 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -32,6 +32,8 @@ %% list_to_integer/1 %% round/1 %% trunc/1 +%% floor/1 +%% ceil/1 %% integer_to_binary/1 %% integer_to_binary/2 %% binary_to_integer/1 @@ -41,7 +43,7 @@ t_float_to_string/1, t_integer_to_string/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]}]. @@ -49,7 +51,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. 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_list_to_integer_edge_cases]. + t_trunc_and_friends, t_list_to_integer_edge_cases]. groups() -> [{t_string_to_float, [], @@ -106,7 +108,7 @@ 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)), @@ -116,6 +118,7 @@ t_float(Config) when is_list(Config) -> %% Tests float_to_list/1, float_to_list/2, float_to_binary/1, float_to_binary/2 t_float_to_string(Config) when is_list(Config) -> + rand_seed(), test_fts("0.00000000000000000000e+00", 0.0), test_fts("2.50000000000000000000e+01", 25.0), test_fts("2.50000000000000000000e+00", 2.5), @@ -143,7 +146,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), @@ -158,6 +161,7 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("1.000",1.0, [{decimals, 3}]), test_fts("1.0",1.0, [{decimals, 1}]), test_fts("1.0",1.0, [{decimals, 3}, compact]), + test_fts("10",10.0, [{decimals, 0}, compact]), test_fts("1.12",1.123, [{decimals, 2}]), test_fts("1.123",1.123, [{decimals, 3}]), test_fts("1.123",1.123, [{decimals, 3}, compact]), @@ -165,8 +169,8 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("1.12300",1.123, [{decimals, 5}]), test_fts("1.123",1.123, [{decimals, 5}, compact]), test_fts("1.1234",1.1234,[{decimals, 6}, compact]), - test_fts("1.01",1.005, [{decimals, 2}]), - test_fts("-1.01",-1.005,[{decimals, 2}]), + test_fts("1.00",1.005, [{decimals, 2}]), %% 1.005 is really 1.0049999999... + test_fts("-1.00",-1.005,[{decimals, 2}]), test_fts("0.999",0.999, [{decimals, 3}]), test_fts("-0.999",-0.999,[{decimals, 3}]), test_fts("1.0",0.999, [{decimals, 2}, compact]), @@ -182,6 +186,9 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("123000000000000000000.0",1.23e20, [{decimals, 10}, compact]), test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]), test_fts("1.23000000000000000000e+20",1.23e20, []), + + fts_rand_float_decimals(1000), + ok. test_fts(Expect, Float) -> @@ -195,6 +202,83 @@ test_fts(Expect, Float, Args) -> BinExpect = float_to_binary(Float,Args). +rand_float_reasonable() -> + F = rand_float(), + case abs(F) > 1.0e238 of + true -> rand_float_reasonable(); + false -> F + end. + +fts_rand_float_decimals(0) -> ok; +fts_rand_float_decimals(N) -> + [begin + F0 = rand_float_reasonable(), + L0 = float_to_list(F0, [{decimals, D}]), + case conform_with_io_lib_format_os(F0,D) of + false -> ok; + true -> + IOL = lists:flatten(io_lib:format("~.*f", [D, F0])), + true = case L0 =:= IOL of + true -> true; + false -> + io:format("F0 = ~w ~w\n", [F0, <<F0/float>>]), + io:format("decimals = ~w\n", [D]), + io:format("float_to_list = ~s\n", [L0]), + io:format("io_lib:format = ~s\n", [IOL]), + false + end + end, + L1 = case D of + 0 -> L0 ++ ".0"; + _ -> L0 + end, + F1 = list_to_float(L1), + Diff = abs(F0-F1), + MaxDiff = max_diff_decimals(F0, D), + ok = case Diff =< MaxDiff of + true -> ok; + false -> + io:format("F0 = ~w ~w\n", [F0, <<F0/float>>]), + io:format("L1 = ~s\n", [L1]), + io:format("F1 = ~w ~w\n", [F1, <<F1/float>>]), + io:format("Diff = ~w, MaxDiff = ~w\n", [Diff, MaxDiff]), + error + end + end + || D <- lists:seq(0,15)], + + fts_rand_float_decimals(N-1). + +conform_with_io_lib_format_os(F, D) -> + case os:type() of + {win32,_} -> + %% io_lib:format("~.*f") buggy on windows? OTP-15010 + false; + _ -> + conform_with_io_lib_format(F, D) + end. + +conform_with_io_lib_format(_, 0) -> + %% io_lib:format("~.*f") does not support zero decimals + false; +conform_with_io_lib_format(_, D) when D > 10 -> + %% Seems float_to_list gets it slightly wrong sometimes for many decimals + false; +conform_with_io_lib_format(F, D) -> + %% io_lib:format prints '0' for input bits beyond mantissa precision + %% float_to_list treats those unknown input bits as if they were zeros. + math:log2(abs(F) * math:pow(10,D)) < 54. + +max_diff_decimals(F, D) -> + IntBits = floor(math:log2(abs(F))) + 1, + FracBits = (52 - IntBits), + Log10_2 = 0.3010299956639812, % math:log10(2) + MaxDec = floor(FracBits * Log10_2), + + Resolution = math:pow(2, IntBits - 53), + + (math:pow(10, -min(D,MaxDec)) / 2) + Resolution. + %% Tests list_to_float/1. t_string_to_float_safe(Config) when is_list(Config) -> @@ -293,32 +377,91 @@ 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. + rand_seed(), + t_trunc_and_friends_rand(100), + ok. + +rand_seed() -> + rand:seed(exrop), + io:format("\n*** rand:export_seed() = ~w\n\n", [rand:export_seed()]), ok. +rand_float() -> + F0 = rand:uniform() * math:pow(10, 50*rand:normal()), + case rand:uniform() of + U when U < 0.5 -> -F0; + _ -> F0 + end. + +t_trunc_and_friends_rand(0) -> + ok; +t_trunc_and_friends_rand(N) -> + _ = trunc_and_friends(rand_float()), + 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. @@ -438,7 +581,7 @@ t_string_to_integer(Config) when is_list(Config) -> list_to_binary(Value),Base)), {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value,Base)) - end,[{" 1",1},{" 1",37},{"2",2},{"C",11}, + end,[{" 1",1},{" 1",37},{"2",2},{"B",11},{"b",11},{":", 16}, {"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16}, {"1z111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111",16}, {"111z11111111",16}]), diff --git a/erts/emulator/test/old_mod.erl b/erts/emulator/test/old_mod.erl deleted file mode 100644 index 866aba79bb..0000000000 --- a/erts/emulator/test/old_mod.erl +++ /dev/null @@ -1,48 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-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(old_mod). --compile(r10). - --export([sort_on_old_node/1, sorter/3]). - --include_lib("common_test/include/ct.hrl"). - -sorter(Receiver, Ref, List) -> - Receiver ! {Ref, lists:sort(List)}. - -sort_on_old_node(List) when is_list(List) -> - OldVersion = "r10", - Pa = filename:dirname(code:which(?MODULE)), - {X, Y, Z} = now(), - NodeName = list_to_atom(OldVersion - ++ "_" - ++ integer_to_list(X) - ++ integer_to_list(Y) - ++ integer_to_list(Z)), - {ok, Node} = test_server:start_node(NodeName, - peer, - [{args, " -pa " ++ Pa}, - {erl, [{release, OldVersion++"b_patched"}]}]), - Ref = make_ref(), - spawn_link(Node, ?MODULE, sorter, [self(), Ref, List]), - SortedPids = receive {Ref, SP} -> SP end, - true = test_server:stop_node(Node), - SortedPids. diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl deleted file mode 100644 index ffe7d40139..0000000000 --- a/erts/emulator/test/old_scheduler_SUITE.erl +++ /dev/null @@ -1,384 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-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(old_scheduler_SUITE). - --include_lib("common_test/include/ct.hrl"). - --export([all/0, suite/0, - init_per_testcase/2, end_per_testcase/2]). --export([equal/1, many_low/1, few_low/1, max/1, high/1]). - -suite() -> - [{ct_hooks,[ts_install_cth]}, - {timetrap, {minutes, 11}}]. - -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. - - -%%----------------------------------------------------------------------------------- -%% 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) -> - %% main test process needs max prio - Prio = process_flag(priority, max), - MS = erlang:system_flag(multi_scheduling, block), - [{prio,Prio},{multi_scheduling, MS}|Config]. - -end_per_testcase(_Case, Config) -> - erlang:system_flag(multi_scheduling, unblock), - Prio=proplists:get_value(prio, Config), - process_flag(priority, Prio), - ok. - -ok(Config) when is_list(Config) -> - case proplists:get_value(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(Config) when is_list(Config) -> - 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 - Receiver = - spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end), - Starter = - spawn(fun() -> starter(Normal, Low, Receiver) end), - - %% receive test data from Receiver - {NRs,NAvg,LRs,LAvg,Ratio} = - receive - {Receiver,Res} -> Res - end, - - %% stop controllers and test processes - exit(Starter, kill), - 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 -> - ct:fail({bad_ratio,Ratio}); - true -> - ok(Config) - end. - - -%% Run many low and few normal prio processes. - -many_low(Config) when is_list(Config) -> - Self = self(), - Normal = {normal,1}, - Low = {low,1000}, - - %% specify time of test (in seconds) - Time = 30, - - Receiver = - spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end), - Starter = - spawn(fun() -> starter(Normal, Low, Receiver) end), - {NRs,NAvg,LRs,LAvg,Ratio} = - receive - {Receiver,Res} -> Res - end, - exit(Starter, kill), - 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 -> - ct:fail({bad_ratio,Ratio}); - true -> - ok(Config) - end. - - -%% Run few low and many normal prio processes. - -few_low(Config) when is_list(Config) -> - Self = self(), - Normal = {normal,1000}, - Low = {low,1}, - - %% specify time of test (in seconds) - Time = 30, - - Receiver = - spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end), - Starter = - spawn(fun() -> starter(Normal, Low, Receiver) end), - {NRs,NAvg,LRs,LAvg,Ratio} = - receive - {Receiver,Res} -> Res - end, - exit(Starter, kill), - 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 -> - ct: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(Config) when is_list(Config) -> - max = process_flag(priority, max), % should already be max (init_per_tc) - Self = self(), - Max = {max,2}, - High = {high,2}, - Normal = {normal,100}, - Low = {low,100}, - - %% specify time of test (in seconds) - Time = 30, - - Receiver1 = - spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, High) end), - Starter1 = - spawn(fun() -> starter(Max, High, Receiver1) end), - {M1Rs,M1Avg,HRs,HAvg,Ratio1} = - receive - {Receiver1,Res1} -> Res1 - end, - exit(Starter1, kill), - 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 -> - ct:fail({bad_ratio,Ratio1}); - true -> - ok(Config) - end, - - Receiver2 = - spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, Normal) end), - Starter2 = - spawn(fun() -> starter(Max, Normal, Receiver2) end), - {M2Rs,M2Avg,NRs,NAvg,Ratio2} = - receive - {Receiver2,Res2} -> Res2 - end, - exit(Starter2, kill), - 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 -> - ct:fail({bad_ratio,Ratio2}); - true -> - ok - end, - - Receiver3 = - spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, Low) end), - Starter3 = - spawn(fun() -> starter(Max, Low, Receiver3) end), - {M3Rs,M3Avg,LRs,LAvg,Ratio3} = - receive - {Receiver3,Res3} -> Res3 - end, - exit(Starter3, kill), - 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 -> - ct: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(Config) when is_list(Config) -> - max = process_flag(priority, max), % should already be max (init_per_tc) - Self = self(), - High = {high,2}, - Normal = {normal,100}, - Low = {low,100}, - - %% specify time of test (in seconds) - Time = 30, - - Receiver1 = - spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, High, Normal) end), - Starter1 = - spawn(fun() -> starter(High, Normal, Receiver1) end), - {H1Rs,H1Avg,NRs,NAvg,Ratio1} = - receive - {Receiver1,Res1} -> Res1 - end, - exit(Starter1, kill), - 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 -> - ct:fail({bad_ratio,Ratio1}); - true -> - ok - end, - - Receiver2 = - spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, High, Low) end), - Starter2 = - spawn(fun() -> starter(High, Low, Receiver2) end), - {H2Rs,H2Avg,LRs,LAvg,Ratio2} = - receive - {Receiver2,Res2} -> Res2 - end, - exit(Starter2, kill), - 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 -> - ct: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 = erlang:convert_time_unit(erlang:monotonic_time() - T0, native, millisecond), - % 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 - erlang:convert_time_unit(erlang:monotonic_time() - T0, - native, millisecond), % 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(). 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/persistent_term_SUITE.erl b/erts/emulator/test/persistent_term_SUITE.erl new file mode 100644 index 0000000000..58cd3276b0 --- /dev/null +++ b/erts/emulator/test/persistent_term_SUITE.erl @@ -0,0 +1,614 @@ +%% +%% %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 +%5 +%% 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(persistent_term_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-export([all/0,suite/0, + basic/1,purging/1,sharing/1,get_trapping/1, + info/1,info_trapping/1,killed_while_trapping/1, + off_heap_values/1,keys/1,collisions/1, + init_restart/1]). + +%% +-export([test_init_restart_cmd/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,10}}]. + +all() -> + [basic,purging,sharing,get_trapping,info,info_trapping, + killed_while_trapping,off_heap_values,keys,collisions, + init_restart]. + +basic(_Config) -> + Chk = chk(), + N = 777, + Seq = lists:seq(1, N), + par(2, N, Seq), + seq(3, Seq), + seq(3, Seq), %Same values. + _ = [begin + Key = {?MODULE,{key,I}}, + true = persistent_term:erase(Key), + false = persistent_term:erase(Key), + {'EXIT',{badarg,_}} = (catch persistent_term:get(Key)) + end || I <- Seq], + [] = [P || {{?MODULE,_},_}=P <- persistent_term:get()], + chk(Chk). + +par(C, N, Seq) -> + _ = [spawn_link(fun() -> + ok = persistent_term:put({?MODULE,{key,I}}, + {value,C*I}) + end) || I <- Seq], + Result = wait(N), + _ = [begin + Double = C*I, + {{?MODULE,{key,I}},{value,Double}} = Res + end || {I,Res} <- lists:zip(Seq, Result)], + ok. + +seq(C, Seq) -> + _ = [ok = persistent_term:put({?MODULE,{key,I}}, {value,C*I}) || + I <- Seq], + All = persistent_term:get(), + All = [P || {{?MODULE,_},_}=P <- persistent_term:get()], + All = [{Key,persistent_term:get(Key)} || {Key,_} <- All], + Result = lists:sort(All), + _ = [begin + Double = C*I, + {{?MODULE,{key,I}},{value,Double}} = Res + end || {I,Res} <- lists:zip(Seq, Result)], + ok. + +wait(N) -> + All = [P || {{?MODULE,_},_}=P <- persistent_term:get()], + case length(All) of + N -> + All = [{Key,persistent_term:get(Key)} || {Key,_} <- All], + lists:sort(All); + _ -> + receive after 10 -> ok end, + wait(N) + end. + +%% Make sure that terms that have been erased are copied into all +%% processes that still hold a pointer to them. + +purging(_Config) -> + Chk = chk(), + do_purging(fun(K) -> persistent_term:put(K, {?MODULE,new}) end, + replaced), + do_purging(fun persistent_term:erase/1, erased), + chk(Chk). + +do_purging(Eraser, Type) -> + Parent = self(), + Key = {?MODULE,?FUNCTION_NAME}, + ok = persistent_term:put(Key, {term,[<<"abc",0:777/unit:8>>]}), + Ps0 = [spawn_monitor(fun() -> purging_tester(Parent, Key) end) || + _ <- lists:seq(1, 50)], + Ps = maps:from_list(Ps0), + purging_recv(gotten, Ps), + Eraser(Key), + _ = [P ! {Parent,Type} || P <- maps:keys(Ps)], + purging_wait(Ps). + +purging_recv(Tag, Ps) when map_size(Ps) > 0 -> + receive + {Pid,Tag} -> + true = is_map_key(Pid, Ps), + purging_recv(Tag, maps:remove(Pid, Ps)) + end; +purging_recv(_, _) -> ok. + +purging_wait(Ps) when map_size(Ps) > 0 -> + receive + {'DOWN',Ref,process,Pid,Reason} -> + normal = Reason, + Ref = map_get(Pid, Ps), + purging_wait(maps:remove(Pid, Ps)) + end; +purging_wait(_) -> ok. + +purging_tester(Parent, Key) -> + Term = persistent_term:get(Key), + purging_check_term(Term), + 0 = erts_debug:size_shared(Term), + Parent ! {self(),gotten}, + receive + {Parent,erased} -> + {'EXIT',{badarg,_}} = (catch persistent_term:get(Key)), + purging_tester_1(Term); + {Parent,replaced} -> + {?MODULE,new} = persistent_term:get(Key), + purging_tester_1(Term) + end. + +%% Wait for the term to be copied into this process. +purging_tester_1(Term) -> + purging_check_term(Term), + receive after 1 -> ok end, + case erts_debug:size_shared(Term) of + 0 -> + purging_tester_1(Term); + Size -> + %% The term has been copied into this process. + purging_check_term(Term), + Size = erts_debug:size(Term) + end. + +purging_check_term({term,[<<"abc",0:777/unit:8>>]}) -> + ok. + +%% Test that sharing is preserved when storing terms. + +sharing(_Config) -> + Chk = chk(), + Depth = 10, + Size = 2*Depth, + Shared = lists:foldl(fun(_, A) -> [A|A] end, + [], lists:seq(1, Depth)), + Size = erts_debug:size(Shared), + Key = {?MODULE,?FUNCTION_NAME}, + ok = persistent_term:put(Key, Shared), + SharedStored = persistent_term:get(Key), + Size = erts_debug:size(SharedStored), + 0 = erts_debug:size_shared(SharedStored), + + {Pid,Ref} = spawn_monitor(fun() -> + Term = persistent_term:get(Key), + Size = erts_debug:size(Term), + 0 = erts_debug:size_shared(Term), + true = Term =:= SharedStored + end), + receive + {'DOWN',Ref,process,Pid,normal} -> + true = persistent_term:erase(Key), + Size = erts_debug:size(SharedStored), + chk(Chk) + end. + +%% Test trapping of persistent_term:get/0. + +get_trapping(_Config) -> + Chk = chk(), + + %% Assume that the get/0 traps after 4000 iterations + %% in a non-debug emulator. + N = case test_server:timetrap_scale_factor() of + 1 -> 10000; + _ -> 1000 + end, + spawn_link(fun() -> get_trapping_create(N) end), + All = do_get_trapping(N, []), + N = get_trapping_check_result(lists:sort(All), 1), + erlang:garbage_collect(), + get_trapping_erase(N), + chk(Chk). + +do_get_trapping(N, Prev) -> + case persistent_term:get() of + Prev when length(Prev) >= N -> + All = [P || {{?MODULE,{get_trapping,_}},_}=P <- Prev], + case length(All) of + N -> All; + _ -> do_get_trapping(N, Prev) + end; + New -> + receive after 1 -> ok end, + do_get_trapping(N, New) + end. + +get_trapping_create(0) -> + ok; +get_trapping_create(N) -> + ok = persistent_term:put({?MODULE,{get_trapping,N}}, N), + get_trapping_create(N-1). + +get_trapping_check_result([{{?MODULE,{get_trapping,N}},N}|T], N) -> + get_trapping_check_result(T, N+1); +get_trapping_check_result([], N) -> N-1. + +get_trapping_erase(0) -> + ok; +get_trapping_erase(N) -> + true = persistent_term:erase({?MODULE,{get_trapping,N}}), + get_trapping_erase(N-1). + +%% Test retrieving information about persistent terms. + +info(_Config) -> + Chk = chk(), + + %% White box test of info/0. + N = 100, + try + Overhead = info_literal_area_overhead(), + io:format("Overhead = ~p\n", [Overhead]), + info_wb(N, Overhead, info_info()) + after + _ = [_ = persistent_term:erase({?MODULE,I}) || + I <- lists:seq(1, N)] + end, + + chk(Chk). + +%% White box test of persistent_term:info/0. We take into account +%% that there might already exist persistent terms (created by the +%% OTP standard libraries), but we assume that they are not +%% changed during the execution of this test case. + +info_wb(0, _, _) -> + ok; +info_wb(N, Overhead, {BaseCount,BaseMemory}) -> + Key = {?MODULE,N}, + Value = lists:seq(1, N), + ok = persistent_term:put(Key, Value), + + %% Calculate the extra memory needed for this term. + WordSize = erlang:system_info(wordsize), + ExtraMemory = Overhead + 2 * N * WordSize, + + %% Call persistent_term:info/0. + {Count,Memory} = info_info(), + + %% There should be one more persistent term. + Count = BaseCount + 1, + + %% Verify that the amount of memory is correct. + case BaseMemory + ExtraMemory of + Memory -> + %% Exactly right. The size of the hash table was not changed. + ok; + Expected -> + %% The size of the hash table has been doubled to avoid filling + %% the table to more than 50 percent. The previous number + %% of entries must have been exactly half the size of the + %% hash table. The expected number of extra words added by + %% the resizing will be twice that number. + ExtraWords = BaseCount * 2, + true = ExtraWords * WordSize =:= (Memory - Expected) + end, + info_wb(N-1, Overhead, {Count,Memory}). + +info_info() -> + #{count:=Count,memory:=Memory} = persistent_term:info(), + true = is_integer(Count) andalso Count >= 0, + true = is_integer(Memory) andalso Memory >= 0, + {Count,Memory}. + +%% Calculate the number of extra bytes needed for storing each term in +%% the literal, assuming that the key is a tuple of size 2 with +%% immediate elements. The calculated number is the size of the +%% ErtsLiteralArea struct excluding the storage for the literal term +%% itself. + +info_literal_area_overhead() -> + Key1 = {?MODULE,1}, + Key2 = {?MODULE,2}, + #{memory:=Mem0} = persistent_term:info(), + ok = persistent_term:put(Key1, literal), + #{memory:=Mem1} = persistent_term:info(), + ok = persistent_term:put(Key2, literal), + #{memory:=Mem2} = persistent_term:info(), + true = persistent_term:erase(Key1), + true = persistent_term:erase(Key2), + + %% The size of the hash table may have doubled when inserting + %% one of the keys. To avoiding counting the change in the hash + %% table size, take the smaller size increase. + min(Mem2-Mem1, Mem1-Mem0). + +%% Test trapping of persistent_term:info/0. + +info_trapping(_Config) -> + Chk = chk(), + + %% Assume that the info/0 traps after 4000 iterations + %% in a non-debug emulator. + N = case test_server:timetrap_scale_factor() of + 1 -> 10000; + _ -> 1000 + end, + spawn_link(fun() -> info_trapping_create(N) end), + All = do_info_trapping(N, 0), + N = info_trapping_check_result(lists:sort(All), 1), + erlang:garbage_collect(), + info_trapping_erase(N), + chk(Chk). + +do_info_trapping(N, PrevMem) -> + case info_info() of + {N,Mem} -> + true = Mem >= PrevMem, + All = [P || {{?MODULE,{info_trapping,_}},_}=P <- persistent_term:get()], + case length(All) of + N -> All; + _ -> do_info_trapping(N, PrevMem) + end; + {_,Mem} -> + true = Mem >= PrevMem, + receive after 1 -> ok end, + do_info_trapping(N, Mem) + end. + +info_trapping_create(0) -> + ok; +info_trapping_create(N) -> + ok = persistent_term:put({?MODULE,{info_trapping,N}}, N), + info_trapping_create(N-1). + +info_trapping_check_result([{{?MODULE,{info_trapping,N}},N}|T], N) -> + info_trapping_check_result(T, N+1); +info_trapping_check_result([], N) -> N-1. + +info_trapping_erase(0) -> + ok; +info_trapping_erase(N) -> + true = persistent_term:erase({?MODULE,{info_trapping,N}}), + info_trapping_erase(N-1). + +%% Test that hash tables are deallocated if a process running +%% persistent_term:get/0 is killed. + +killed_while_trapping(_Config) -> + Chk = chk(), + N = case test_server:timetrap_scale_factor() of + 1 -> 20000; + _ -> 2000 + end, + kwt_put(N), + kwt_spawn(10), + kwt_erase(N), + chk(Chk). + +kwt_put(0) -> + ok; +kwt_put(N) -> + ok = persistent_term:put({?MODULE,{kwt,N}}, N), + kwt_put(N-1). + +kwt_spawn(0) -> + ok; +kwt_spawn(N) -> + Pids = [spawn(fun kwt_getter/0) || _ <- lists:seq(1, 20)], + erlang:yield(), + _ = [exit(Pid, kill) || Pid <- Pids], + kwt_spawn(N-1). + +kwt_getter() -> + _ = persistent_term:get(), + kwt_getter(). + +kwt_erase(0) -> + ok; +kwt_erase(N) -> + true = persistent_term:erase({?MODULE,{kwt,N}}), + kwt_erase(N-1). + +%% Test storing off heap values (such as ref-counted binaries). + +off_heap_values(_Config) -> + Chk = chk(), + Key = {?MODULE,?FUNCTION_NAME}, + Val = {a,list_to_binary(lists:seq(0, 255)),make_ref(),fun() -> ok end}, + ok = persistent_term:put(Key, Val), + FetchedVal = persistent_term:get(Key), + Val = FetchedVal, + true = persistent_term:erase(Key), + off_heap_values_wait(FetchedVal, Val), + chk(Chk). + +off_heap_values_wait(FetchedVal, Val) -> + case erts_debug:size_shared(FetchedVal) of + 0 -> + Val = FetchedVal, + ok; + _ -> + erlang:yield(), + off_heap_values_wait(FetchedVal, Val) + end. + +%% Test some more data types as keys. Use the module name as a key +%% to minimize the risk of collision with any key used +%% by the OTP libraries. + +keys(_Config) -> + Chk = chk(), + do_key(?MODULE), + do_key([?MODULE]), + do_key(?MODULE_STRING), + do_key(list_to_binary(?MODULE_STRING)), + chk(Chk). + +do_key(Key) -> + Val = term_to_binary(Key), + ok = persistent_term:put(Key, Val), + StoredVal = persistent_term:get(Key), + Val = StoredVal, + true = persistent_term:erase(Key). + +%% Create persistent terms with keys that are known to collide. +%% Delete them in random order, making sure that all others +%% terms can still be found. + +collisions(_Config) -> + Chk = chk(), + + %% Create persistent terms with random keys. + Keys = lists:flatten(colliding_keys()), + Kvs = [{K,rand:uniform(1000)} || K <- Keys], + _ = [ok = persistent_term:put(K, V) || {K,V} <- Kvs], + _ = [V = persistent_term:get(K) || {K,V} <- Kvs], + + %% Now delete the persistent terms in random order. + collisions_delete(lists:keysort(2, Kvs)), + + chk(Chk). + +collisions_delete([{Key,Val}|Kvs]) -> + Val = persistent_term:get(Key), + true = persistent_term:erase(Key), + true = lists:sort(persistent_term:get()) =:= lists:sort(Kvs), + _ = [V = persistent_term:get(K) || {K,V} <- Kvs], + collisions_delete(Kvs); +collisions_delete([]) -> + ok. + +colliding_keys() -> + %% Collisions found by Jesper L. Andersen for breaking maps. + L = [[764492191,2361333849], + [49527266765044,90940896816021,20062927283041,267080852079651], + [249858369443708,206247021789428,20287304470696,25847120931175], + [10645228898670,224705626119556,267405565521452,258214397180678], + [264783762221048,166955943492306,98802957003141,102012488332476], + [69425677456944,177142907243411,137138950917722,228865047699598], + [116031213307147,29203342183358,37406949328742,255198080174323], + [200358182338308,235207156008390,120922906095920,116215987197289], + [58728890318426,68877471005069,176496507286088,221041411345780], + [91094120814795,50665258299931,256093108116737,19777509566621], + [74646746200247,98350487270564,154448261001199,39881047281135], + [23408943649483,164410325820923,248161749770122,274558342231648], + [169531547115055,213630535746863,235098262267796,200508473898303], + [235098564415817,85039146398174,51721575960328,173069189684390], + [176136386396069,155368359051606,147817099696487,265419485459634], + [137542881551462,40028925519736,70525669519846,63445773516557], + [173854695142814,114282444507812,149945832627054,99605565798831], + [177686773562184,127158716984798,132495543008547], + [227073396444896,139667311071766,158915951283562], + [26212438434289,94902985796531,198145776057315], + [266279278943923,58550737262493,74297973216378], + [32373606512065,131854353044428,184642643042326], + [34335377662439,85341895822066,273492717750246]], + + %% Verify that the keys still collide (this will fail if the + %% internal hash function has been changed). + erts_debug:set_internal_state(available_internal_state, true), + try + case erlang:system_info(wordsize) of + 8 -> + verify_colliding_keys(L); + 4 -> + %% Not guaranteed to collide on a 32-bit system. + ok + end + after + erts_debug:set_internal_state(available_internal_state, false) + end, + + L. + +verify_colliding_keys([[K|Ks]|Gs]) -> + Hash = internal_hash(K), + [Hash] = lists:usort([internal_hash(Key) || Key <- Ks]), + verify_colliding_keys(Gs); +verify_colliding_keys([]) -> + ok. + +internal_hash(Term) -> + erts_debug:get_internal_state({internal_hash,Term}). + +%% Test that all persistent terms are erased by init:restart/0. + +init_restart(_Config) -> + File = "command_file", + ok = file:write_file(File, term_to_binary(restart)), + {ok,[[Erl]]} = init:get_argument(progname), + ModPath = filename:dirname(code:which(?MODULE)), + Cmd = Erl ++ " -pa " ++ ModPath ++ " -noshell " + "-run " ++ ?MODULE_STRING ++ " test_init_restart_cmd " ++ + File, + io:format("~s\n", [Cmd]), + Expected = "12ok", + case os:cmd(Cmd) of + Expected -> + ok; + Actual -> + io:format("Expected: ~s", [Expected]), + io:format("Actual: ~s\n", [Actual]), + ct:fail(unexpected_output) + end. + +test_init_restart_cmd([File]) -> + try + do_test_init_restart_cmd(File) + catch + C:R -> + io:format("\n~p ~p\n", [C,R]), + halt() + end, + receive + _ -> ok + end. + +do_test_init_restart_cmd(File) -> + {ok,Bin} = file:read_file(File), + Seq = lists:seq(1, 50), + case binary_to_term(Bin) of + restart -> + _ = [persistent_term:put({?MODULE,I}, {value,I}) || + I <- Seq], + ok = file:write_file(File, term_to_binary(was_restarted)), + io:put_chars("1"), + init:restart(), + receive + _ -> ok + end; + was_restarted -> + io:put_chars("2"), + ok = file:delete(File), + _ = [begin + Key = {?MODULE,I}, + {'EXIT',{badarg,_}} = (catch persistent_term:get(Key)) + end || I <- Seq], + io:put_chars("ok"), + init:stop() + end. + +%% Check that there is the same number of persistents terms before +%% and after each test case. + +chk() -> + persistent_term:info(). + +chk(Chk) -> + Chk = persistent_term:info(), + Key = {?MODULE,?FUNCTION_NAME}, + ok = persistent_term:put(Key, {term,Chk}), + Term = persistent_term:get(Key), + true = persistent_term:erase(Key), + chk_not_stuck(Term), + ok. + +chk_not_stuck(Term) -> + %% Hash tables to be deleted are put onto a queue. + %% Make sure that the queue isn't stuck by a table with + %% a non-zero ref count. + + case erts_debug:size_shared(Term) of + 0 -> + erlang:yield(), + chk_not_stuck(Term); + _ -> + ok + end. diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 4323849465..eb9b94a316 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -86,6 +86,7 @@ cd_relative/1, close_deaf_port/1, count_fds/1, + dropped_commands/1, dying_port/1, env/1, eof/1, @@ -108,7 +109,6 @@ 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, @@ -153,12 +153,12 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 10}}]. + {timetrap, {minutes, 1}}]. 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, huge_env, bad_env, cd, cd_relative, pipe_limit_env, bad_args, @@ -179,8 +179,7 @@ all() -> mon_port_bad_named, mon_port_pid_demonitor, mon_port_name_demonitor, - mon_port_driver_die, - mon_port_driver_die_demonitor + mon_port_driver_die ]. groups() -> @@ -548,6 +547,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. @@ -925,7 +965,7 @@ env_slave(File, Env) -> env_slave(File, Env, Body) -> file:write_file(File, term_to_binary(Body)), - Program = atom_to_list(lib:progname()), + Program = ct:get_progname(), Dir = filename:dirname(code:which(?MODULE)), Cmd = Program ++ " -pz " ++ Dir ++ " -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++ @@ -976,23 +1016,26 @@ try_bad_env(Env) -> %% Test that we can handle a very very large environment gracefully. huge_env(Config) when is_list(Config) -> ct:timetrap({minutes, 2}), - Vars = case os:type() of - {win32,_} -> 500; - _ -> - %% We create a huge environment, - %% 20000 variables is about 25MB - %% which seems to be the limit on Linux. - 20000 - end, + {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,"ls"},[exit_status, {env, Env}]) of + 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 @@ -1009,7 +1052,10 @@ huge_env(Config) when is_list(Config) -> %% Test to spawn program with command payload buffer %% just around pipe capacity (9f779819f6bda734c5953468f7798) pipe_limit_env(Config) when is_list(Config) -> - Cmd = "true", + 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 @@ -1026,7 +1072,7 @@ pipe_limit_env_do(Bytes, Cmd, CmdSize) -> try erlang:open_port({spawn,Cmd},[exit_status, {env, Env}]) of P -> receive - {P, {exit_status,N}} = M -> + {P, {exit_status,N}} -> %% Bug caused exit_status 150 (EINVAL+128) 0 = N end @@ -1039,7 +1085,7 @@ pipe_limit_env_do(Bytes, Cmd, CmdSize) -> %% environ format: KEY=VALUE\0 env_of_bytes(Bytes) when Bytes > 3 -> - Env = [{"X",lists:duplicate(Bytes-3, $x)}]; + [{"X",lists:duplicate(Bytes-3, $x)}]; env_of_bytes(_) -> []. %% White box assumption about payload written to pipe @@ -1083,7 +1129,7 @@ try_bad_args(Args) -> cd(Config) when is_list(Config) -> ct:timetrap({minutes, 1}), - Program = atom_to_list(lib:progname()), + Program = ct:get_progname(), DataDir = proplists:get_value(data_dir, Config), TestDir = filename:join(DataDir, "dir"), Cmd = Program ++ " -pz " ++ DataDir ++ @@ -1145,7 +1191,7 @@ cd(Config) when is_list(Config) -> %% be relative the new cwd and not the original cd_relative(Config) -> - Program = atom_to_list(lib:progname()), + Program = ct:get_progname(), DataDir = proplists:get_value(data_dir, Config), TestDir = filename:join(DataDir, "dir"), @@ -1168,7 +1214,7 @@ cd_relative(Config) -> relative_cd() -> - Program = atom_to_list(lib:progname()), + Program = ct:get_progname(), ok = file:set_cwd(".."), {ok, Cwd} = file:get_cwd(), @@ -1617,13 +1663,7 @@ spawn_executable(Config) when is_list(Config) -> [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, + ExeExt = filename:extension(ExactFile2), Executable2 = "spoky name"++ExeExt, file:copy(ExactFile1,filename:join([SpaceDir,Executable2])), ExactFile3 = filename:nativename(filename:join([SpaceDir,Executable2])), @@ -1791,7 +1831,7 @@ collect_data(Port) -> 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])]. %% Test that the emulator does not mix up ports when the port table wraps mix_up_ports(Config) when is_list(Config) -> @@ -1917,7 +1957,7 @@ 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). @@ -2063,13 +2103,13 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> 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 = (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; @@ -2128,7 +2168,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}, [], []). @@ -2289,7 +2329,7 @@ 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 -> @@ -2741,7 +2781,7 @@ mon_port_driver_die(Config) -> end, ok. - +-ifdef(DISABLED_TESTCASE). %% 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 @@ -2777,6 +2817,7 @@ mon_port_driver_die_demonitor(Config) -> after 5000 -> ?assert(false) end, ok. +-endif. %% @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 diff --git a/erts/emulator/test/port_SUITE_data/Makefile.src b/erts/emulator/test/port_SUITE_data/Makefile.src index fb7685c4b6..3a343e6d17 100644 --- a/erts/emulator/test/port_SUITE_data/Makefile.src +++ b/erts/emulator/test/port_SUITE_data/Makefile.src @@ -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/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 cc3ebdf0f8..fa97b4c9d0 100644 --- a/erts/emulator/test/port_SUITE_data/port_test.c +++ b/erts/emulator/test/port_SUITE_data/port_test.c @@ -10,6 +10,7 @@ #include <sys/types.h> #include <sys/stat.h> #include <fcntl.h> +#include <ctype.h> #ifndef __WIN32__ #include <unistd.h> @@ -33,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. */ @@ -105,9 +106,7 @@ int err; #endif -MAIN(argc, argv) -int argc; -char *argv[]; +int main(int argc, char *argv[]) { int ret, fd_count; if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) { @@ -377,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. @@ -387,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) @@ -558,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_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 index 5d9a75bcd3..eba8f194e0 100644 --- a/erts/emulator/test/port_trace_SUITE.erl +++ b/erts/emulator/test/port_trace_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -52,7 +52,7 @@ -define(ECHO_DRV_REMOTE_SEND_TERM, 15). suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 30}}]. + {timetrap, {minutes, 2}}]. all() -> [port_specs, ports, open_close, @@ -78,13 +78,6 @@ end_per_group(_GroupName, Config) -> Config. -init_per_testcase(driver_remote_send_term, Config) -> - case erlang:system_info(smp_support) of - false -> - {skip,"Only supported on smp systems"}; - true -> - init_per_testcase(driver_remote_send_term_smp, Config) - end; init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> erlang:trace(all, false, [all]), os:unsetenv("OUTPUTV"), @@ -209,8 +202,7 @@ ports(_Config) -> erlang:port_close(Prt), [{trace,Prt,closed,normal}, - {trace,Prt,unregister,port_trace_SUITE}, - {trace,Prt,unlink,S}] = flush(), + {trace,Prt,unregister,port_trace_SUITE}] = flush(), ok. @@ -482,8 +474,7 @@ failure_test(Failure, Reason) -> process_flag(trap_exit, false) end, [{trace, Prt, 'receive', {S, {command, Failure}}}, - {trace, Prt, closed, Reason}, - {trace, Prt, unlink, S}] = flush(), + {trace, Prt, closed, Reason}] = flush(), ok. @@ -606,13 +597,11 @@ close(Prt, Flags) -> if Recv, Ports -> [{trace, Prt, 'receive', {S, close}}, - {trace, Prt, closed, normal}, - {trace, Prt, unlink, S}] = flush(); + {trace, Prt, closed, normal}] = flush(); Recv -> [{trace, Prt, 'receive', {S, close}}] = flush(); Ports -> - [{trace, Prt, closed, normal}, - {trace, Prt, unlink, S}] = flush(); + [{trace, Prt, closed, normal}] = flush(); true -> [] = flush() end. diff --git a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c index b545523192..20ec33a594 100644 --- a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c +++ b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c @@ -2,23 +2,30 @@ #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 { - char *buf; - int len; + struct my_thread thread; ErlDrvTermData port; ErlDrvTermData caller; + int len; + char buf[1]; /* buf[len] */ }; #define ECHO_DRV_NOOP 0 @@ -86,7 +93,7 @@ static ErlDrvEntry echo_drv_entry = { NULL }; -static void send_term_thread(void *); +static void* send_term_thread(void *); /* ------------------------------------------------------------------------- ** Entry functions @@ -111,10 +118,22 @@ 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) { +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); } @@ -212,14 +231,14 @@ static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { } case ECHO_DRV_REMOTE_SEND_TERM: { - ErlDrvTid tid; - struct remote_send_term *t = malloc(sizeof(struct remote_send_term)); + struct remote_send_term *t = driver_alloc(sizeof(struct remote_send_term) + len); t->len = len-1; - t->buf = malloc(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", &tid, send_term_thread, t, NULL); + 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: @@ -262,7 +281,7 @@ static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data, return len-command; } -static void send_term_thread(void *a) +static void* send_term_thread(void *a) { struct remote_send_term *t = (struct remote_send_term*)a; ErlDrvTermData term[] = { @@ -273,5 +292,5 @@ static void send_term_thread(void *a) ERL_DRV_TUPLE, 3}; erl_drv_send_term(t->port, t->caller, term, sizeof(term) / sizeof(ErlDrvTermData)); - return; + 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 0f999e0efe..57eb082d64 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -42,8 +42,9 @@ process_info_lock_reschedule2/1, process_info_lock_reschedule3/1, process_info_garbage_collection/1, + process_info_smoke_all/1, + process_info_status_handled_signal/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_max_heap_size/1, @@ -58,6 +59,7 @@ no_priority_inversion2/1, system_task_blast/1, system_task_on_suspended/1, + system_task_failed_enqueue/1, gc_request_when_gc_disabled/1, gc_request_blast_when_gc_disabled/1]). -export([prio_server/2, prio_client/2, init/1, handle_event/2]). @@ -80,7 +82,8 @@ all() -> process_info_lock_reschedule2, process_info_lock_reschedule3, process_info_garbage_collection, - process_status_exiting, + process_info_smoke_all, + process_info_status_handled_signal, bump_reductions, low_prio, yield, yield2, otp_4725, bad_register, garbage_collect, process_info_messages, process_flag_badarg, process_flag_heap_size, @@ -104,7 +107,7 @@ groups() -> otp_7738_resume]}, {system_task, [], [no_priority_inversion, no_priority_inversion2, - system_task_blast, system_task_on_suspended, + system_task_blast, system_task_on_suspended, system_task_failed_enqueue, gc_request_when_gc_disabled, gc_request_blast_when_gc_disabled]}]. init_per_suite(Config) -> @@ -134,6 +137,11 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> [{testcase, Func}|Config]. end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + %% Restore max_heap_size to default value. + erlang:system_flag(max_heap_size, + #{size => 0, + kill => true, + error_logger => true}), ok. fun_spawn(Fun) -> @@ -147,7 +155,11 @@ 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, - test_server:do_times(150, Fun), + Iter = case test_server:is_valgrind() of + true -> 10; + false -> 150 + end, + test_server:do_times(Iter, Fun), ok. binary_owner(Bin) when is_binary(Bin) -> @@ -437,11 +449,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, @@ -492,14 +515,20 @@ pio_current_location(N, Pid, Pi, Looper) -> case Where of {erlang,process_info,2,[]} -> pio_current_location(N-1, Pid, Pi+1, Looper); + {erts_internal,await_result,1, Loc} when is_list(Loc) -> + pio_current_location(N-1, Pid, Pi+1, Looper); {?MODULE,process_info_looper,1,Loc} when is_list(Loc) -> - pio_current_location(N-1, Pid, Pi, Looper+1) + pio_current_location(N-1, Pid, Pi, Looper+1); + _ -> + exit({unexpected_location, Where}) end. pio_current_stacktrace() -> L = [begin - {current_stacktrace,Stk} = process_info(P, current_stacktrace), - {P,Stk} + case process_info(P, current_stacktrace) of + {current_stacktrace, Stk} -> {P,Stk}; + undefined -> {P, []} + end end || P <- processes()], [erlang:garbage_collect(P) || {P,_} <- L], erlang:garbage_collect(), @@ -661,7 +690,7 @@ chk_pi_order([{Arg, _}| Values], [Arg|Args]) -> chk_pi_order(Values, Args). 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), @@ -821,28 +850,6 @@ process_info_lock_reschedule3(Config) when is_list(Config) -> ct:fail(BadStatus) end. -process_status_exiting(Config) when is_list(Config) -> - %% Make sure that erts_debug:get_internal_state({process_status,P}) - %% returns exiting if it is in status P_EXITING. - erts_debug:set_internal_state(available_internal_state,true), - Prio = process_flag(priority, max), - P = spawn_opt(fun () -> receive after infinity -> ok end end, - [{priority, normal}]), - erlang:yield(), - %% The tok_loop processes are here to make it hard for the exiting - %% process to be scheduled in for exit... - TokLoops = lists:map(fun (_) -> - spawn_opt(fun tok_loop/0, - [link,{priority, high}]) - end, lists:seq(1, erlang:system_info(schedulers_online))), - exit(P, boom), - wait_until(fun() -> - exiting =:= erts_debug:get_internal_state({process_status,P}) - end), - lists:foreach(fun (Tok) -> unlink(Tok), exit(Tok,bang) end, TokLoops), - process_flag(priority, Prio), - ok. - otp_4725(Config) when is_list(Config) -> Tester = self(), Ref1 = make_ref(), @@ -977,10 +984,110 @@ process_info_garbage_collection(_Config) -> gv(Key,List) -> proplists:get_value(Key,List). +process_info_smoke_all_tester() -> + register(process_info_smoke_all_tester, self()), + put(ets_ref, ets:new(blupp, [])), + put(binary, [list_to_binary(lists:duplicate(1000, 1)), + list_to_binary(lists:duplicate(1000, 2))]), + process_info_smoke_all_tester_loop(). + +process_info_smoke_all_tester_loop() -> + receive + {other_process, Pid} -> + case get(procs) of + undefined -> put(procs, [Pid]); + Procs -> put(procs, [Pid|Procs]) + end, + erlang:monitor(process, Pid), + link(Pid), + process_info_smoke_all_tester_loop() + end. + +process_info_smoke_all(Config) when is_list(Config) -> + AllPIOptions = [registered_name, + current_function, + initial_call, + messages, + message_queue_len, + links, + monitors, + monitored_by, + dictionary, + trap_exit, + error_handler, + heap_size, + stack_size, + memory, + garbage_collection, + group_leader, + reductions, + priority, + trace, + binary, + sequential_trace_token, + catchlevel, + backtrace, + last_calls, + total_heap_size, + suspending, + min_heap_size, + min_bin_vheap_size, + max_heap_size, + current_location, + current_stacktrace, + message_queue_data, + garbage_collection_info, + magic_ref, + fullsweep_after], + + {ok, Node} = start_node(Config, ""), + RP = spawn_link(Node, fun process_info_smoke_all_tester/0), + LP = spawn_link(fun process_info_smoke_all_tester/0), + RP ! {other_process, LP}, + LP ! {other_process, RP}, + LP ! {other_process, self()}, + LP ! ets:new(blapp, []), + LP ! ets:new(blipp, []), + LP ! list_to_binary(lists:duplicate(1000, 3)), + receive after 1000 -> ok end, + _MLP = erlang:monitor(process, LP), + true = is_process_alive(LP), + PI = process_info(LP, AllPIOptions), + io:format("~p~n", [PI]), + garbage_collect(), + unlink(RP), + unlink(LP), + exit(RP, kill), + exit(LP, kill), + false = is_process_alive(LP), + stop_node(Node), + ok. + +process_info_status_handled_signal(Config) when is_list(Config) -> + P = spawn_link(fun () -> + receive after infinity -> ok end + end), + wait_until(fun () -> + process_info(P, status) == {status, waiting} + end), + %% + %% The 'messages' option will force a process-info-request + %% signal to be scheduled on the process. Ensure that status + %% 'waiting' is reported even though it is actually running + %% when handling the request. We want it to report the status + %% it would have had if it had not been handling the + %% process-info-request... + %% + [{status, waiting}, {messages, []}] = process_info(P, [status, messages]), + unlink(P), + exit(P, kill), + false = erlang:is_process_alive(P), + ok. + %% Tests erlang:bump_reductions/1. bump_reductions(Config) when is_list(Config) -> erlang:garbage_collect(), - receive after 1 -> ok end, % Clear reductions. + erlang:yield(), % Clear reductions. {reductions,R1} = process_info(self(), reductions), true = erlang:bump_reductions(100), {reductions,R2} = process_info(self(), reductions), @@ -1013,36 +1120,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)), - ct:sleep({seconds,3}), + 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 @@ -1086,9 +1205,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, @@ -1611,6 +1730,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], @@ -1620,6 +1740,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) -> @@ -1658,7 +1787,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(), @@ -1671,7 +1800,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]), @@ -1711,10 +1840,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(), @@ -1923,7 +2052,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(), @@ -1933,7 +2062,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]), @@ -2036,6 +2165,7 @@ max_heap_size_test(Option, Size, Kill, ErrorLogger) -> end, if ErrorLogger -> receive + %% There must be at least one error message. {error, _, {emulator, _, [Pid|_]}} -> ok end; @@ -2048,22 +2178,33 @@ max_heap_size_test(Option, Size, Kill, ErrorLogger) -> {'DOWN', Ref, process, Pid, die} -> ok end, - flush(); + %% 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 - M -> - ct:fail({unexpected_message, M}) - after 10 -> + {error, _, {emulator, _, [Pid|_]}} -> + receive_error_messages(Pid) + after 1000 -> ok end. -flush() -> +receive_unexpected() -> receive - _M -> - flush() - after 1000 -> + {info_report, _, _} -> + %% May be an alarm message from os_mon. Ignore. + receive_unexpected(); + M -> + ct:fail({unexpected_message, M}) + after 10 -> ok end. @@ -2077,36 +2218,44 @@ handle_event(Event, Pid) -> processes_term_proc_list(Config) when is_list(Config) -> Tester = self(), - as_expected = processes_term_proc_list_test(false), - {ok, Node} = start_node(Config, "+Mis true"), - RT = spawn_link(Node, fun () -> - receive after 1000 -> ok end, - processes_term_proc_list_test(false), - Tester ! {it_worked, self()} - end), - receive {it_worked, RT} -> ok end, - stop_node(Node), + + Run = fun(Args) -> + {ok, Node} = start_node(Config, Args), + RT = spawn_link(Node, fun () -> + receive after 1000 -> ok end, + as_expected = processes_term_proc_list_test(false), + Tester ! {it_worked, self()} + end), + receive {it_worked, RT} -> ok end, + stop_node(Node) + end, + + %% We have to run this test case with +S1 since instrument:allocations() + %% will report a free()'d block as present until it's actually deallocated + %% by its employer. + Run("+MSe true +MSatags false +S1"), + Run("+MSe true +MSatags true +S1"), + ok. - + -define(CHK_TERM_PROC_LIST(MC, XB), chk_term_proc_list(?LINE, MC, XB)). chk_term_proc_list(Line, MustChk, ExpectBlks) -> - case {MustChk, instrument:memory_status(types)} of - {false, false} -> + Allocs = instrument:allocations(#{ allocator_types => [sl_alloc] }), + case {MustChk, Allocs} of + {false, {error, not_enabled}} -> not_enabled; - {_, MS} -> - {value, - {ptab_list_deleted_el, - DL}} = lists:keysearch(ptab_list_deleted_el, 1, MS), - case lists:keysearch(blocks, 1, DL) of - {value, {blocks, ExpectBlks, _, _}} -> - ok; - {value, {blocks, Blks, _, _}} -> - exit({line, Line, - mismatch, expected, ExpectBlks, actual, Blks}); - Unexpected -> - exit(Unexpected) + {_, {ok, {_Shift, _Unscanned, ByOrigin}}} -> + ByType = maps:get(system, ByOrigin, #{}), + Hist = maps:get(ptab_list_deleted_el, ByType, {}), + case lists:sum(tuple_to_list(Hist)) of + ExpectBlks -> + ok; + Blks -> + exit({line, Line, mismatch, + expected, ExpectBlks, + actual, Blks}) end end, ok. @@ -2140,7 +2289,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(), @@ -2150,7 +2299,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]), @@ -2211,7 +2360,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), @@ -2220,7 +2369,7 @@ 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. @@ -2428,7 +2577,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) -> @@ -2477,9 +2626,65 @@ system_task_on_suspended(Config) when is_list(Config) -> ok end. +%% When a system task couldn't be enqueued due to the process being in an +%% incompatible state, it would linger in the system task list and get executed +%% anyway the next time the process was scheduled. This would result in a +%% double-free at best. +%% +%% This test continuously purges modules while other processes run dirty code, +%% which will provoke this error as ERTS_PSTT_CPC can't be enqueued while a +%% process is running dirty code. +system_task_failed_enqueue(Config) when is_list(Config) -> + case erlang:system_info(dirty_cpu_schedulers) of + N when N > 0 -> + system_task_failed_enqueue_1(Config); + _ -> + {skipped, "No dirty scheduler support"} + end. + +system_task_failed_enqueue_1(Config) -> + Priv = proplists:get_value(priv_dir, Config), + + Purgers = [spawn_link(fun() -> purge_loop(Priv, Id) end) + || Id <- lists:seq(1, erlang:system_info(schedulers))], + Hogs = [spawn_link(fun() -> dirty_loop() end) + || _ <- lists:seq(1, erlang:system_info(dirty_cpu_schedulers))], + + ct:sleep(5000), + + [begin + unlink(Pid), + exit(Pid, kill) + end || Pid <- (Purgers ++ Hogs)], + + ok. + +purge_loop(PrivDir, Id) -> + Mod = "failed_enq_" ++ integer_to_list(Id), + Path = PrivDir ++ "/" ++ Mod, + file:write_file(Path ++ ".erl", + "-module('" ++ Mod ++ "').\n" ++ + "-export([t/0]).\n" ++ + "t() -> ok."), + purge_loop_1(Path). +purge_loop_1(Path) -> + {ok, Mod} = compile:file(Path, []), + erlang:delete_module(Mod), + erts_code_purger:purge(Mod), + purge_loop_1(Path). + +dirty_loop() -> + ok = erts_debug:dirty_cpu(reschedule, 10000), + dirty_loop(). + gc_request_when_gc_disabled(Config) when is_list(Config) -> - Master = self(), AIS = erts_debug:set_internal_state(available_internal_state, true), + gc_request_when_gc_disabled_do(ref), + gc_request_when_gc_disabled_do(immed), + erts_debug:set_internal_state(available_internal_state, AIS). + +gc_request_when_gc_disabled_do(ReqIdType) -> + Master = self(), {P, M} = spawn_opt(fun () -> true = erts_debug:set_internal_state(gc_state, false), @@ -2491,7 +2696,10 @@ gc_request_when_gc_disabled(Config) when is_list(Config) -> receive after 100 -> ok end end, [monitor, link]), receive {P, gc_state, false} -> ok end, - ReqId = make_ref(), + ReqId = case ReqIdType of + ref -> make_ref(); + immed -> immed + end, async = garbage_collect(P, [{async, ReqId}]), receive {garbage_collect, ReqId, Result} -> @@ -2500,7 +2708,6 @@ gc_request_when_gc_disabled(Config) when is_list(Config) -> ok end, receive {garbage_collect, ReqId, true} -> ok end, - erts_debug:set_internal_state(available_internal_state, AIS), receive {'DOWN', M, process, P, _Reason} -> ok end, ok. diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl index 83653a7a36..1fe11428b4 100644 --- a/erts/emulator/test/receive_SUITE.erl +++ b/erts/emulator/test/receive_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% 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. @@ -25,39 +25,56 @@ -include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0, - call_with_huge_message_queue/1,receive_in_between/1]). + call_with_huge_message_queue/1,receive_in_between/1, + receive_opt_exception/1,receive_opt_recursion/1]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 3}}]. -all() -> - [call_with_huge_message_queue, receive_in_between]. - -groups() -> - []. +all() -> + [call_with_huge_message_queue, receive_in_between, + receive_opt_exception, receive_opt_recursion]. 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 -> - ct:fail("Best Q = ~p", [Q]) - 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) -> @@ -98,6 +115,60 @@ receive_one() -> dummy -> ok end. +receive_opt_exception(_Config) -> + Recurse = fun() -> + %% Overwrite with the same mark, + %% and never consume it. + ThrowFun = fun() -> throw(aborted) end, + aborted = (catch do_receive_opt_exception(ThrowFun)), + ok + end, + do_receive_opt_exception(Recurse), + + %% Eat the second message. + receive + Ref when is_reference(Ref) -> ok + end. + +do_receive_opt_exception(Disturber) -> + %% Create a receive mark. + Ref = make_ref(), + self() ! Ref, + Disturber(), + receive + Ref -> + ok + after 0 -> + error(the_expected_message_was_not_there) + end. + +receive_opt_recursion(_Config) -> + Recurse = fun() -> + %% Overwrite with the same mark, + %% and never consume it. + NoOp = fun() -> ok end, + BlackHole = spawn(NoOp), + expected = do_receive_opt_recursion(BlackHole, NoOp, true), + ok + end, + do_receive_opt_recursion(self(), Recurse, false), + ok. + +do_receive_opt_recursion(Recipient, Disturber, IsInner) -> + Ref = make_ref(), + Recipient ! Ref, + Disturber(), + receive + Ref -> ok + after 0 -> + case IsInner of + true -> + expected; + false -> + error(the_expected_message_was_not_there) + end + end. + %%% %%% Common helpers. %%% @@ -108,6 +179,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 5f519d522e..925c30caa5 100644 --- a/erts/emulator/test/ref_SUITE.erl +++ b/erts/emulator/test/ref_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -22,6 +22,7 @@ -export([all/0, suite/0]). -export([wrap_1/1]). +-export([compare_list/1, compare_ets/1]). -export([loop_ref/1]). @@ -32,7 +33,7 @@ suite() -> {timetrap, {minutes, 2}}]. all() -> - [wrap_1]. + [wrap_1, compare_list, compare_ets]. %% Check that refs don't wrap around easily. wrap_1(Config) when is_list(Config) -> @@ -53,3 +54,28 @@ loop_ref(Parent) -> loop_ref(R, R, _) -> ok; loop_ref(R0, _, N) -> loop_ref(R0, make_ref(), N+1). + +%% Check that ref ordering works +compare_list(Config) when is_list(Config) -> + %% Although this test uses external refs, it would apply the same to plain refs + ExtRef1 = <<131,114,0,3,100,0,3,110,64,98,3, 0,0,173,156, 0,216,0,4, 0,0,0,0>>, + ExtRef2 = <<131,114,0,3,100,0,3,110,64,98,3, 0,1,31,27, 129,4,0,1, 0,0,0,0>>, + + Ref1 = binary_to_term(ExtRef1), %% #Ref<[email protected]> + Ref2 = binary_to_term(ExtRef2), %% #Ref<[email protected]> + OrderedList = [Ref1, Ref2], + OrderedList = lists:sort(OrderedList), + ok. + +%% This is the scarier case since it makes terms "invisible" in ets or Mnesia +%% (the underlying fault cause is the same as compare_list/1) +compare_ets(Config) when is_list(Config) -> + W2s = [610350147,899574699,2994196869,686384822,2397690439, 923302211], + ExtRefBase = <<131,114,0,3,100,0,3,110,64,98,3>>, + ExtRefs = [<<ExtRefBase/binary, 1:32, W2:32, 0:32>> || W2 <- W2s], + Refs = [binary_to_term(Bin) || Bin <- ExtRefs], + + Ets = ets:new(refbug, [ordered_set]), + ets:insert(Ets, [{Ref,Ref} || Ref <- Refs]), + 0 = length([R || R <- ets:tab2list(Ets), ets:lookup(Ets, element(1,R)) == []]), + ok. diff --git a/erts/emulator/test/register_SUITE.erl b/erts/emulator/test/register_SUITE.erl index 43ae749498..a7c0acbf17 100644 --- a/erts/emulator/test/register_SUITE.erl +++ b/erts/emulator/test/register_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-2018. 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. @@ -44,14 +44,7 @@ all() -> -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; diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 3aee15a8fc..2e0dfa42f3 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2018. 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. @@ -57,6 +57,7 @@ scheduler_suspend_basic/1, scheduler_suspend/1, dirty_scheduler_threads/1, + poll_threads/1, reader_groups/1]). suite() -> @@ -72,6 +73,7 @@ all() -> {group, scheduler_bind}, scheduler_threads, scheduler_suspend_basic, scheduler_suspend, dirty_scheduler_threads, + poll_threads, reader_groups]. groups() -> @@ -799,7 +801,7 @@ update_cpu_info(Config) when is_list(Config) -> unchanged -> ok; changed -> ok end; - {Avail, _} -> + {_Avail, _} -> try adjust_schedulers_online(), case erlang:system_info(schedulers_online) of @@ -807,21 +809,31 @@ update_cpu_info(Config) when is_list(Config) -> %% Nothing much to test; just a smoke test ok; Onln0 -> - %% unset least significant bit - Aff = (OldAff band (OldAff - 1)), - set_affinity_mask(Aff), - Onln1 = Avail - 1, - 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 + 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), @@ -835,22 +847,56 @@ update_cpu_info(Config) when is_list(Config) -> 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; @@ -1037,26 +1083,18 @@ sbt_test(Config, CpuTCmd, ClBt, Bt, LP) -> 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,8 +1117,8 @@ scheduler_threads(Config) when is_list(Config) -> ResetCmd = "+S "++FourSched++":"++FourSchedOnln++" +S 0:0", {LProc, LProcAvail, _} = get_sstate(Config, ResetCmd), %% Test negative +S settings, but only for SMP-enabled emulators - case {SmpSupport, LProc > 1, LProcAvail > 1} of - {true, true, true} -> + case {LProc > 1, LProcAvail > 1} of + {true, true} -> SchedMinus1 = LProc-1, SchedOnlnMinus1 = LProcAvail-1, {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1"), @@ -1095,23 +1133,15 @@ scheduler_threads(Config) when is_list(Config) -> 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,9 +1153,6 @@ 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) -> @@ -1374,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) -> @@ -1422,6 +1446,82 @@ sst5_loop(N) -> 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, ""), + + if + Conc -> + [1, 1, 1] = get_ionum(Config,"+IOt 2 +IOp 2"), + [1, 1, 1, 1, 1, 1] = get_ionum(Config,"+IOt 5 +IOp 5"), + [1, 1, 1] = get_ionum(Config, "+S 2 +IOPt 100 +IOPp 100"), + + [5, 1] = get_ionum(Config,"+IOt 5 +IOp 1"), + [3, 2, 1] = get_ionum(Config,"+IOt 5 +IOp 2"), + [2, 2, 2, 2, 2, 1] = get_ionum(Config,"+IOt 10 +IOPp 50"), + + [2, 1] = get_ionum(Config, "+S 2 +IOPt 100"), + [4, 1] = get_ionum(Config, "+S 4 +IOPt 100"), + [4, 1] = get_ionum(Config, "+S 4:2 +IOPt 100"), + [4, 4, 1] = get_ionum(Config, "+S 8 +IOPt 100 +IOPp 25"), + + fail = get_ionum(Config, "+IOt 1 +IOp 2"), + + ok; + not Conc -> + [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"), + + [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... @@ -1746,18 +1846,24 @@ 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 + 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) -> + lists:map(fun ({Ref, MRef}) -> receive {Ref, Res} -> - Res + receive + {'DOWN',MRef,_,_,_} -> + Res + end; + {'DOWN',MRef,_,_,Reason} -> + Reason end end, Refs). @@ -2052,7 +2158,7 @@ workers_exit([Ps|Pss]) -> workers_exit(Pss). do_work(PartTime) -> - lists:reverse(lists:seq(1, 50)), + _ = id(lists:seq(1, 50)), receive stop_work -> receive after infinity -> ok end after 0 -> ok end, case PartTime of true -> receive after 1 -> ok end; @@ -2060,6 +2166,8 @@ do_work(PartTime) -> end, do_work(PartTime). +id(I) -> I. + workers(N, _Prio, _PartTime) when N =< 0 -> []; workers(N, Prio, PartTime) -> diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl index c3e303bbd1..206d2c1bfc 100644 --- a/erts/emulator/test/sensitive_SUITE.erl +++ b/erts/emulator/test/sensitive_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2016. All Rights Reserved. +%% Copyright Ericsson AB 2007-2018. 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. @@ -413,7 +413,7 @@ my_process_info(Pid, Tag) -> t_process_display(Config) when is_list(Config) -> Dir = filename:dirname(code:which(?MODULE)), - Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++ + Cmd = ct:get_progname() ++ " -noinput -pa " ++ Dir ++ " -run " ++ ?MODULE_STRING ++ " remote_process_display", io:put_chars(Cmd), P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]), diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl index 7e516176f7..4e6baa9e0e 100644 --- a/erts/emulator/test/signal_SUITE.erl +++ b/erts/emulator/test/signal_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-2018. 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. @@ -34,50 +34,26 @@ -export([init_per_testcase/2, end_per_testcase/2]). % Test cases --export([xm_sig_order/1, - pending_exit_unlink_process/1, - pending_exit_unlink_dist_process/1, - pending_exit_unlink_port/1, - pending_exit_trap_exit/1, - pending_exit_receive/1, - pending_exit_exit/1, - pending_exit_gc/1, - pending_exit_is_process_alive/1, - pending_exit_process_display/1, - pending_exit_process_info_1/1, - pending_exit_process_info_2/1, - pending_exit_group_leader/1, - exit_before_pending_exit/1]). +-export([xm_sig_order/1]). init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - available_internal_state(true), [{testcase, Func}|Config]. -end_per_testcase(_Func, Config) -> +end_per_testcase(_Func, _Config) -> ok. init_per_suite(Config) -> Config. end_per_suite(_Config) -> - available_internal_state(true), - catch erts_debug:set_internal_state(not_running_optimization, true), - available_internal_state(false). + ok. suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 2}}]. all() -> - [xm_sig_order, pending_exit_unlink_process, - pending_exit_unlink_dist_process, - pending_exit_unlink_port, pending_exit_trap_exit, - pending_exit_receive, pending_exit_trap_exit, - pending_exit_gc, pending_exit_is_process_alive, - pending_exit_process_display, - pending_exit_process_info_1, - pending_exit_process_info_2, pending_exit_group_leader, - exit_before_pending_exit]. + [xm_sig_order]. %% Test that exit signals and messages are received in correct order @@ -109,371 +85,13 @@ xm_sig_order_proc() -> receive may_not_reach -> exit(bad_signal_order); may_reach -> ok - after 0 -> ok + after 0 -> erlang:yield() end, xm_sig_order_proc(). -pending_exit_unlink_process(Config) when is_list(Config) -> - pending_exit_test(self(), unlink). - -pending_exit_unlink_dist_process(Config) when is_list(Config) -> - {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) -> - pending_exit_test(hd(erlang:ports()), unlink). - -pending_exit_trap_exit(Config) when is_list(Config) -> - pending_exit_test(self(), trap_exit). - -pending_exit_receive(Config) when is_list(Config) -> - pending_exit_test(self(), 'receive'). - -pending_exit_exit(Config) when is_list(Config) -> - pending_exit_test(self(), exit). - -pending_exit_gc(Config) when is_list(Config) -> - pending_exit_test(self(), gc). - -pending_exit_test(From, Type) -> - case catch erlang:system_info(smp_support) of - true -> - 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."}; - _ -> - {skipped, "SMP support not enabled. Test only valid with current SMP emulator."} - end. - - - -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. - 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} -> - process_flag(trap_exit, OTE), - ok; - Msg -> - ct:fail({unexpected_message, Msg}) - end, - NoScheds = integer_to_list(erlang:system_info(schedulers_online)), - {comment, - "Was " - ++ case PendingExit of - true -> ""; - false ->"*not*" - end ++ " able to trigger a pending exit. " - ++ "Running on " ++ NoScheds ++ " scheduler(s). " - ++ "This test is only interesting with at least two schedulers."}. - --define(PE_INFO_REPEAT, 100). - -pending_exit_is_process_alive(Config) when is_list(Config) -> - 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) -> - S = exit_op_test_init(), - TestFun = fun (P) -> - undefined = process_info(P) - end, - repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - verify_pending_exit_success(S), - comment(). - -pending_exit_process_info_2(Config) when is_list(Config) -> - S0 = exit_op_test_init(), - repeated_exit_op_test(fun (P) -> - undefined = process_info(P, messages) - end, ?PE_INFO_REPEAT), - S1 = verify_pending_exit_success(S0), - repeated_exit_op_test(fun (P) -> - undefined = process_info(P, status) - end, ?PE_INFO_REPEAT), - S2 = verify_pending_exit_success(S1), - repeated_exit_op_test(fun (P) -> - undefined = process_info(P, links) - end, ?PE_INFO_REPEAT), - S3 = verify_pending_exit_success(S2), - repeated_exit_op_test(fun (P) -> - undefined = process_info(P, [messages]) - end, ?PE_INFO_REPEAT), - S4 = verify_pending_exit_success(S3), - repeated_exit_op_test(fun (P) -> - undefined = process_info(P, [status]) - end, ?PE_INFO_REPEAT), - S5 = verify_pending_exit_success(S4), - repeated_exit_op_test(fun (P) -> - undefined = process_info(P, [links]) - end, ?PE_INFO_REPEAT), - S6 = verify_pending_exit_success(S5), - repeated_exit_op_test(fun (P) -> - undefined = process_info(P, [status, - links]) - end, ?PE_INFO_REPEAT), - S7 = verify_pending_exit_success(S6), - repeated_exit_op_test(fun (P) -> - undefined = process_info(P, [messages, - status]) - end, ?PE_INFO_REPEAT), - S8 = verify_pending_exit_success(S7), - repeated_exit_op_test(fun (P) -> - undefined = process_info(P, [messages, - links]) - end, ?PE_INFO_REPEAT), - S9 = verify_pending_exit_success(S8), - repeated_exit_op_test( - fun (P) -> - undefined = process_info(P, [message_queue_len, - status]) - end, ?PE_INFO_REPEAT), - S10 = verify_pending_exit_success(S9), - repeated_exit_op_test(fun (P) -> - undefined = process_info(P, [messages, - links, - status]) - end, ?PE_INFO_REPEAT), - verify_pending_exit_success(S10), - comment(). - -pending_exit_process_display(Config) when is_list(Config) -> - S = exit_op_test_init(), - TestFun = fun (P) -> - badarg = try - erlang:process_display(P, backtrace) - catch - error:badarg -> badarg - end - end, - repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - verify_pending_exit_success(S), - comment(). - -pending_exit_group_leader(Config) when is_list(Config) -> - S = exit_op_test_init(), - TestFun = fun (P) -> - badarg = try - group_leader(self(), P) - catch - error:badarg -> badarg - end - end, - repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - verify_pending_exit_success(S), - comment(). - %% %% -- Internal utils -------------------------------------------------------- %% -exit_op_test_init() -> - put(no_pending_exit_success, 0), - put(no_pending_exit_tries, 0), - {case {erlang:system_info(run_queues), - erlang:system_info(schedulers_online)} of - {RQ, SO} when RQ =:= 1; SO =:= 1 -> false; - _ -> true - end, 0, 0}. - -verify_pending_exit_success({false, _, _} = S) -> - S; -verify_pending_exit_success({true, S, T}) -> - NewS = get(no_pending_exit_success), - NewT = get(no_pending_exit_tries), - case NewT =:= T of - true -> ok; - _ -> case NewS > S of - true -> ok; - _ -> exit(no_pending_exits) - end - end, - {true, NewS, NewT}. - -comment() -> - {comment, - "Pending exit trigger ratio " - ++ integer_to_list(get(no_pending_exit_success)) - ++ "/" - ++ integer_to_list(get(no_pending_exit_tries)) - ++ "." - ++ case get(not_running_opt_test) of - true -> " No 'not running optimization' to disable."; - _ -> "" - end}. - -repeated_exit_op_test(TestFun, N) -> - WorkFun0 = fun () -> - lists:sort(lists:reverse(lists:seq(1, 1000))) - end, - repeat(fun () -> exit_op_test(TestFun, WorkFun0) end, N), - try erts_debug:set_internal_state(not_running_optimization, false) of - Bool when Bool == true; Bool == false -> - WorkFun1 = fun () -> - erts_debug:set_internal_state(sleep, 0), - lists:sort(lists:reverse(lists:seq(1, 1000))) - end, - repeat(fun () -> - exit_op_test(TestFun, WorkFun1) - end, N) - catch - error:notsup -> put(not_running_opt_test, true) - after - catch erts_debug:set_internal_state(not_running_optimization, true) - end. - -exit_op_test(TestFun, WorkFun) -> - 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, - Master = self(), - Going = make_ref(), - P = spawn_opt(fun () -> - loop(10, WorkFun), - Master ! Going, - loop(infinity, WorkFun) - end, Opts), - receive Going -> ok end, - loop(10, WorkFun), - erlang:yield(), - exit(P, bang), - PE0 = have_pending_exit(P), - TestFun(P), - PE = case PE0 of - true -> true; - _ -> false - end, - case {PE, get(no_pending_exit_success), get(no_pending_exit_tries)} of - {true, undefined, undefined} -> - put(no_pending_exit_success, 1), - put(no_pending_exit_tries, 1); - {false, undefined, undefined} -> - put(no_pending_exit_success, 0), - put(no_pending_exit_tries, 1); - {true, S, T} -> - put(no_pending_exit_success, S+1), - put(no_pending_exit_tries, T+1); - {false, _S, T} -> - put(no_pending_exit_tries, T+1) - end, - ok. - -loop(infinity, WorkFun) -> - do_loop(infinity, WorkFun); -loop(0, _WorkFun) -> - ok; -loop(N, WorkFun) when is_integer(N) -> - do_loop(N-1, WorkFun). - -do_loop(N, WorkFun) -> - WorkFun(), - loop(N, WorkFun). repeat(_Fun, N) when is_integer(N), N =< 0 -> ok; @@ -491,30 +109,3 @@ start_node(Config) -> stop_node(Node) -> test_server:stop_node(Node). - -have_pending_exit() -> - have_pending_exit(self()). - -have_pending_exit(Pid) -> - erts_debug:get_internal_state({have_pending_exit, Pid}). - -force_gc() -> - erts_debug:set_internal_state(force_gc, self()). - -fake_exit(From, To, Reason) -> - erts_debug:set_internal_state(send_fake_exit_signal, {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 - end. diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl index 5eccdc562b..26c610e3a8 100644 --- a/erts/emulator/test/smoke_test_SUITE.erl +++ b/erts/emulator/test/smoke_test_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2016. All Rights Reserved. +%% Copyright Ericsson AB 2011-2018. 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. @@ -66,17 +66,24 @@ 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), + + WBTArgs = ["very_short", "short", "medium", "long", "very_long"], + WTArgs = ["very_low", "low", "medium", "high", "very_high"], + [chk_boot(Config, + " +sbwt " ++ WBT ++ + " +sbwtdcpu " ++ WBT ++ + " +sbwtdio " ++ WBT ++ + " +swt " ++ WT ++ + " +swtdcpu " ++ WT ++ + " +swtdio " ++ WT, NOOP) || WBT <- WBTArgs, WT <- WTArgs], + + WSArgs = ["legacy", "default"], + [chk_boot(Config, " +sws " ++ WS, NOOP) || WS <- WSArgs], + %% A lot more combos could be implemented... ok after @@ -95,11 +102,9 @@ native_atomics(Config) when is_list(Config) -> {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", _} -> + case {erlang:system_info(build_type), NA32, NA64, DWNA} of + {opt, "no", "no", _} -> ct:fail(optimized_smp_runtime_without_native_atomics); - {_, false, "no", "no", _} -> - {comment, "No native atomics"}; _ -> {comment, NA32 ++ " 32-bit, " diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index a1f12ba93c..ae3099633a 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -23,11 +23,15 @@ %% Tests the statistics/1 bif. -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, run_queues_lengths_active_tasks/1, msacc/1]). @@ -43,18 +47,32 @@ suite() -> all() -> [{group, wall_clock}, {group, runtime}, reductions, - reductions_big, {group, run_queue}, scheduler_wall_time, + 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]}]. +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. + %%% Testing statistics(wall_clock). %% Tests that the 'Wall clock since last call' element of the result @@ -98,6 +116,20 @@ 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. %% Tests that the difference between the times returned from two consectuitive %% calls to statistics(runtime) is zero. @@ -271,35 +303,71 @@ hog_iter(0, Mon) -> %% 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) -> + case string:find(erlang:system_info(system_version), + "dirty-schedulers-TEST") == nomatch of + true -> run_scheduler_wall_time_test(Type); + false -> {skip, "Cannot be run with dirty-schedulers-TEST build"} + end. + +run_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), + 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(), + EmptyLoad = get_load(Type), {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad}, MeMySelfAndI = self(), StartHog = fun() -> - Pid = spawn(?MODULE, hog, [self()]), + 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(), + _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)], - HalfLoad = lists:sum(get_load()) div Schedulers, + 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; @@ -308,23 +376,30 @@ scheduler_wall_time(Config) when is_list(Config) -> %% 100% load LastHogs = [StartHog() || _ <- lists:seq(1, Schedulers div 2)], - FullScheds = get_load(), + 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 Schedulers, + 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++LastHogs]], - AfterLoad = get_load(), + [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) @@ -332,16 +407,81 @@ scheduler_wall_time(Config) when is_list(Config) -> erlang:system_flag(scheduler_wall_time, false) end. -get_load() -> - Start = erlang:statistics(scheduler_wall_time), +get_load(Type) -> + Start = erlang:statistics(Type), timer:sleep(1500), - End = erlang:statistics(scheduler_wall_time), + 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. %% Tests that statistics(garbage_collection) is callable. %% It is not clear how to test anything more. @@ -388,7 +528,7 @@ badarg(Config) when is_list(Config) -> tok_loop() -> tok_loop(). -run_queues_lengths_active_tasks(Config) -> +run_queues_lengths_active_tasks(_Config) -> TokLoops = lists:map(fun (_) -> spawn_opt(fun () -> tok_loop() @@ -397,20 +537,37 @@ run_queues_lengths_active_tasks(Config) -> 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), - NoScheds = length(RQLs0), - NoScheds = length(ATs0), + 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), @@ -426,8 +583,8 @@ run_queues_lengths_active_tasks(Config) -> RQLs1 = statistics(run_queue_lengths), ATs1 = statistics(active_tasks), - NoScheds = length(RQLs1), - NoScheds = length(ATs1), + DefRqs = length(RQLs1), + DefRqs = length(ATs1), TRQLs2 = lists:sum(RQLs1), TATs2 = lists:sum(ATs1), true = TRQLs2 >= 10, @@ -488,9 +645,7 @@ msacc(Config) -> (aux, 0) -> %% aux will be zero if we do not have smp support %% or no async threads - case erlang:system_info(smp_support) orelse - erlang:system_info(thread_pool_size) > 0 - of + case erlang:system_info(thread_pool_size) > 0 of false -> ok; true -> @@ -526,6 +681,16 @@ msacc_test(TmpFile) -> 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)], diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index a4aedb31f6..21ab6b378a 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. +%% Copyright Ericsson AB 2005-2018. 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. @@ -36,7 +36,9 @@ -export([all/0, suite/0]). -export([process_count/1, system_version/1, misc_smoke_tests/1, - heap_size/1, wordsize/1, memory/1, ets_limit/1]). + heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1, + ets_count/1, + atom_count/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -44,7 +46,8 @@ suite() -> all() -> [process_count, system_version, misc_smoke_tests, - heap_size, wordsize, memory, ets_limit]. + ets_count, + heap_size, wordsize, memory, ets_limit, atom_limit, atom_count]. %%% %%% The test cases ------------------------------------------------------------- @@ -173,7 +176,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), @@ -307,9 +310,9 @@ memory_test(_Config) -> 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))) + _ = 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"), @@ -362,11 +365,6 @@ mem_workers_call(MWs, Fun, Args) -> end end, MWs). -mem_workers_cast(MWs, Fun, Args) -> - lists:foreach(fun (MW) -> - MW ! {cast, self(), Fun, Args} - end, MWs). - spawn_mem_workers() -> spawn_mem_workers(erlang:system_info(schedulers_online)). @@ -472,6 +470,32 @@ mapn(_Fun, 0) -> mapn(Fun, N) -> [Fun(N) | mapn(Fun, N-1)]. + +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]))). + +ets_count(Config) when is_list(Config) -> + [ets_count_do([Type | Named]) + || Type <- [set, bag, duplicate_bag, ordered_set], + Named <- [[named_table], []] + ], + ok. + +ets_count_do(Opts) -> + Before = erlang:system_info(ets_count), + T = ets:new(?MODULE, Opts), + After = erlang:system_info(ets_count), + After = Before + 1, + ets:delete(T), + Before = erlang:system_info(ets_count). + + %% Verify system_info(ets_limit) reflects max ETS table settings. ets_limit(Config0) when is_list(Config0) -> Config = [{testcase,ets_limit}|Config0], @@ -486,7 +510,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, @@ -502,16 +526,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)), + 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)), - 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, peer, [{args, "-pa "++Pa}, {env, Envs}]). + test_server:start_node(get_node_name(Config), peer, + [{args, "-pa "++ Pa ++ AtomsMax}]). 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 2e359b11ce..0c3844e90f 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2016. All Rights Reserved. +%% Copyright Ericsson AB 2007-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -95,18 +95,20 @@ do_runnable_procs({TsType, TsTypeFlag}) -> % FIXME: Set #laps and #nodes in config file Nodes = 10, Laps = 10, - Master = ring(Nodes), + All = ring(Nodes, [link,monitor]), + [Master | _] = All, undefined = erlang:system_profile(Pid, [runnable_procs]++TsTypeFlag), % loop a message ok = ring_message(Master, message, Laps), + ok = kill_ring(Master), + [receive {'DOWN', _, process, P, _} -> ok end || P <- All], Events = get_profiler_events(), - kill_em_all = kill_ring(Master), erlang:system_profile(undefined, []), put(master, Master), put(laps, Laps), true = has_runnable_event(TsType, Events), Pids = sort_events_by_pid(Events), - ok = check_events(TsType, Pids), + ok = check_events(TsType, Pids, (Laps+1)*2+2, (Laps+1)*2), erase(), exit(Pid,kill), ok. @@ -139,16 +141,15 @@ do_runnable_ports({TsType, TsTypeFlag}, Config) -> erlang:system_profile(undefined, []), true = has_runnable_event(TsType, Events), Pids = sort_events_by_pid(Events), - ok = check_events(TsType, Pids), + ok = check_events(TsType, Pids, Laps*2+2, Laps*2), erase(), exit(Pid,kill), ok. %% 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, lists:foreach(fun (TsType) -> @@ -172,12 +173,12 @@ dont_profile_profiler(Config) when is_list(Config) -> Nodes = 10, Laps = 10, - Master = ring(Nodes), + [Master|_] = ring(Nodes, [link]), undefined = erlang:system_profile(Pid, [runnable_procs]), % loop a message ok = ring_message(Master, message, Laps), erlang:system_profile(undefined, []), - kill_em_all = kill_ring(Master), + ok = kill_ring(Master), Events = get_profiler_events(), false = has_profiler_pid_event(Events, Pid), @@ -249,27 +250,28 @@ check_block_system({TsType, TsTypeFlag}, Nodes) -> %%% Check events -check_events(_TsType, []) -> ok; -check_events(TsType, [Pid | Pids]) -> +check_events(_TsType, [], _, _) -> ok; +check_events(TsType, [Pid | Pids], ExpMaster, ExpMember) -> Master = get(master), - Laps = get(laps), CheckPids = get(pids), {Events, N} = get_pid_events(Pid), ok = check_event_flow(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(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(TsType, Pids); - Pid -> - check_events(TsType, Pids) - end. + {Title,Exp} = case Pid of + Master -> {master,ExpMaster}; + Pid when IsMember == true -> {member,ExpMember}; + _ -> {other,N} + end, + ok = case N of + Exp -> ok; + _ -> + io:format("Expected ~p and got ~p profile events from ~p ~p:~n~p~n", + [Exp, N, Title, Pid, Events]), + error + end, + check_events(TsType, Pids, ExpMaster, ExpMember). + %% timestamp consistency check for descending timestamps @@ -297,7 +299,13 @@ check_event_ts(TsType, [{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) -> %% consistency check for active vs. inactive activity (runnable) check_event_flow(Events) -> - check_event_flow(Events, undefined). + case check_event_flow(Events, undefined) of + ok -> ok; + Error -> + io:format("Events = ~p\n", [Events]), + Error + end. + check_event_flow([], _) -> ok; check_event_flow([Event | PidEvents], undefined) -> check_event_flow(PidEvents, Event); @@ -337,10 +345,11 @@ sort_events_by_pid([Event | Events],Pids) -> %% API % Returns master pid -ring(N) -> - Pids = build_ring(N, []), +ring(N, SpawnOpt) -> + Pids = build_ring(N, [], SpawnOpt), put(pids, Pids), - setup_ring(Pids). + setup_ring(Pids), + Pids. ring_message(Master, Message, Laps) -> Master ! {message, Master, Laps, Message}, @@ -348,13 +357,19 @@ ring_message(Master, Message, Laps) -> {laps_complete, Master} -> ok end. -kill_ring(Master) -> Master ! kill_em_all. +kill_ring(Master) -> + Master ! kill_em_all, + ok. %% Process ring helpers -build_ring(0, Pids) -> Pids; -build_ring(N, Pids) -> - build_ring(N - 1, [spawn_link(?MODULE, ring_loop, [undefined]) | Pids]). +build_ring(0, Pids, _) -> Pids; +build_ring(N, Pids, SpawnOpt) -> + Pid = case spawn_opt(?MODULE, ring_loop, [undefined], SpawnOpt) of + {P,_} -> P; + P -> P + end, + build_ring(N-1, [Pid | Pids], SpawnOpt). setup_ring([Master | Relayers]) -> % Relayers may not include the master pid @@ -383,15 +398,13 @@ ring_loop(RelayTo) -> {message, Master, Lap, Msg}=Message -> case {self(), Lap} of {Master, 0} -> - get(supervisor) ! {laps_complete, self()}, - ring_loop(RelayTo); + get(supervisor) ! {laps_complete, self()}; {Master, Lap} -> - RelayTo ! {message, Master, Lap - 1, Msg}, - ring_loop(RelayTo); + RelayTo ! {message, Master, Lap - 1, Msg}; _ -> - RelayTo ! Message, - ring_loop(RelayTo) - end + RelayTo ! Message + end, + ring_loop(RelayTo) end. %%% @@ -542,8 +555,10 @@ has_runnable_event(TsType, Events) -> 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 9501569814..e01efac86b 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% 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. @@ -132,7 +132,7 @@ local_to_univ_utc(Config) when is_list(Config) -> end. -%% Tests conversion from univeral to local time. +%% Tests conversion from universal to local time. univ_to_local(Config) when is_list(Config) -> test_univ_to_local(test_data()). @@ -300,7 +300,7 @@ os_system_time_offset() -> had_time_warp(Secs) -> had_time_warp(os_system_time_offset(), Secs). -had_time_warp(OrigOffs, 0) -> +had_time_warp(_OrigOffs, 0) -> false; had_time_warp(OrigOffs, N) -> receive after 1000 -> ok end, @@ -993,9 +993,6 @@ bad_dates() -> {{1996, 4, 30}, {12, 0, -1}}, % Sec {{1996, 4, 30}, {12, 0, 60}}]. -start_node(Config) -> - start_node(Config, ""). - start_node(Config, Args) -> TestCase = proplists:get_value(testcase, Config), PA = filename:dirname(code:which(?MODULE)), diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl index 7cbd93a0f3..fc11a04a31 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-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. @@ -488,24 +488,40 @@ registered_process(Config) when is_list(Config) -> 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(), hej, [{abs, true}]) + erlang:start_timer(Tmo, self(), Ref, [{abs, true}]) end, lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)), true = mem_larger_than(Mem), - lists:foreach(fun (Tmr) -> receive {timeout, Tmr, hej} -> ok end end, Tmrs), + 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 = Done < Tmo + 200; - _ -> true = Done < Tmo + 1000 + 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). diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index da6a6bdea4..c2d5cd7023 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -24,20 +24,22 @@ %%% Tests the trace BIF. %%% --export([all/0, suite/0, link_receive_call_correlation/0, +-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_new_trace/1, - suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1, + 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, + trace_info_badarg/1, erl_704/1]). -include_lib("common_test/include/ct.hrl"). @@ -46,22 +48,31 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 5}}]. + {timetrap, {minutes, 1}}]. all() -> [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_exit, suspender_exit, suspend_system_limit, suspend_opts, suspend_waiting, - new_clear, existing_clear, set_on_spawn, + 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]. + system_monitor_large_heap_2, bad_flag, trace_delivered, + trap_exit_self_receive, trace_info_badarg, erl_704]. +init_per_testcase(_Case, Config) -> + [{receiver,spawn(fun receiver/0)}|Config]. + +end_per_testcase(_Case, Config) -> + Receiver = proplists:get_value(receiver, Config), + unlink(Receiver), + exit(Receiver, die), + ok. %% No longer testing anything, just reporting whether cpu_timestamp %% is enabled or not. @@ -83,7 +94,7 @@ cpu_timestamp(Config) when is_list(Config) -> %% Tests that trace(Pid, How, ['receive']) works. receive_trace(Config) when is_list(Config) -> - Receiver = fun_spawn(fun receiver/0), + Receiver = proplists:get_value(receiver, Config), %% Trace the process; make sure that we receive the trace messages. 1 = erlang:trace(Receiver, true, ['receive']), @@ -184,10 +195,10 @@ receive_trace(Config) when is_list(Config) -> {'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, @@ -225,7 +236,7 @@ link_receive_call_correlation(Config) when is_list(Config) -> 1 = erlang:trace(Receiver, true, ['receive', procs, call, timestamp, scheduler_id]), 1 = erlang:trace_pattern({?MODULE, receive_msg, '_'}, [], [local]), - Num = 100000, + Num = 100, (fun F(0) -> []; F(N) -> @@ -245,7 +256,7 @@ link_receive_call_correlation(Config) when is_list(Config) -> Msgs = (fun F() -> receive M -> [M | F()] after 1 -> [] end end)(), - case check_consistent(Receiver, Num, Num, Num, Msgs) of + case check_consistent(Receiver, Num, Num, Num, Msgs, false, undefined) of ok -> ok; {error, Reason} -> @@ -255,20 +266,63 @@ link_receive_call_correlation(Config) when is_list(Config) -> -define(schedid, , _). -check_consistent(_Pid, Recv, Call, _LU, [Msg | _]) when Recv > Call -> +check_consistent(_Pid, Recv, Call, _LU, [Msg | _], _Received, _LinkedN) when Recv > Call -> {error, Msg}; -check_consistent(Pid, Recv, Call, LU, [Msg | Msgs]) -> +check_consistent(Pid, Recv, Call, LU, [Msg | Msgs], false, undefined) -> case Msg of {trace, Pid, 'receive', Recv ?schedid} -> - check_consistent(Pid,Recv - 1, Call, LU, Msgs); + check_consistent(Pid,Recv - 1, Call, LU, Msgs, true, undefined); {trace_ts, Pid, 'receive', Recv ?schedid, _} -> - check_consistent(Pid,Recv - 1, Call, LU, Msgs); + check_consistent(Pid,Recv - 1, Call, LU, Msgs, true, undefined); {trace, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid} -> - check_consistent(Pid,Recv, Call - 1, LU, Msgs); + check_consistent(Pid,Recv, Call - 1, LU, Msgs, false, undefined); {trace_ts, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid, _} -> - check_consistent(Pid,Recv, Call - 1, LU, Msgs); + check_consistent(Pid,Recv, Call - 1, LU, Msgs, false, undefined); + + {trace, Pid, _, _Self ?schedid} -> + check_consistent(Pid, Recv, Call, LU, Msgs, false, undefined); + {trace_ts, Pid, _, _Self ?schedid, _} -> + check_consistent(Pid, Recv, Call, LU, Msgs, false, undefined); + + Msg -> + {error, Msg} + end; +check_consistent(Pid, Recv, Call, LU, [Msg | Msgs], true, undefined) -> + + case Msg of + {trace, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid} -> + check_consistent(Pid,Recv, Call - 1, LU, Msgs, true, undefined); + {trace_ts, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid, _} -> + check_consistent(Pid,Recv, Call - 1, LU, Msgs, true, undefined); + + {trace, Pid, getting_linked, _Self ?schedid} -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, Recv rem 2); + {trace_ts, Pid, getting_linked, _Self ?schedid, _} -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, Recv rem 2); + + {trace, Pid, getting_unlinked, _Self ?schedid} -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, (Recv+1) rem 2); + {trace_ts, Pid, getting_unlinked, _Self ?schedid, _} -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, (Recv+1) rem 2); + + Msg -> + {error, Msg} + end; +check_consistent(Pid, Recv, Call, LU, [Msg | Msgs], true, LinkedN) -> + UnlinkedN = (LinkedN + 1) rem 2, + + case Msg of + {trace, Pid, 'receive', Recv ?schedid} when Recv == LU -> + check_consistent(Pid,Recv - 1, Call, LU, Msgs, true, LinkedN); + {trace_ts, Pid, 'receive', Recv ?schedid, _} when Recv == LU -> + check_consistent(Pid,Recv - 1, Call, LU, Msgs, true, LinkedN); + + {trace, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid} -> + check_consistent(Pid,Recv, Call - 1, LU, Msgs, true, LinkedN); + {trace_ts, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid, _} -> + check_consistent(Pid,Recv, Call - 1, LU, Msgs, true, LinkedN); %% We check that for each receive we have gotten a %% getting_linked or getting_unlinked message. Also @@ -276,38 +330,38 @@ check_consistent(Pid, Recv, Call, LU, [Msg | Msgs]) -> %% 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); + when Recv rem 2 == LinkedN -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, LinkedN); {trace_ts, Pid, getting_linked, _Self ?schedid, _} - when Recv rem 2 == 0, Recv == LU -> - check_consistent(Pid, Recv, Call, LU - 1, Msgs); + when Recv rem 2 == LinkedN -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, LinkedN); {trace, Pid, getting_unlinked, _Self ?schedid} - when Recv rem 2 == 1, Recv == LU -> - check_consistent(Pid, Recv, Call, LU - 1, Msgs); + when Recv rem 2 == UnlinkedN -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, LinkedN); {trace_ts, Pid, getting_unlinked, _Self ?schedid, _} - when Recv rem 2 == 1, Recv == LU -> - check_consistent(Pid, Recv, Call, LU - 1, Msgs); + when Recv rem 2 == UnlinkedN -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, LinkedN); {trace,Pid,'receive',Ignore ?schedid} when Ignore == stop; Ignore == timeout -> - check_consistent(Pid, Recv, Call, LU, Msgs); + check_consistent(Pid, Recv, Call, LU, Msgs, true, LinkedN); {trace_ts,Pid,'receive',Ignore ?schedid,_} when Ignore == stop; Ignore == timeout -> - check_consistent(Pid, Recv, Call, LU, Msgs); + check_consistent(Pid, Recv, Call, LU, Msgs, true, LinkedN); {trace, Pid, exit, normal ?schedid} -> - check_consistent(Pid, Recv, Call, LU, Msgs); + check_consistent(Pid, Recv, Call, LU, Msgs, true, LinkedN); {trace_ts, Pid, exit, normal ?schedid, _} -> - check_consistent(Pid, Recv, Call, LU, Msgs); + check_consistent(Pid, Recv, Call, LU, Msgs, true, LinkedN); {'EXIT', Pid, normal} -> - check_consistent(Pid, Recv, Call, LU, Msgs); + check_consistent(Pid, Recv, Call, LU, Msgs, true, LinkedN); Msg -> {error, Msg} end; -check_consistent(_, 0, 0, 0, []) -> +check_consistent(_, 0, 0, 1, [], true, _) -> ok; -check_consistent(_, Recv, Call, LU, []) -> +check_consistent(_, Recv, Call, LU, [], _, _) -> {error,{Recv, Call, LU}}. receive_msg(M) -> @@ -353,7 +407,7 @@ timeout_trace(Config) when is_list(Config) -> send_trace(Config) when is_list(Config) -> process_flag(trap_exit, true), Sender = fun_spawn(fun sender/0), - Receiver = fun_spawn(fun receiver/0), + Receiver = proplists:get_value(receiver, Config), %% Check that a message sent to another process is traced. 1 = erlang:trace(Sender, true, [send]), @@ -733,7 +787,7 @@ set_on_first_spawn(Config) when is_list(Config) -> %% Tests trace(Pid, How, [set_on_link]). -set_on_link(Config) -> +set_on_link(_Config) -> Listener = fun_spawn(fun process/0), %% Create and trace a process with the set_on_link flag. @@ -756,7 +810,7 @@ set_on_link(Config) -> %% Tests trace(Pid, How, [set_on_first_spawn]). -set_on_first_link(Config) -> +set_on_first_link(_Config) -> ct:timetrap({seconds, 10}), Listener = fun_spawn(fun process/0), @@ -1181,55 +1235,6 @@ do_suspend(Pid, N) -> erlang:yield(), do_suspend(Pid, N-1). - - -mutual_suspend(Config) when is_list(Config) -> - 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) -> - ok; -do_mutual_suspend(Pid, N) -> - %% Suspend a process and test that it is suspended. - true = erlang:suspend_process(Pid), - {status, suspended} = process_info(Pid, status), - %% Unsuspend the process. - true = erlang:resume_process(Pid), - do_mutual_suspend(Pid, N-1). - suspend_exit(Config) when is_list(Config) -> ct:timetrap({minutes, 2}), rand:seed(exsplus, {4711,17,4711}), @@ -1460,7 +1465,8 @@ suspend_opts(Config) when is_list(Config) -> dbl_async = AA, synced = S, async_once = AO} = Acc) -> - erlang:suspend_process(Tok, [asynchronous]), + Tag = {make_ref(), self()}, + erlang:suspend_process(Tok, [{asynchronous, Tag}]), Res = case {suspend_count(Tok), N rem 4} of {0, 2} -> erlang:suspend_process(Tok, @@ -1496,7 +1502,11 @@ suspend_opts(Config) when is_list(Config) -> _ -> Acc end, - erlang:resume_process(Tok), + receive + {Tag, Result} -> + suspended = Result, + erlang:resume_process(Tok) + end, erlang:yield(), Res end, @@ -1604,7 +1614,8 @@ suspend_waiting(Config) when is_list(Config) -> %% Test that erlang:trace(new, true, ...) is cleared when tracer dies. new_clear(Config) when is_list(Config) -> - Tracer = spawn(fun receiver/0), + 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), @@ -1623,7 +1634,7 @@ new_clear(Config) when is_list(Config) -> existing_clear(Config) when is_list(Config) -> Self = self(), - Tracer = fun_spawn(fun receiver/0), + 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), @@ -1636,6 +1647,37 @@ existing_clear(Config) when is_list(Config) -> ok. +%% 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 @@ -1668,6 +1710,50 @@ trace_delivered(Config) when is_list(Config) -> 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. + +trace_info_badarg(Config) when is_list(Config) -> + catch erlang:trace_info({a,b,c},d), + ok. + +%% An incoming suspend monitor down wasn't handled +%% correct when the local monitor half had been +%% removed with an emulator crash as result. +erl_704(Config) -> + erl_704_test(100). + +erl_704_test(0) -> + ok; +erl_704_test(N) -> + P = spawn(fun () -> receive infinity -> ok end end), + erlang:suspend_process(P), + exit(P, kill), + (catch erlang:resume_process(P)), + erl_704_test(N-1). + drop_trace_until_down(Proc, Mon) -> drop_trace_until_down(Proc, Mon, false, 0, 0). @@ -1750,6 +1836,9 @@ process(Dest) -> 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); diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index f60c777ba1..f12c359874 100644 --- a/erts/emulator/test/trace_bif_SUITE.erl +++ b/erts/emulator/test/trace_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-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. @@ -47,7 +47,7 @@ not_run(Config) when is_list(Config) -> %% Tests switching tracing on and off. trace_on_and_off(Config) when is_list(Config) -> - Pid = spawn(?MODULE, bif_process, []), + Pid = spawn_link(?MODULE, bif_process, []), Self = self(), 1 = erlang:trace(Pid, true, [call,timestamp]), {flags, Flags} = erlang:trace_info(Pid,flags), @@ -59,6 +59,7 @@ trace_on_and_off(Config) when is_list(Config) -> 1 = erlang:trace(Pid, false, [call]), {flags,[]} = erlang:trace_info(Pid,flags), {tracer, []} = erlang:trace_info(Pid,tracer), + unlink(Pid), exit(Pid,kill), ok. @@ -71,7 +72,7 @@ trace_bif_local(Config) when is_list(Config) -> do_trace_bif([local]). do_trace_bif(Flags) -> - Pid = spawn(?MODULE, bif_process, []), + Pid = spawn_link(?MODULE, bif_process, []), 1 = erlang:trace(Pid, true, [call]), erlang:trace_pattern({erlang,'_','_'}, [], Flags), Pid ! {do_bif, time, []}, @@ -90,6 +91,7 @@ do_trace_bif(Flags) -> 1 = erlang:trace(Pid, false, [call]), erlang:trace_pattern({erlang,'_','_'}, false, Flags), + unlink(Pid), exit(Pid, die), ok. @@ -121,7 +123,7 @@ trace_bif_timestamp_local(Config) when is_list(Config) -> do_trace_bif_timestamp(Flags, TsType, TsFlags) -> io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]), - Pid=spawn(?MODULE, bif_process, []), + Pid = spawn_link(?MODULE, bif_process, []), 1 = erlang:trace(Pid, true, [call]++TsFlags), erlang:trace_pattern({erlang,'_','_'}, [], Flags), @@ -161,6 +163,7 @@ do_trace_bif_timestamp(Flags, TsType, TsFlags) -> 1 = erlang:trace(Pid, false, [call]), erlang:trace_pattern({erlang,'_','_'}, false, Flags), + unlink(Pid), exit(Pid, die), ok. @@ -179,7 +182,7 @@ trace_bif_return(Config) when is_list(Config) -> do_trace_bif_return(TsType, TsFlags) -> io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]), - Pid=spawn(?MODULE, bif_process, []), + Pid = spawn_link(?MODULE, bif_process, []), 1 = erlang:trace(Pid, true, [call,return_to]++TsFlags), erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], [local]), 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 c297acd78b..253d5fed23 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-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. @@ -19,7 +19,6 @@ %% -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, @@ -65,7 +64,7 @@ init_per_testcase(_Case, Config) -> Config. -end_per_testcase(_Case, Config) -> +end_per_testcase(_Case, _Config) -> shutdown(), %% Reloading the module will clear all trace patterns, and @@ -78,7 +77,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 2}}]. -all() -> +all() -> case test_server:is_native(trace_local_SUITE) of true -> [not_run]; false -> @@ -98,7 +97,7 @@ all() -> end. -not_run(Config) when is_list(Config) -> +not_run(Config) when is_list(Config) -> {skipped,"Native code"}. %% Tests basic local call-trace @@ -299,8 +298,9 @@ basic_test() -> setup([call]), NumMatches = erlang:trace_pattern({?MODULE,'_','_'},[],[local]), NumMatches = erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + false = code:is_module_native(?MODULE), % got fooled by local trace erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), ?CT(?MODULE,exported_wrap,[1]), ?CT(?MODULE,exported,[1]), ?CT(?MODULE,local,[1]), @@ -308,17 +308,17 @@ basic_test() -> ?CT(?MODULE,local_tail,[1]), erlang:trace_pattern({?MODULE,'_','_'},[],[]), erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), ?CT(?MODULE,exported_wrap,[1]), - [1,1,1,1] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?NM, + [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,1] = lambda_slave(fun() -> - exported_wrap(1) - end), + [1,1,1,997] = lambda_slave(fun() -> + exported_wrap(1) + end), ?CT(?MODULE,_,_), %% The fun ?CT(?MODULE,exported_wrap,[1]), ?CT(?MODULE,exported,[1]), @@ -379,36 +379,36 @@ return_test() -> setup([call]), erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], [local]), - erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}], + erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], [local]), erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?CT(?MODULE,exported_wrap,[1]), + [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,hash,[1,1]), - ?RF(erlang,hash,2,1), - ?RF(?MODULE,local_tail,1,[1,1]), - ?RF(?MODULE,local2,1,[1,1]), - ?RF(?MODULE,local,1,[1,1,1]), - ?RF(?MODULE,exported,1,[1,1,1,1]), - ?RF(?MODULE,exported_wrap,1,[1,1,1,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,hash,'_'},[], + erlang:trace_pattern({erlang,phash2,'_'},[], [local]), erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?CT(?MODULE,exported_wrap,[1]), + [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,hash,[1,1]), + ?CT(erlang,phash2,[1,1023]), ?RT(?MODULE,local_tail,1), ?RT(?MODULE,local,1), ?RT(?MODULE,exported,1), @@ -417,25 +417,25 @@ return_test() -> setup([call,return_to]), erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], [local]), - erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}], + erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], [local]), erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?CT(?MODULE,exported_wrap,[1]), + [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,hash,[1,1]), - ?RF(erlang,hash,2,1), + ?CT(erlang,phash2,[1,1023]), + ?RF(erlang,phash2,2,997), ?RT(?MODULE,local_tail,1), - ?RF(?MODULE,local_tail,1,[1,1]), - ?RF(?MODULE,local2,1,[1,1]), + ?RF(?MODULE,local_tail,1,[1,997]), + ?RF(?MODULE,local2,1,[1,997]), ?RT(?MODULE,local,1), - ?RF(?MODULE,local,1,[1,1,1]), + ?RF(?MODULE,local,1,[1,1,997]), ?RT(?MODULE,exported,1), - ?RF(?MODULE,exported,1,[1,1,1,1]), - ?RF(?MODULE,exported_wrap,1,[1,1,1,1]), + ?RF(?MODULE,exported,1,[1,1,1,997]), + ?RF(?MODULE,exported_wrap,1,[1,1,1,997]), ?RT(?MODULE,slave,2), shutdown(), ?NM, @@ -446,7 +446,6 @@ return_test() -> erlang:trace_pattern({'_','_','_'},[],[local]), apply_slave(erlang,trace,[Pid, false, [all]]), shutdown(), - ok. on_and_off_test() -> @@ -456,72 +455,72 @@ on_and_off_test() -> LocalTail = fun() -> local_tail(1) end, - [1,1] = lambda_slave(LocalTail), + [1,997] = lambda_slave(LocalTail), ?CT(?MODULE,local_tail,[1]), erlang:trace(Pid,true,[return_to]), - [1,1] = lambda_slave(LocalTail), + [1,997] = lambda_slave(LocalTail), ?CT(?MODULE,local_tail,[1]), ?RT(?MODULE,_,_), 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), - [1,1] = lambda_slave(LocalTail), + [1,997] = lambda_slave(LocalTail), ?NM, 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[global]), - [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + [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,1] = apply_slave(?MODULE,exported_wrap,[1]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), ?CT(?MODULE,exported_wrap,[1]), ?RT(?MODULE,slave,2), - 1 = erlang:trace_pattern({erlang,hash,2},[],[local]), - [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + 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,hash,[1,1]), + ?CT(erlang,phash2,[1,1023]), ?RT(?MODULE,local_tail,1), ?RT(?MODULE,slave,2), erlang:trace(Pid,true,[timestamp]), - [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), ?CTT(?MODULE,exported_wrap,[1]), - ?CTT(erlang,hash,[1,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,1] = apply_slave(?MODULE,exported_wrap,[1]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), ?CT(?MODULE,exported_wrap,[1]), - ?CT(erlang,hash,[1,1]), + ?CT(erlang,phash2,[1,1023]), erlang:trace(Pid,true,[return_to]), - 1 = erlang:trace_pattern({erlang,hash,2},[],[]), - [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + 1 = erlang:trace_pattern({erlang,phash2,2},[],[]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), ?CT(?MODULE,exported_wrap,[1]), - ?CT(erlang,hash,[1,1]), + ?CT(erlang,phash2,[1,1023]), ?RT(?MODULE,slave,2), 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), - [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]), ?CT(?MODULE,exported_wrap,[1]), - ?CT(erlang,hash,[1,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 -> + N -> ok; Else -> exit({number_mismatch, {expected, N}, {got, Else}}) end, case erlang:trace_pattern({erlang,'_','_'},false,[local]) of - N -> + 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 -> + M -> ok; Else3 -> exit({number_mismatch, {expected, N}, {got, Else3}}) end, case erlang:trace_pattern({erlang,'_','_'},false,[]) of - M -> + M -> ok; Else4 -> exit({number_mismatch, {expected, N}, {got, Else4}}) @@ -930,7 +929,7 @@ local2(Val) -> local_tail(Val). %% Tail recursive call local_tail(Val) -> - [Val , erlang:hash(1,1)]. + [Val , erlang:phash2(1,1023)]. diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl index b6a6fd5404..f157a6c9eb 100644 --- a/erts/emulator/test/trace_meta_SUITE.erl +++ b/erts/emulator/test/trace_meta_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2016. All Rights Reserved. +%% Copyright Ericsson AB 2002-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. @@ -74,7 +74,7 @@ config(priv_dir,_) -> init_per_testcase(_Case, Config) -> Config. -end_per_testcase(_Case, Config) -> +end_per_testcase(_Case, _Config) -> shutdown(), ok. diff --git a/erts/emulator/test/trace_nif_SUITE.erl b/erts/emulator/test/trace_nif_SUITE.erl index 8d5bff2a48..f796b9d667 100644 --- a/erts/emulator/test/trace_nif_SUITE.erl +++ b/erts/emulator/test/trace_nif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% 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. @@ -80,7 +80,7 @@ trace_nif_meta(Config) when is_list(Config) -> {?MODULE,nif, ["Arg1"]}}), ok. do_trace_nif(Flags) -> - Pid = spawn(?MODULE, nif_process, []), + Pid = spawn_link(?MODULE, nif_process, []), 1 = erlang:trace(Pid, true, [call]), erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), Pid ! {apply_nif, nif, []}, @@ -123,6 +123,8 @@ do_trace_nif(Flags) -> 1 = erlang:trace(Pid, false, [call]), erlang:trace_pattern({?MODULE,nif,'_'}, false, Flags), + + unlink(Pid), exit(Pid, die), ok. @@ -137,7 +139,7 @@ trace_nif_timestamp_local(Config) when is_list(Config) -> do_trace_nif_timestamp([local]). do_trace_nif_timestamp(Flags) -> - Pid=spawn(?MODULE, nif_process, []), + Pid = spawn_link(?MODULE, nif_process, []), 1 = erlang:trace(Pid, true, [call,timestamp]), erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), @@ -170,6 +172,7 @@ do_trace_nif_timestamp(Flags) -> 1 = erlang:trace(Pid, false, [call]), erlang:trace_pattern({erlang,'_','_'}, false, Flags), + unlink(Pid), exit(Pid, die), ok. @@ -177,7 +180,7 @@ do_trace_nif_timestamp(Flags) -> trace_nif_return(Config) when is_list(Config) -> load_nif(Config), - Pid=spawn(?MODULE, nif_process, []), + Pid = spawn_link(?MODULE, nif_process, []), 1 = erlang:trace(Pid, true, [call,timestamp,return_to]), erlang:trace_pattern({?MODULE,nif,'_'}, [{'_',[],[{return_trace}]}], [local]), @@ -265,10 +268,16 @@ nif_process() -> nif_process(). load_nif(Config) -> - Path = proplists:get_value(data_dir, Config), - - 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"). 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 e4db368ea1..c85a77536e 100644 --- a/erts/emulator/test/trace_port_SUITE.erl +++ b/erts/emulator/test/trace_port_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% 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. @@ -37,7 +37,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 30}}]. + {timetrap, {minutes, 2}}]. all() -> [call_trace, return_trace, send, receive_trace, @@ -190,7 +190,7 @@ receive_trace(Config) when is_list(Config) -> receive_trace_non_scheduler(Config) when is_list(Config) -> start_tracer(Config), S = self(), - Receiver = spawn( + Receiver = spawn_link( fun() -> receive go -> @@ -349,15 +349,6 @@ huge_data(N) -> P = huge_data(N div 2), [16#1234566,P|P]. -expect() -> - receive - Other -> - ok = io:format("Unexpected; got ~p", [Other]), - ct:fail({unexpected, Other}) - after 200 -> - ok - end. - expect({trace_ts,E1,E2,info,ts}=Message) -> receive {trace_ts,E1,E2,_Info,_Ts}=MessageTs -> diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl index 9eb55c9af3..5556953feb 100644 --- a/erts/emulator/test/tracer_SUITE.erl +++ b/erts/emulator/test/tracer_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -30,7 +30,8 @@ -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]). + register/1, unregister/1, in/1, out/1, gc_start/1, gc_end/1, + seq_trace/1]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 1}}]. @@ -41,7 +42,8 @@ all() -> groups() -> [{ basic, [], [send, recv, call, call_return, spawn, exit, link, unlink, getting_linked, getting_unlinked, - register, unregister, in, out, gc_start, gc_end]}]. + register, unregister, in, out, gc_start, gc_end, + seq_trace]}]. init_per_suite(Config) -> erlang:trace_pattern({'_','_','_'}, false, [local]), @@ -70,7 +72,7 @@ init_per_testcase(TC, Config) when TC =:= load; TC =:= reload -> end end), register(tracer_test_config, Pid), - Config; + 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 @@ -79,16 +81,52 @@ init_per_testcase(_, Config) -> _ -> 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), - ok; + 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]), @@ -113,7 +151,6 @@ unload(_Config) -> Pid = erlang:spawn_link(fun() -> ServerFun(0, undefined) end), - Tc = fun(N) -> Pid ! {N, self()}, receive done -> ok after 1000 -> ct:fail(timeout) end, @@ -295,7 +332,7 @@ call_test(Arg) -> spawn(_Config) -> Tc = fun(Pid) -> - Pid ! fun() -> erlang:spawn(lists,seq,[1,10]), ok end + Pid ! fun() -> kill_me(erlang:spawn(lists,seq,[1,10])), ok end end, Expect = @@ -355,6 +392,7 @@ unlink(_Config) -> SPid = erlang:spawn(fun() -> receive _ -> ok end end), erlang:link(SPid), erlang:unlink(SPid), + kill_me(SPid), ok end end, @@ -547,6 +585,24 @@ gc_end(_Config) -> test(gc_major_end, garbage_collection, Tc, Expect, false). +seq_trace(_Config) -> + + seq_trace:set_system_tracer({tracer_test, + {#{ seq_trace => trace }, self(), []}}), + erlang:spawn(fun() -> + seq_trace:set_token(label,17), + seq_trace:set_token(print,true), + seq_trace:print(17,"**** Trace Started ****") + end), + receive + {seq_trace, _, 17, {print, _, _, _, _}, _} -> + ok; + M -> + ct:fail("~p~n",[M]) + after 100 -> + ct:fail(timeout) + end. + test(Event, Tc, Expect) -> test(Event, Tc, Expect, false). test(Event, Tc, Expect, Removes) -> @@ -567,7 +623,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) -> Expect(Pid1, State1, Opts), receive M11 -> ct:fail({unexpected, M11}) after 0 -> ok end, - if not Dies -> + if not Dies andalso Event /= in -> {flags, [TraceFlag]} = erlang:trace_info(Pid1, flags), {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1, tracer), erlang:trace(Pid1, false, [TraceFlag]); @@ -584,7 +640,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) -> Expect(Pid1T, State1, Opts#{ scheduler_id => number, timestamp => timestamp}), receive M11T -> ct:fail({unexpected, M11T}) after 0 -> ok end, - if not Dies -> + if not Dies andalso Event /= in -> {flags, [scheduler_id, TraceFlag, timestamp]} = erlang:trace_info(Pid1T, flags), {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1T, tracer), @@ -599,7 +655,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) -> Tc(Pid2), ok = trace_delivered(Pid2), receive M2 -> ct:fail({unexpected, M2}) after 0 -> ok end, - if not Dies -> + if not Dies andalso Event /= in -> {flags, [TraceFlag]} = erlang:trace_info(Pid2, flags), {tracer, {tracer_test, State2}} = erlang:trace_info(Pid2, tracer), erlang:trace(Pid2, false, [TraceFlag]); diff --git a/erts/emulator/test/tracer_SUITE_data/tracer_test.c b/erts/emulator/test/tracer_SUITE_data/tracer_test.c index a26bb33600..1555a95d9a 100644 --- a/erts/emulator/test/tracer_SUITE_data/tracer_test.c +++ b/erts/emulator/test/tracer_SUITE_data/tracer_test.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * 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. @@ -18,7 +18,7 @@ * %CopyrightEnd% */ -#include "erl_nif.h" +#include <erl_nif.h> #include <stdio.h> #include <string.h> diff --git a/erts/emulator/test/tracer_test.erl b/erts/emulator/test/tracer_test.erl index 1da80bfe31..a82fd04d2e 100644 --- a/erts/emulator/test/tracer_test.erl +++ b/erts/emulator/test/tracer_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl index 79b681b4d1..e03677a518 100644 --- a/erts/emulator/test/tuple_SUITE.erl +++ b/erts/emulator/test/tuple_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -134,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) -> diff --git a/erts/emulator/test/unique_SUITE.erl b/erts/emulator/test/unique_SUITE.erl index c5aa80c7b4..cfc37bd44f 100644 --- a/erts/emulator/test/unique_SUITE.erl +++ b/erts/emulator/test/unique_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014-2016. All Rights Reserved. +%% 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. @@ -302,20 +302,12 @@ smaller_valid_uniqint(Int, UinqintInfo) -> smaller_valid_uniqint(Cand, UinqintInfo) end. -int32_to_bigendian_list(Int) -> - 0 = Int bsr 32, - [(Int bsr 24) band 16#ff, - (Int bsr 16) band 16#ff, - (Int bsr 8) band 16#ff, - Int band 16#ff]. - 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), - NodeName = atom_to_list(node()), Make = {make_unique_integer, ThrId, Value}, %% erlang:display(Make), Res = erts_debug:get_internal_state(Make), diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index ab56018373..1c52e1a934 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-2018. 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. @@ -36,7 +36,9 @@ -export([schedulers_alive/1, node_container_refc_check/1, long_timers/1, pollset_size/1, - check_io_debug/1, get_check_io_info/0]). + check_io_debug/1, get_check_io_info/0, + lc_graph/1, + leaked_processes/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -44,7 +46,11 @@ suite() -> all() -> [schedulers_alive, node_container_refc_check, - long_timers, pollset_size, check_io_debug]. + long_timers, pollset_size, check_io_debug, + lc_graph, + %% Make sure that the leaked_processes/1 is always + %% run last. + leaked_processes]. %%% %%% The test cases ------------------------------------------------------------- @@ -68,8 +74,8 @@ schedulers_alive(Config) when is_list(Config) -> enabled -> io:format("Testing blocking process exit~n"), BF = fun () -> - blocked = erlang:system_flag(multi_scheduling, - block), + blocked_normal = erlang:system_flag(multi_scheduling, + block_normal), Master ! {self(), blocking}, receive after infinity -> ok end end, @@ -77,21 +83,21 @@ schedulers_alive(Config) when is_list(Config) -> Mon = erlang:monitor(process, Blocker), receive {Blocker, blocking} -> ok end, [Blocker] - = erlang:system_info(multi_scheduling_blockers), + = 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(multi_scheduling_blockers), + [] = erlang:system_info(normal_multi_scheduling_blockers), ok end, io:format("Testing blocked~n"), - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), case erlang:system_info(multi_scheduling) of enabled -> ct:fail(multi_scheduling_enabled); - blocked -> - [Master] = erlang:system_info(multi_scheduling_blockers); + blocked_normal -> + [Master] = erlang:system_info(normal_multi_scheduling_blockers); disabled -> ok end, Ps = lists:map( @@ -109,8 +115,8 @@ schedulers_alive(Config) when is_list(Config) -> unlink(P), exit(P, bang) end, Ps), - case erlang:system_flag(multi_scheduling, unblock) of - blocked -> ct:fail(multi_scheduling_blocked); + case erlang:system_flag(multi_scheduling, unblock_normal) of + blocked_normal -> ct:fail(multi_scheduling_blocked); disabled -> ok; enabled -> ok end, @@ -226,7 +232,7 @@ pollset_size(Config) when is_list(Config) -> "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 @@ -285,6 +291,37 @@ has_gethost([P|T]) -> has_gethost([]) -> false. +lc_graph(Config) when is_list(Config) -> + %% Create "lc_graph" file in current working dir + %% if lock checker is enabled + erts_debug:lc_graph(), + ok. + +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... @@ -301,7 +338,7 @@ display_check_io(ChkIo) -> ok. get_check_io_info() -> - ChkIo = erlang:system_info(check_io), + 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; |