diff options
Diffstat (limited to 'erts/emulator/test')
| -rw-r--r-- | erts/emulator/test/alloc_SUITE.erl | 142 | ||||
| -rw-r--r-- | erts/emulator/test/alloc_SUITE_data/allocator_test.h | 5 | ||||
| -rw-r--r-- | erts/emulator/test/alloc_SUITE_data/migration.c | 112 | ||||
| -rw-r--r-- | erts/emulator/test/binary_SUITE.erl | 1 | ||||
| -rw-r--r-- | erts/emulator/test/code_SUITE.erl | 55 | ||||
| -rw-r--r-- | erts/emulator/test/code_SUITE_data/erl_544.erl | 35 | ||||
| -rw-r--r-- | erts/emulator/test/iovec_SUITE.erl | 46 | ||||
| -rw-r--r-- | erts/emulator/test/nif_SUITE.erl | 30 | ||||
| -rw-r--r-- | erts/emulator/test/num_bif_SUITE.erl | 73 |
9 files changed, 420 insertions, 79 deletions
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/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 61536bacd7..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]), diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index dca600bc7b..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. @@ -27,7 +27,8 @@ 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"). @@ -41,7 +42,8 @@ all() -> module_md5, constant_pools, constant_refc_binaries, fake_literals, false_dependency, - coverage, fun_confusion, t_copy_literals, t_copy_literals_frags]. + 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), @@ -918,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/iovec_SUITE.erl b/erts/emulator/test/iovec_SUITE.erl index 49dc64b0d2..963b7e2501 100644 --- a/erts/emulator/test/iovec_SUITE.erl +++ b/erts/emulator/test/iovec_SUITE.erl @@ -25,7 +25,8 @@ -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]). + iolist_to_iovec_correctness/1, unaligned_sub_binaries/1, + direct_binary_arg/1]). -include_lib("common_test/include/ct.hrl"). @@ -36,7 +37,8 @@ suite() -> 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]. + iolist_to_iovec_idempotence, iolist_to_iovec_correctness, + unaligned_sub_binaries, direct_binary_arg]. init_per_suite(Config) -> Config. @@ -78,7 +80,7 @@ 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]], + BadTails = [["test" | 0], ["gurka" | gaffel], ["gaffel" | <<1:1>>]], Variations = BitStrs ++ BadInts ++ Atoms ++ BadTails, @@ -98,14 +100,7 @@ cons_bomb(Config) when is_list(Config) -> BinBase = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]), MixBase = gen_variations([<<12, 45, 78>>, lists:seq(1, 255)]), - Rounds = - case system_mem_size() of - Mem when Mem >= (16 bsl 30) -> 32; - Mem when Mem >= (3 bsl 30) -> 28; - _ -> 20 - end, - - Variations = gen_variations([IntBase, BinBase, MixBase], Rounds), + 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) -> @@ -130,6 +125,21 @@ iolist_to_iovec_correctness(Config) when is_list(Config) -> 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. @@ -145,11 +155,18 @@ equivalence_test(Fun, [Head | _] = Variations) -> 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, 16). + gen_variations(Base, 12). gen_variations(Base, N) -> [gen_flat_list(Base, N), gen_nested_list(Base, N), @@ -169,8 +186,3 @@ gen_nasty_list_1([Head | Base], Result) when is_list(Head) -> gen_nasty_list_1(Base, [[Result], [gen_nasty_list_1(Head, [])]]); gen_nasty_list_1([Head | Base], Result) -> gen_nasty_list_1(Base, [[Result], [Head]]). - -system_mem_size() -> - application:ensure_all_started(os_mon), - {Tot,_Used,_} = memsup:get_memory_data(), - Tot. diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 4811244b98..ac2b136a38 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -2983,8 +2983,24 @@ nif_ioq(Config) -> {enqv, a, 5, iolist_size(nif_ioq_payload(5)) - 1}, {peek, a}, - %% Test to enqueue a bunch of refc binaries + %% 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}, @@ -3120,13 +3136,16 @@ nif_ioq_payload(N) when is_integer(N) -> Tail = if N > 3 -> nif_ioq_payload(N-3); true -> [] end, Head = element(1, lists:split(N,[nif_ioq_payload(subbin), nif_ioq_payload(heapbin), - nif_ioq_payload(refcbin) | Tail])), + 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) -> @@ -3134,6 +3153,13 @@ nif_ioq_payload(refcbin) -> 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. call_history() -> ?nif_stub. 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}]), |