diff options
Diffstat (limited to 'erts/emulator/test')
29 files changed, 1845 insertions, 191 deletions
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index fcd7244ae9..b17170c8b8 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -71,8 +71,10 @@ MODULES= \ hash_SUITE \ hibernate_SUITE \ hipe_SUITE \ + iovec_SUITE \ list_bif_SUITE \ lttng_SUITE \ + lcnt_SUITE \ map_SUITE \ match_spec_SUITE \ module_info_SUITE \ diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 3a721095e2..3d29776530 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -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) -> @@ -67,7 +69,11 @@ cpool(Cfg) -> drv_case(Cfg). migration(Cfg) -> case erlang:system_info(smp_support) of true -> - drv_case(Cfg, concurrent, "+MZe true"); + %% 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"); false -> {skipped, "No smp"} end. @@ -114,7 +120,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 +150,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 +237,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 +305,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 +430,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 +445,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..1d974225fc 100644 --- a/erts/emulator/test/alloc_SUITE_data/migration.c +++ b/erts/emulator/test/alloc_SUITE_data/migration.c @@ -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/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index 339c827602..04b7f2de15 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -24,7 +24,7 @@ -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,list_to_utf8_atom/1, specs/1,improper_bif_stubs/1,auto_imports/1, @@ -43,7 +43,7 @@ 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, list_to_utf8_atom, + display, display_string, list_to_utf8_atom, atom_to_binary, binary_to_atom, binary_to_existing_atom, erl_crash_dump_bytes, min_max, erlang_halt, is_builtin, error_stacktrace, error_stacktrace_during_call_trace]. @@ -68,6 +68,28 @@ deeep(N,Acc) -> deeep(N) -> deeep(N,[hello]). +display_string(Config) when is_list(Config) -> + true = erlang:display_string("hej"), + true = erlang:display_string(""), + true = erlang:display_string("hopp"), + true = erlang:display_string("\n"), + true = erlang:display_string(lists:seq(1100,1200)), + {error,badarg} = try + erlang:display_string(atom), + ok + catch + T0:E0 -> + {T0, E0} + end, + {error,badarg} = try + erlang:display_string(make_ref()), + ok + catch + T1:E1 -> + {T1, E1} + end, + ok. + erl_bif_types(Config) when is_list(Config) -> ensure_erl_bif_types_compiled(), @@ -503,6 +525,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. + <<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)), @@ -691,6 +715,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. diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl index 402751393a..c308760211 100644 --- a/erts/emulator/test/big_SUITE.erl +++ b/erts/emulator/test/big_SUITE.erl @@ -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() -> @@ -396,3 +398,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 4d17276e5c..374f91e487 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -257,6 +257,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]), @@ -599,6 +600,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) -> diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index b79f4b995d..ce50bcdd86 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -905,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/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 77321aa50f..661a2ee6c9 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2017. 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. @@ -25,8 +25,10 @@ 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]). -define(line_trace, 1). -include_lib("common_test/include/ct.hrl"). @@ -38,8 +40,10 @@ all() -> call_purged_fun_code_reload, call_purged_fun_code_there, multi_proc_purge, t_check_old_code, external_fun, get_chunk, module_md5, - constant_pools, constant_refc_binaries, false_dependency, - coverage, fun_confusion, t_copy_literals, t_copy_literals_frags]. + constant_pools, constant_refc_binaries, fake_literals, + false_dependency, + coverage, fun_confusion, t_copy_literals, t_copy_literals_frags, + erl_544]. init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), @@ -554,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) -> @@ -860,6 +920,53 @@ 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 = + lib: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. %% Utilities. 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/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index b4ec99f902..e731b68f2f 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -56,6 +56,7 @@ 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. @@ -92,6 +93,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. @@ -1361,81 +1363,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 @@ -1672,6 +1652,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 @@ -1739,10 +1774,11 @@ 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), + erlang:monitor_node(Node, true), DPrt = dport(Node), Bad1 = case WhereToPutSelf of 0 -> @@ -1756,7 +1792,16 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> [] -> []; _Other -> [dmsg_ext(PayLoad)] end, + + receive {nodedown, Node} -> exit("premature nodedown") + after 10 -> ok + end, + port_command(DPrt, DData), + + receive {nodedown, Node} -> ok + after 5000 -> exit("missing nodedown") + end, Parent ! {DData,Done} end), receive @@ -1775,9 +1820,12 @@ 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, @@ -1787,7 +1835,7 @@ send_bad_msgs(BadNode, To, Repeat) when is_atom(BadNode), DPrt = dport(Node), DData = [dmsg_hdr(), dmsg_ext({?DOP_SEND, ?COOKIE, To}), - dmsg_bad_atom_cache_ref()], + BadTerm], repeat(fun () -> port_command(DPrt, DData) end, Repeat), Parent ! Done end), @@ -1874,6 +1922,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"), diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 6810729285..c31ceb4d4b 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1673,7 +1673,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]), diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c index 8e5e81665c..e55b9e10ba 100644 --- a/erts/emulator/test/driver_SUITE_data/chkio_drv.c +++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c @@ -1225,7 +1225,6 @@ chkio_drv_control(ErlDrvData drv_data, break; } case CHKIO_SMP_SELECT: { - int rounds = 1; /*rand(); */ ChkioSmpSelect* pip = (ChkioSmpSelect*) cddp->test_data; if (pip == NULL) { erl_drv_mutex_lock(smp_pipes_mtx); @@ -1242,7 +1241,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,7 +1252,6 @@ 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])); @@ -1332,7 +1331,9 @@ chkio_drv_control(ErlDrvData drv_data, 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 +1349,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: diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index e4640909aa..7d29ebec52 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -22,6 +22,7 @@ -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_phash/1,t_phash2/1,md5/1, refc/1,refc_ets/1,refc_dist/1, @@ -39,6 +40,7 @@ suite() -> all() -> [bad_apply, bad_fun_call, badarity, ext_badarity, + 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, @@ -107,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) -> diff --git a/erts/emulator/test/iovec_SUITE.erl b/erts/emulator/test/iovec_SUITE.erl new file mode 100644 index 0000000000..963b7e2501 --- /dev/null +++ b/erts/emulator/test/iovec_SUITE.erl @@ -0,0 +1,188 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(iovec_SUITE). + +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). + +-export([integer_lists/1, binary_lists/1, empty_lists/1, empty_binary_lists/1, + mixed_lists/1, improper_lists/1, illegal_lists/1, cons_bomb/1, + sub_binary_lists/1, iolist_to_iovec_idempotence/1, + iolist_to_iovec_correctness/1, 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..4e52c2813c --- /dev/null +++ b/erts/emulator/test/lcnt_SUITE.erl @@ -0,0 +1,180 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(lcnt_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-export( + [all/0, suite/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). + +-export( + [toggle_lock_counting/1, error_on_invalid_category/1, preserve_locks/1, + 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(), + case erts_debug:lcnt_collect() of + [{duration, _}, {locks, []}] -> + ok; + _ -> + timer:sleep(50), + wait_for_empty_lock_list(Tries - 1) + end; +wait_for_empty_lock_list(0) -> + ct:fail("Lock list failed to clear after disabling lock counting."). + +%% Queue up a lot of thread progress cleanup ops in a vain attempt to +%% flush the lock list. +try_flush_cleanup_ops() -> + false = lists:member(process, erts_debug:lcnt_control(mask)), + [spawn(fun() -> ok end) || _ <- lists:seq(1, 1000)]. + +%% +%% Test cases +%% + +toggle_lock_counting(Config) when is_list(Config) -> + Categories = + [allocator, db, debug, distribution, generic, io, process, scheduler], + lists:foreach( + fun(Category) -> + Locks = get_lock_info_for(Category), + if + Locks =/= [] -> + disable_lock_counting(); + Locks =:= [] -> + ct:fail("Failed to toggle ~p locks.", [Category]) + end + end, Categories). + +get_lock_info_for(Categories) when is_list(Categories) -> + ok = erts_debug:lcnt_control(mask, Categories), + [{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(), + Locks; + +get_lock_info_for(Category) when is_atom(Category) -> + get_lock_info_for([Category]). + +preserve_locks(Config) when is_list(Config) -> + erts_debug:lcnt_control(mask, [process]), + + erts_debug:lcnt_control(copy_save, true), + [spawn(fun() -> ok end) || _ <- lists:seq(1, 1000)], + + %% Wait for the processes to be fully destroyed before disabling copy_save, + %% then remove all active locks from the list. (There's no foolproof method + %% to do this; sleeping before/after is the best way we have) + timer:sleep(500), + + erts_debug:lcnt_control(copy_save, false), + erts_debug:lcnt_control(mask, []), + + try_flush_cleanup_ops(), + timer:sleep(500), + + case erts_debug:lcnt_collect() of + [{duration, _}, {locks, Locks}] when length(Locks) > 0 -> + ct:pal("Preserved ~p locks.", [length(Locks)]); + [{duration, _}, {locks, []}] -> + ct:fail("copy_save didn't preserve any locks.") + end. + +error_on_invalid_category(Config) when is_list(Config) -> + {error, badarg, q_invalid} = erts_debug:lcnt_control(mask, [q_invalid]), + ok. + +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. diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 92ddc23592..08a7b4560c 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -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, @@ -47,7 +47,7 @@ suite() -> 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, diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 05c250125d..4237715c4b 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -61,7 +61,8 @@ nif_internal_hash_salted/1, nif_phash2/1, nif_whereis/1, nif_whereis_parallel/1, - nif_whereis_threaded/1, nif_whereis_proxy/1 + nif_whereis_threaded/1, nif_whereis_proxy/1, + nif_ioq/1 ]). -export([many_args_100/100]). @@ -99,7 +100,8 @@ all() -> nif_internal_hash, nif_internal_hash_salted, nif_phash2, - nif_whereis, nif_whereis_parallel, nif_whereis_threaded]. + nif_whereis, nif_whereis_parallel, nif_whereis_threaded, + nif_ioq]. groups() -> [{G, [], api_repeaters()} || G <- api_groups()] @@ -2592,16 +2594,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. @@ -2886,11 +2895,15 @@ nif_whereis_parallel(Config) when is_list(Config) -> true = lists:all(PidReg, Procs), %% tell them all to 'fire' as fast as we can - [P ! {Ref, send_proc} || {_, P, _} <- Procs], + repeat(10, fun(_) -> + [P ! {Ref, send_proc} || {_, P, _} <- Procs] + end, void), %% each gets forwarded through two processes - true = lists:all(RecvNum, NSeq), - true = lists:all(RecvNum, NSeq), + 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], @@ -2953,6 +2966,206 @@ nif_whereis_proxy(Ref) -> {Ref, quit} -> ok end. +nif_ioq(Config) -> + ensure_lib_loaded(Config), + + Script = + [{create, a}, + + %% Test enq of erlang term binary + {enqb, a}, + {enqb, a, 3}, + + %% Test enq of non-erlang term binary + {enqbraw,a}, + {enqbraw,a, 5}, + {peek, a}, + {deq, a, 42}, + + %% Test enqv + {enqv, a, 2, 100}, + {deq, a, all}, + + %% This skips all elements but one in the iolist + {enqv, a, 5, iolist_size(nif_ioq_payload(5)) - 1}, + {peek, a}, + + %% 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), + + {'EXIT', {badarg, _}} = (catch ioq_nif(deq, Q, 1)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, 1, 1234)), + + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [atom_in_list], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [make_ref()], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [256], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [-1], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [#{}], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [1 bsl 64], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [{tuple}], 0)), + + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [atom_in_list], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [make_ref()], no_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [256], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [-1], no_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [#{}], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [1 bsl 64], no_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [{tuple}], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, <<"binary">>, use_stack)), + + ioq_nif(destroy, Q), + + %% Test that the example in the docs works + ExampleQ = ioq_nif(create), + true = ioq_nif(example, ExampleQ, nif_ioq_payload(5)), + ioq_nif(destroy, ExampleQ), + + ok. + + +nif_ioq_run(Script) -> + nif_ioq_run(Script, #{}). + +nif_ioq_run([{Action, Name}|T], State) + when Action =:= enqb; Action =:= enqbraw -> + nif_ioq_run([{Action, Name, heapbin}|T], State); +nif_ioq_run([{Action, Name, Skip}|T], State) + when Action =:= enqb, is_integer(Skip); + Action =:= enqbraw, is_integer(Skip) -> + nif_ioq_run([{Action, Name, heapbin, Skip}|T], State); +nif_ioq_run([{Action, Name, N}|T], State) + when Action =:= enqv; Action =:= enqb; Action =:= enqbraw -> + nif_ioq_run([{Action, Name, N, 0}|T], State); +nif_ioq_run([{Action, Name, N, Skip}|T], State) + when Action =:= enqv; Action =:= enqb; Action =:= enqbraw -> + + #{ q := IOQ, b := B } = Q = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + %% Sanitize the log output a bit so that it doesn't become too large. + H = {Action, Name, try iolist_size(N) of Sz -> Sz catch _:_ -> N end, Skip}, + ct:log("~p", [H]), + + Data = nif_ioq_payload(N), + ioq_nif(Action, IOQ, Data, Skip), + + <<_:Skip/binary, SkippedData/binary>> = iolist_to_binary(Data), + + true = ioq_nif(size, IOQ) == (iolist_size([B|SkippedData])), + + nif_ioq_run(T, State#{ Name := Q#{ b := [B|SkippedData]}}); +nif_ioq_run([{peek, Name} = H|T], State) -> + #{ q := IOQ, b := B } = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + ct:log("~p", [H]), + + Data = ioq_nif(peek, IOQ, ioq_nif(size, IOQ)), + + true = iolist_to_binary(B) == iolist_to_binary(Data), + nif_ioq_run(T, State); +nif_ioq_run([{deq, Name, all}|T], State) -> + #{ q := IOQ, b := B } = maps:get(Name, State), + Size = ioq_nif(size, IOQ), + true = Size == iolist_size(B), + nif_ioq_run([{deq, Name, Size}|T], State); +nif_ioq_run([{deq, Name, N} = H|T], State) -> + #{ q := IOQ, b := B } = Q = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + ct:log("~p", [H]), + + <<_:N/binary,Remain/binary>> = iolist_to_binary(B), + NewQ = Q#{ b := Remain }, + + Sz = ioq_nif(deq, IOQ, N), + + true = Sz == iolist_size(Remain), + true = ioq_nif(size, IOQ) == iolist_size(Remain), + + nif_ioq_run(T, State#{ Name := NewQ }); +nif_ioq_run([{create, Name} = H|T], State) -> + ct:log("~p", [H]), + nif_ioq_run(T, State#{ Name => #{ q => ioq_nif(create), b => [] } }); +nif_ioq_run([{destroy, Name} = H|T], State) -> + #{ q := IOQ, b := B } = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + ct:log("~p", [H]), + + ioq_nif(destroy, IOQ), + + nif_ioq_run(T, maps:remove(Name, State)); +nif_ioq_run([], State) -> + State. + +nif_ioq_payload(N) when is_integer(N) -> + Tail = if N > 3 -> nif_ioq_payload(N-3); true -> [] end, + Head = element(1, lists:split(N,[nif_ioq_payload(subbin), + nif_ioq_payload(heapbin), + nif_ioq_payload(refcbin), + 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. @@ -3028,6 +3241,10 @@ 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. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 307d1c390f..87cd3650ff 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -186,6 +186,12 @@ static ErlNifResourceTypeInit frenzy_rt_init = { 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) { @@ -243,6 +249,10 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) 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"); @@ -2374,7 +2384,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; @@ -2387,6 +2397,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) @@ -2394,11 +2407,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); } } @@ -2430,7 +2444,6 @@ 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)) { @@ -3158,7 +3171,231 @@ static void frenzy_resource_down(ErlNifEnv* env, void* obj, ErlNifPid* pid, abort(); } +/*********** testing ioq ************/ + +static void ioq_resource_dtor(ErlNifEnv* env, void* obj) { + +} + +#ifndef __WIN32__ +static int writeiovec(ErlNifEnv *env, ERL_NIF_TERM term, ERL_NIF_TERM *tail, ErlNifIOQueue *q, int fd) { + ErlNifIOVec vec, *iovec = &vec; + SysIOVec *sysiovec; + int saved_errno; + int iovcnt, n; + + if (!enif_inspect_iovec(env, 64, term, tail, &iovec)) + return -2; + + if (enif_ioq_size(q) > 0) { + /* If the I/O queue contains data we enqueue the iovec and then + peek the data to write out of the queue. */ + if (!enif_ioq_enqv(q, iovec, 0)) + return -3; + + sysiovec = enif_ioq_peek(q, &iovcnt); + } else { + /* If the I/O queue is empty we skip the trip through it. */ + iovcnt = iovec->iovcnt; + sysiovec = iovec->iov; + } + + /* Attempt to write the data */ + n = writev(fd, sysiovec, iovcnt); + saved_errno = errno; + + if (enif_ioq_size(q) == 0) { + /* If the I/O queue was initially empty we enqueue any + remaining data into the queue for writing later. */ + if (n >= 0 && !enif_ioq_enqv(q, iovec, n)) + return -3; + } else { + /* Dequeue any data that was written from the queue. */ + if (n > 0 && !enif_ioq_deq(q, n, NULL)) + return -4; + } + + /* return n, which is either number of bytes written or -1 if + some error happened */ + errno = saved_errno; + return n; +} +#endif + +static ERL_NIF_TERM ioq(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct ioq_resource *ioq; + ERL_NIF_TERM ret; + if (enif_is_identical(argv[0], enif_make_atom(env, "create"))) { + ErlNifIOQueue *q = enif_ioq_create(ERL_NIF_IOQ_NORMAL); + ioq = (struct ioq_resource *)enif_alloc_resource(ioq_resource_type, + sizeof(*ioq)); + ioq->q = q; + ret = enif_make_resource(env, ioq); + enif_release_resource(ioq); + return ret; + } else if (enif_is_identical(argv[0], enif_make_atom(env, "inspect"))) { + ErlNifIOVec vec, *iovec = NULL; + int i, iovcnt; + ERL_NIF_TERM *elems, tail, list; + ErlNifEnv *myenv = NULL; + + if (enif_is_identical(argv[2], enif_make_atom(env, "use_stack"))) + iovec = &vec; + if (enif_is_identical(argv[3], enif_make_atom(env, "use_env"))) + myenv = env; + if (!enif_inspect_iovec(myenv, ~(size_t)0, argv[1], &tail, &iovec)) + return enif_make_badarg(env); + + iovcnt = iovec->iovcnt; + elems = enif_alloc(sizeof(ERL_NIF_TERM) * iovcnt); + + for (i = 0; i < iovcnt; i++) { + ErlNifBinary bin; + if (!enif_alloc_binary(iovec->iov[i].iov_len, &bin)) { + enif_free_iovec(iovec); + enif_free(elems); + return enif_make_badarg(env); + } + memcpy(bin.data, iovec->iov[i].iov_base, iovec->iov[i].iov_len); + elems[i] = enif_make_binary(env, &bin); + } + + if (!myenv) + enif_free_iovec(iovec); + + list = enif_make_list_from_array(env, elems, iovcnt); + enif_free(elems); + return list; + } else { + unsigned skip; + if (!enif_get_resource(env, argv[1], ioq_resource_type, (void**)&ioq) + || !ioq->q) + return enif_make_badarg(env); + + if (enif_is_identical(argv[0], enif_make_atom(env, "example"))) { +#ifndef __WIN32__ + int fd[2], res = 0, cnt = 0, queue_cnt; + ERL_NIF_TERM tail; + char buff[255]; + pipe(fd); + fcntl(fd[0], F_SETFL, fcntl(fd[0], F_GETFL) | O_NONBLOCK); + fcntl(fd[1], F_SETFL, fcntl(fd[1], F_GETFL) | O_NONBLOCK); + + /* Write until the pipe buffer is full, which should result in data + * being queued up. */ + for (res = 0; res >= 0; ) { + cnt += res; + res = writeiovec(env, argv[2], &tail, ioq->q, fd[1]); + } + /* Flush the queue while reading from the other end of the pipe. */ + tail = enif_make_list(env, 0); + while (enif_ioq_size(ioq->q) > 0) { + res = writeiovec(env, tail, &tail, ioq->q, fd[1]); + + if (res < 0 && errno != EAGAIN) { + break; + } else if (res > 0) { + cnt += res; + } + + for (res = 0; res >= 0; ) { + cnt -= res; + res = read(fd[0], buff, sizeof(buff)); + } + } + + close(fd[0]); + close(fd[1]); + + /* Check that we read as much as we wrote */ + if (cnt == 0 && enif_ioq_size(ioq->q) == 0) + return enif_make_atom(env, "true"); + + return enif_make_int(env, cnt); +#else + return enif_make_atom(env, "true"); +#endif + } + if (enif_is_identical(argv[0], enif_make_atom(env, "destroy"))) { + enif_ioq_destroy(ioq->q); + ioq->q = NULL; + return enif_make_atom(env, "false"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqv"))) { + ErlNifIOVec vec, *iovec = &vec; + ERL_NIF_TERM tail; + + if (!enif_get_uint(env, argv[3], &skip)) + return enif_make_badarg(env); + if (!enif_inspect_iovec(env, ~0ul, argv[2], &tail, &iovec)) + return enif_make_badarg(env); + if (!enif_ioq_enqv(ioq->q, iovec, skip)) + return enif_make_badarg(env); + + return enif_make_atom(env, "true"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqb"))) { + ErlNifBinary bin; + if (!enif_get_uint(env, argv[3], &skip) || + !enif_inspect_binary(env, argv[2], &bin)) + return enif_make_badarg(env); + + if (!enif_ioq_enq_binary(ioq->q, &bin, skip)) + return enif_make_badarg(env); + + return enif_make_atom(env, "true"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqbraw"))) { + ErlNifBinary bin; + ErlNifBinary localbin; + int i; + if (!enif_get_uint(env, argv[3], &skip) || + !enif_inspect_binary(env, argv[2], &bin) || + !enif_alloc_binary(bin.size, &localbin)) + return enif_make_badarg(env); + + memcpy(localbin.data, bin.data, bin.size); + i = enif_ioq_enq_binary(ioq->q, &localbin, skip); + if (!i) + return enif_make_badarg(env); + else + return enif_make_atom(env, "true"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "peek"))) { + int iovlen, num, i, off = 0; + SysIOVec *iov = enif_ioq_peek(ioq->q, &iovlen); + ErlNifBinary bin; + + if (!enif_get_int(env, argv[2], &num) || !enif_alloc_binary(num, &bin)) + return enif_make_badarg(env); + + for (i = 0; i < iovlen && num > 0; i++) { + int to_copy = num < iov[i].iov_len ? num : iov[i].iov_len; + memcpy(bin.data + off, iov[i].iov_base, to_copy); + num -= to_copy; + off += to_copy; + } + + return enif_make_binary(env, &bin); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "deq"))) { + int num; + size_t sz; + ErlNifUInt64 sz64; + if (!enif_get_int(env, argv[2], &num)) + return enif_make_badarg(env); + + if (!enif_ioq_deq(ioq->q, num, &sz)) + return enif_make_badarg(env); + + sz64 = sz; + + return enif_make_uint64(env, sz64); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "size"))) { + ErlNifUInt64 size = enif_ioq_size(ioq->q); + return enif_make_uint64(env, size); + } + } + + return enif_make_badarg(env); +} static ErlNifFunc nif_funcs[] = { @@ -3255,7 +3492,11 @@ static ErlNifFunc nif_funcs[] = {"whereis_send", 3, whereis_send}, {"whereis_term", 2, whereis_term}, {"whereis_thd_lookup", 2, whereis_thd_lookup}, - {"whereis_thd_result", 1, whereis_thd_result} + {"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,NULL,upgrade,unload) diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 1c76eb8019..d950179882 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -118,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), @@ -167,8 +168,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]), @@ -184,6 +185,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) -> @@ -197,6 +201,49 @@ 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}]), + 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). + +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) -> @@ -331,18 +378,26 @@ t_trunc_and_friends(_Config) -> -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) -> - F0 = rand:uniform() * math:pow(10, 50*rand:normal()), - F = case rand:uniform() of - U when U < 0.5 -> -F0; - _ -> F0 - end, - _ = trunc_and_friends(F), + _ = trunc_and_friends(rand_float()), t_trunc_and_friends_rand(N-1). trunc_and_friends(F) -> @@ -491,7 +546,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/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index f512fa3a57..730a17d7e8 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -86,6 +86,7 @@ cd_relative/1, close_deaf_port/1, count_fds/1, + dropped_commands/1, dying_port/1, env/1, eof/1, @@ -158,7 +159,7 @@ suite() -> 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, @@ -548,6 +549,47 @@ make_dying_port(Config) when is_list(Config) -> Command = lists:concat([PortTest, " -h0 -d -q"]), open_port({spawn, Command}, [stream]). +%% Test that dropped port_commands work correctly. +%% This used to cause a segfault. +%% +%% This testcase creates a port and then lets many processes +%% do parallel commands to it. After a while it closes the +%% port and we are trying to catch the race when doing a +%% command while the port is closing. +dropped_commands(Config) -> + %% Test with output callback + dropped_commands(Config, false, {self(), {command, "1"}}), + %% Test with outputv callback + dropped_commands(Config, true, {self(), {command, "1"}}). + +dropped_commands(Config, Outputv, Cmd) -> + Path = proplists:get_value(data_dir, Config), + os:putenv("ECHO_DRV_USE_OUTPUTV", atom_to_list(Outputv)), + ok = load_driver(Path, "echo_drv"), + [dropped_commands_test(Cmd) || _ <- lists:seq(1, 100)], + timer:sleep(100), + erl_ddll:unload_driver("echo_drv"), + os:unsetenv("ECHO_DRV_USE_OUTPUTV"), + ok. + +dropped_commands_test(Cmd) -> + spawn_monitor( + fun() -> + Port = erlang:open_port({spawn_driver, "echo_drv"}, + [{parallelism, true}]), + [spawn_link(fun() -> spin(Port, Cmd) end) || _ <- lists:seq(1,8)], + timer:sleep(5), + port_close(Port), + timer:sleep(5), + exit(nok) + end), + receive _M -> timer:sleep(5) end. + +spin(P, Cmd) -> + P ! Cmd, + spin(P, Cmd). + + %% Tests that port program with complete path (but without any %% .exe extension) can be started, even if there is a file with %% the same name but without the extension in the same directory. 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/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 6ded7ff1c9..899a5c26bd 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -58,6 +58,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]). @@ -104,7 +105,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) -> @@ -152,7 +153,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) -> @@ -2527,9 +2532,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), @@ -2541,7 +2602,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} -> @@ -2550,7 +2614,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/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl index 5f519d522e..74df857c65 100644 --- a/erts/emulator/test/ref_SUITE.erl +++ b/erts/emulator/test/ref_SUITE.erl @@ -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..49da94a775 100644 --- a/erts/emulator/test/register_SUITE.erl +++ b/erts/emulator/test/register_SUITE.erl @@ -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/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index 7690557fda..40cc940a94 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -23,8 +23,10 @@ %% 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, @@ -54,11 +56,23 @@ all() -> 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 @@ -102,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. diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl index 9b678fcff9..00237c329c 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -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,7 +141,7 @@ 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. @@ -172,12 +174,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 +251,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 +300,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 +346,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 +358,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 +399,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. %%% diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 72acd33033..a81aa64057 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -38,7 +38,7 @@ system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, system_monitor_long_schedule/1, - bad_flag/1, trace_delivered/1]). + bad_flag/1, trace_delivered/1, trap_exit_self_receive/1]). -include_lib("common_test/include/ct.hrl"). @@ -61,7 +61,8 @@ all() -> 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]. init_per_testcase(_Case, Config) -> [{receiver,spawn(fun receiver/0)}|Config]. @@ -1709,6 +1710,31 @@ 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. + drop_trace_until_down(Proc, Mon) -> drop_trace_until_down(Proc, Mon, false, 0, 0). @@ -1791,6 +1817,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); |