diff options
Diffstat (limited to 'erts/emulator/test')
32 files changed, 1581 insertions, 326 deletions
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 7c7ddde5d4..aa6a1fbcdc 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -31,7 +31,8 @@ rbtree/1, mseg_clear_cache/1, erts_mmap/1, - cpool/1]). + cpool/1, + migration/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -43,7 +44,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, coalesce, threads, realloc_copy, bucket_index, - bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool]. + bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool, migration]. groups() -> []. @@ -64,7 +65,7 @@ end_per_group(_GroupName, Config) -> init_per_testcase(Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), - [{watchdog, Dog},{testcase, Case}|Config]. + [{watchdog, Dog}, {testcase, Case}, {debug,false} | Config]. end_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), @@ -112,6 +113,14 @@ cpool(suite) -> []; cpool(doc) -> []; cpool(Cfg) -> ?line drv_case(Cfg). +migration(Cfg) -> + case erlang:system_info(smp_support) of + true -> + drv_case(Cfg, concurrent, "+MZe true"); + false -> + {skipped, "No smp"} + end. + erts_mmap(Config) when is_list(Config) -> case {?t:os_type(), is_halfword_vm()} of {{unix, _}, false} -> @@ -176,18 +185,17 @@ erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> %% %% drv_case(Config) -> - drv_case(Config, ""). + drv_case(Config, one_shot, ""). -drv_case(Config, Command) when is_list(Config), - is_list(Command) -> +drv_case(Config, Mode, NodeOpts) when is_list(Config) -> case ?t:os_type() of {Family, _} when Family == unix; Family == win32 -> - ?line {ok, Node} = start_node(Config), + ?line {ok, Node} = start_node(Config, NodeOpts), ?line Self = self(), ?line Ref = make_ref(), ?line spawn_link(Node, fun () -> - Res = run_drv_case(Config, Command), + Res = run_drv_case(Config, Mode), Self ! {Ref, Res} end), ?line Result = receive {Ref, Rslt} -> Rslt end, @@ -199,49 +207,172 @@ drv_case(Config, Command) when is_list(Config), | io_lib:format("~p",[SkipOs])])} end. -run_drv_case(Config, Command) -> - ?line DataDir = ?config(data_dir,Config), - ?line CaseName = ?config(testcase,Config), - case erl_ddll:load_driver(DataDir, CaseName) of - ok -> ok; - {error, Error} -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - ?line ?t:fail() +run_drv_case(Config, Mode) -> + DataDir = ?config(data_dir,Config), + CaseName = ?config(testcase,Config), + File = filename:join(DataDir, CaseName), + {ok,CaseName,Bin} = compile:file(File, [binary,return_errors]), + {module,CaseName} = erlang:load_module(CaseName,Bin), + print_stats(CaseName), + ok = CaseName:init(File), + + SlaveState = slave_init(CaseName), + case Mode of + one_shot -> + Result = one_shot(CaseName); + + concurrent -> + Result = concurrent(CaseName) end, - ?line Port = open_port({spawn, atom_to_list(CaseName)}, []), - ?line true = is_port(Port), - ?line Port ! {self(), {command, Command}}, - ?line Result = receive_drv_result(Port, CaseName), - ?line Port ! {self(), close}, - ?line receive - {Port, closed} -> - ok - end, - ?line ok = erl_ddll:unload_driver(CaseName), - ?line Result. - -receive_drv_result(Port, CaseName) -> - ?line receive - {print, Port, CaseName, Str} -> - ?line ?t:format("~s", [Str]), - ?line receive_drv_result(Port, CaseName); - {'EXIT', Port, Error} -> - ?line ?t:fail(Error); - {'EXIT', error, Error} -> - ?line ?t:fail(Error); - {failed, Port, CaseName, Comment} -> - ?line ?t:fail(Comment); - {skipped, Port, CaseName, Comment} -> - ?line {skipped, Comment}; - {succeeded, Port, CaseName, ""} -> - ?line succeeded; - {succeeded, Port, CaseName, Comment} -> - ?line {comment, Comment} - end. - -start_node(Config) -> - start_node(Config, []). + + wait_for_memory_deallocations(), + print_stats(CaseName), + + true = erlang:delete_module(CaseName), + slave_end(SlaveState), + Result. + +slave_init(migration) -> + A0 = case application:start(sasl) of + ok -> [sasl]; + _ -> [] + end, + case application:start(os_mon) of + ok -> [os_mon|A0]; + _ -> A0 + end; +slave_init(_) -> []. + +slave_end(Apps) -> + lists:foreach(fun (A) -> application:stop(A) end, Apps). + +wait_for_memory_deallocations() -> + try + erts_debug:set_internal_state(wait, deallocations) + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_for_memory_deallocations() + end. + +print_stats(migration) -> + {Btot,Ctot} = lists:foldl(fun({instance,Inr,Istats}, {Bacc,Cacc}) -> + {mbcs,MBCS} = lists:keyfind(mbcs, 1, Istats), + Btup = lists:keyfind(blocks, 1, MBCS), + Ctup = lists:keyfind(carriers, 1, MBCS), + io:format("{instance,~p,~p,~p}\n", [Inr, Btup, Ctup]), + {tuple_add(Bacc,Btup),tuple_add(Cacc,Ctup)}; + (_, Acc) -> Acc + end, + {{blocks,0,0,0},{carriers,0,0,0}}, + erlang:system_info({allocator,test_alloc})), + + io:format("Number of blocks : ~p\n", [Btot]), + io:format("Number of carriers: ~p\n", [Ctot]); + +print_stats(_) -> ok. + +tuple_add(T1, T2) -> + list_to_tuple(lists:zipwith(fun(E1,E2) when is_number(E1), is_number(E2) -> + E1 + E2; + (A,A) -> + A + end, + tuple_to_list(T1), tuple_to_list(T2))). + + +one_shot(CaseName) -> + State = CaseName:start({1, 0, erlang:system_info(build_type)}), + Result0 = CaseName:run(State), + false = (Result0 =:= continue), + Result1 = handle_result(State, Result0), + CaseName:stop(State), + Result1. + + +many_shot(CaseName, I, Mem) -> + State = CaseName:start({I, Mem, erlang:system_info(build_type)}), + Result1 = repeat_while(fun() -> + Result0 = CaseName:run(State), + handle_result(State, Result0) + end, + 10*1000, I), + CaseName:stop(State), + flush_log(), + Result1. + +concurrent(CaseName) -> + NSched = erlang:system_info(schedulers), + Mem = (free_memory() * 3) div 4, + PRs = lists:map(fun(I) -> spawn_opt(fun() -> + many_shot(CaseName, I, + Mem div NSched) + end, + [monitor, {scheduler,I}]) + end, + lists:seq(1, NSched)), + lists:foreach(fun({Pid,Ref}) -> + receive {'DOWN', Ref, process, Pid, Reason} -> + Reason + end + end, + PRs), + ok. + +repeat_while(Fun, Timeout, I) -> + TRef = erlang:start_timer(Timeout, self(), timeout), + R = repeat_while_loop(Fun, TRef, I), + erlang:cancel_timer(TRef, [{async,true},{info,false}]), + R. + +repeat_while_loop(Fun, TRef, I) -> + receive + {timeout, TRef, timeout} -> + io:format("~p: Timeout, enough is enough.",[I]), + succeeded + after 0 -> + %%io:format("~p calls fun\n", [self()]), + case Fun() of + continue -> repeat_while_loop(Fun, TRef, I); + R -> R + end + end. + +flush_log() -> + receive + {print, Str} -> + ?t:format("~s", [Str]), + flush_log() + after 0 -> + ok + end. + +handle_result(_State, Result0) -> + flush_log(), + case Result0 of + {'EXIT', Error} -> + ?line ?t:fail(Error); + {'EXIT', error, Error} -> + ?line ?t:fail(Error); + {failed, Comment} -> + ?line ?t:fail(Comment); + {skipped, Comment} -> + ?line {skipped, Comment}; + {succeeded, ""} -> + ?line succeeded; + {succeeded, Comment} -> + ?line {comment, Comment}; + continue -> + continue + end. + start_node(Config, Opts) when is_list(Config), is_list(Opts) -> + case ?config(debug,Config) of + true -> {ok, node()}; + _ -> start_node_1(Config, Opts) + end. + +start_node_1(Config, Opts) -> Pa = filename:dirname(code:which(?MODULE)), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" @@ -252,6 +383,7 @@ start_node(Config, Opts) when is_list(Config), is_list(Opts) -> ++ integer_to_list(erlang:unique_integer([positive]))), ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). +stop_node(Node) when Node =:= node() -> ok; stop_node(Node) -> ?t:stop_node(Node). @@ -261,3 +393,23 @@ is_halfword_vm() -> {4, 8} -> true; {WS, WS} -> false end. + +free_memory() -> + %% Free memory in MB. + try + SMD = memsup:get_system_memory_data(), + {value, {free_memory, Free}} = lists:keysearch(free_memory, 1, SMD), + TotFree = (Free + + case lists:keysearch(cached_memory, 1, SMD) of + {value, {cached_memory, Cached}} -> Cached; + false -> 0 + end + + case lists:keysearch(buffered_memory, 1, SMD) of + {value, {buffered_memory, Buffed}} -> Buffed; + false -> 0 + end), + TotFree div (1024*1024) + catch + error : undef -> + ?t:fail({"os_mon not built"}) + end. diff --git a/erts/emulator/test/alloc_SUITE_data/Makefile.src b/erts/emulator/test/alloc_SUITE_data/Makefile.src index a441fe946b..e31de54e1b 100644 --- a/erts/emulator/test/alloc_SUITE_data/Makefile.src +++ b/erts/emulator/test/alloc_SUITE_data/Makefile.src @@ -25,7 +25,8 @@ TEST_DRVS = basic@dll@ \ bucket_mask@dll@ \ rbtree@dll@ \ mseg_clear_cache@dll@ \ - cpool@dll@ + cpool@dll@ \ + migration@dll@ CC = @CC@ LD = @LD@ diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h index 1d6b2f4907..97ee58cdad 100644 --- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h +++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h @@ -20,9 +20,20 @@ #ifndef ALLOCATOR_TEST_H__ #define ALLOCATOR_TEST_H__ -typedef ErlDrvUInt Ulong; +#if SIZEOF_VOID_P == SIZEOF_INT +typedef unsigned int Ulong; +#elif SIZEOF_VOID_P == SIZEOF_LONG +typedef unsigned long Ulong; +#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG +typedef unsigned long long Ulong; +#else +# error No pointer sized integer type found ??? +#endif -#ifndef __WIN32__ +#ifdef __WIN32__ +typedef Ulong erts_alc_test_Fn(Ulong, Ulong, Ulong, Ulong); +# define erts_alc_test ((erts_alc_test_Fn*)WinDynNifCallbacks.erts_alc_test) +#else Ulong erts_alc_test(Ulong, Ulong, Ulong, Ulong); #endif @@ -85,6 +96,7 @@ typedef void* erts_cond; #define CPOOL_DELETE(A,B) ((Carrier_t *) ALC_TEST2(0x022, (A), (B))) #define CPOOL_IS_EMPTY(A) ((int) ALC_TEST1(0x023, (A))) #define CPOOL_IS_IN_POOL(A,B) ((int) ALC_TEST2(0x024, (A), (B))) +#define UMEM2BLK_TEST(P) ((Block_t*) ALC_TEST1(0x025, (P))) /* From erl_goodfit_alloc.c */ #define BKT_IX(A, S) ((Ulong) ALC_TEST2(0x100, (A), (S))) @@ -142,5 +154,9 @@ typedef void* erts_cond; #define THR_JOIN(T) ((void) ALC_TEST1(0xf11, (T))) #define THR_EXIT(R) ((void) ALC_TEST1(0xf12, (R))) #define IS_SMP_ENABLED ((int) ALC_TEST0(0xf13)) +#define ALLOC_TEST(S) ((void*) ALC_TEST1(0xf14, (S))) +#define FREE_TEST(P) ((void) ALC_TEST1(0xf15, (P))) +#define SET_TEST_MBC_USER_HEADER(SZ,CMBC,DMBC) ((int)ALC_TEST3(0xf16, (SZ), (CMBC), (DMBC))) +#define GET_TEST_MBC_SIZE() ((int) ALC_TEST0(0xf17)) #endif diff --git a/erts/emulator/test/alloc_SUITE_data/basic.c b/erts/emulator/test/alloc_SUITE_data/basic.c index 323a24a11f..debb3d7ebe 100644 --- a/erts/emulator/test/alloc_SUITE_data/basic.c +++ b/erts/emulator/test/alloc_SUITE_data/basic.c @@ -60,3 +60,6 @@ testcase_cleanup(TestCaseState_t *tcs) if (tcs->extra) STOP_ALC((Allctr_t *) tcs->extra); } + +ERL_NIF_INIT(basic, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/basic.erl b/erts/emulator/test/alloc_SUITE_data/basic.erl new file mode 100644 index 0000000000..a018fd5582 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/basic.erl @@ -0,0 +1,10 @@ +-module(basic). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_index.c b/erts/emulator/test/alloc_SUITE_data/bucket_index.c index c13f229049..45cb53fbf7 100644 --- a/erts/emulator/test/alloc_SUITE_data/bucket_index.c +++ b/erts/emulator/test/alloc_SUITE_data/bucket_index.c @@ -113,3 +113,5 @@ test_it(TestCaseState_t *tcs, unsigned sbct) sbct ? sbct_buf : "default"); } +ERL_NIF_INIT(bucket_index, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_index.erl b/erts/emulator/test/alloc_SUITE_data/bucket_index.erl new file mode 100644 index 0000000000..c54f54e2f5 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/bucket_index.erl @@ -0,0 +1,10 @@ +-module(bucket_index). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c index 8d6166771e..c94c265f4e 100644 --- a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c +++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c @@ -52,7 +52,7 @@ testcase_run(TestCaseState_t *tcs) typedef struct linked_block { struct linked_block* next; }Linked; - Linked* link; + Linked* link = NULL; Linked* fence_list; Linked* pad_list; void* tmp; @@ -183,3 +183,5 @@ testcase_run(TestCaseState_t *tcs) tcs->extra = NULL; } +ERL_NIF_INIT(bucket_mask, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl b/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl new file mode 100644 index 0000000000..589a50e1fa --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl @@ -0,0 +1,10 @@ +-module(bucket_mask). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.c b/erts/emulator/test/alloc_SUITE_data/coalesce.c index 0a5e0c5b0e..7791409a34 100644 --- a/erts/emulator/test/alloc_SUITE_data/coalesce.c +++ b/erts/emulator/test/alloc_SUITE_data/coalesce.c @@ -317,3 +317,6 @@ testcase_cleanup(TestCaseState_t *tcs) if (tcs->extra) STOP_ALC((Allctr_t *) tcs->extra); } + +ERL_NIF_INIT(coalesce, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.erl b/erts/emulator/test/alloc_SUITE_data/coalesce.erl new file mode 100644 index 0000000000..453c726c4e --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/coalesce.erl @@ -0,0 +1,10 @@ +-module(coalesce). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.c b/erts/emulator/test/alloc_SUITE_data/cpool.c index 75c2bc13ae..73026cc758 100644 --- a/erts/emulator/test/alloc_SUITE_data/cpool.c +++ b/erts/emulator/test/alloc_SUITE_data/cpool.c @@ -86,13 +86,13 @@ thread_func(void *arg) for (i = 0; i < (TEST_NO_CARRIERS_PER_THREAD+TEST_CARRIERS_OFFSET); i++) { int d; if (i < TEST_NO_CARRIERS_PER_THREAD) { - CPOOL_INSERT(alloc, crr[i]); + (void) CPOOL_INSERT(alloc, crr[i]); if ((i & 0x7) == 0) FATAL_ASSERT(CPOOL_IS_IN_POOL(alloc, crr[i])); } d = i-TEST_CARRIERS_OFFSET; if (d >= 0) { - CPOOL_DELETE(alloc, crr[d]); + (void) CPOOL_DELETE(alloc, crr[d]); if ((d & 0x7) == 0) FATAL_ASSERT(!CPOOL_IS_IN_POOL(alloc, crr[d])); } @@ -129,7 +129,7 @@ testcase_run(TestCaseState_t *tcs) for (c = 0; c < TEST_NO_CARRIERS_PER_THREAD; c++) { Carrier_t *crr = (Carrier_t *) p; p += zcrr_sz; - ZERO_CRR_INIT(alloc, crr); + (void) ZERO_CRR_INIT(alloc, crr); threads[t].crr[c] = crr; } } @@ -156,3 +156,6 @@ testcase_run(TestCaseState_t *tcs) ASSERT(tcs, no_threads == TEST_NO_THREADS); } + +ERL_NIF_INIT(cpool, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.erl b/erts/emulator/test/alloc_SUITE_data/cpool.erl new file mode 100644 index 0000000000..89053471fa --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/cpool.erl @@ -0,0 +1,10 @@ +-module(cpool). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/migration.c b/erts/emulator/test/alloc_SUITE_data/migration.c new file mode 100644 index 0000000000..b006360043 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/migration.c @@ -0,0 +1,343 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Test the carrier migration logic + */ + +#ifndef __WIN32__ +#include <sys/types.h> +#include <unistd.h> +#include <errno.h> +#endif +#include <stdio.h> +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include "testcase_driver.h" +#include "allocator_test.h" + +#define FATAL_ASSERT(A) \ + ((void) ((A) \ + ? 1 \ + : (fatal_assert_failed(#A, \ + (char *) __FILE__, \ + __LINE__), \ + 0))) + +static void +fatal_assert_failed(char* expr, char* file, int line) +{ + fflush(stdout); + fprintf(stderr, "%s:%d: Assertion failed: %s\n", + file, line, expr); + fflush(stderr); + abort(); +} + + +char * +testcase_name(void) +{ + return "migration"; +} + +/* Turns out random_r() is a nonstandard glibc extension. +#define HAVE_RANDOM_R +*/ +#ifdef HAVE_RANDOM_R + +typedef struct { struct random_data rnd; char rndbuf[32]; } MyRandState; + +static void myrand_init(MyRandState* mrs, unsigned int seed) +{ + int res; + memset(&mrs->rnd, 0, sizeof(mrs->rnd)); + res = initstate_r(seed, mrs->rndbuf, sizeof(mrs->rndbuf), &mrs->rnd); + FATAL_ASSERT(res == 0); +} + +static int myrand(MyRandState* mrs) +{ + int32_t x; + int res = random_r(&mrs->rnd, &x); + FATAL_ASSERT(res == 0); + return (int)x; +} + +#else /* !HAVE_RANDOM_R */ + +typedef unsigned int MyRandState; + +static void myrand_init(MyRandState* mrs, unsigned int seed) +{ + *mrs = seed; +} + +static int myrand(MyRandState* mrs) +{ + /* Taken from rand(3) man page. + * Modified to return a full 31-bit value by using low half of *mrs as well. + */ + *mrs = (*mrs) * 1103515245 + 12345; + return (int) (((*mrs >> 16) | (*mrs << 16)) & ~(1 << 31)); +} + +#endif /* !HAVE_RANDOM_R */ + +#define MAX_BLOCK_PER_THR 200 +#define BLOCKS_PER_MBC 10 +#define MAX_ROUNDS 10000 + +typedef struct MyBlock_ { + struct MyBlock_* next; + struct MyBlock_** prevp; +} MyBlock; + +typedef struct { + MyBlock* blockv[MAX_BLOCK_PER_THR]; + MyRandState rand_state; + enum { GROWING, SHRINKING, CLEANUP, DONE } phase; + int nblocks; + int goal_nblocks; + int round; + int nr_of_migrations; + int nr_of_carriers; + int max_blocks_in_mbc; + int block_size; + int max_nblocks; +} MigrationState; + +typedef struct { + ErlNifMutex* mtx; + int nblocks; + MyBlock* first; + MigrationState* employer; +} MyCrrInfo; + + +static int crr_info_offset = -1; +static void (*orig_create_mbc_fn)(Allctr_t *allctr, Carrier_t *carrier); +static void (*orig_destroying_mbc_fn)(Allctr_t *allctr, Carrier_t *carrier); + +static void my_creating_mbc(Allctr_t *allctr, Carrier_t *carrier) +{ + MyCrrInfo* mci = (MyCrrInfo*) ((char*)carrier + crr_info_offset); + if (orig_create_mbc_fn) + orig_create_mbc_fn(allctr, carrier); + + mci->mtx = enif_mutex_create("alloc_SUITE.migration"); + mci->nblocks = 0; + mci->first = NULL; + mci->employer = NULL; +} + +static void my_destroying_mbc(Allctr_t *allctr, Carrier_t *carrier) +{ + MyCrrInfo* mci = (MyCrrInfo*) ((char*)carrier + crr_info_offset); + + FATAL_ASSERT(mci->nblocks == 0); + FATAL_ASSERT(mci->first == NULL); + enif_mutex_destroy(mci->mtx); + + if (orig_destroying_mbc_fn) + orig_destroying_mbc_fn(allctr, carrier); +} + +static int migration_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + void* creating_mbc_arg = (void*)my_creating_mbc; + void* destroying_mbc_arg = (void*)my_destroying_mbc; + + if (testcase_nif_init(env, priv_data, load_info)) + return -1; + + crr_info_offset = SET_TEST_MBC_USER_HEADER(sizeof(MyCrrInfo), + &creating_mbc_arg, + &destroying_mbc_arg); + FATAL_ASSERT(crr_info_offset >= 0); + orig_create_mbc_fn = creating_mbc_arg; + orig_destroying_mbc_fn = destroying_mbc_arg; + + return 0; +} + +static void add_block(MyBlock* p, MigrationState* state) +{ + MyCrrInfo* mci = (MyCrrInfo*)((char*)BLK_TO_MBC(UMEM2BLK_TEST(p)) + crr_info_offset); + + enif_mutex_lock(mci->mtx); + if (++mci->nblocks > state->max_blocks_in_mbc) + state->max_blocks_in_mbc = mci->nblocks; + p->next = mci->first; + p->prevp = &mci->first; + mci->first = p; + if (p->next) + p->next->prevp = &p->next; + if (mci->employer != state) { + if (!mci->employer) { + FATAL_ASSERT(mci->nblocks == 1); + state->nr_of_carriers++; + } + else { + state->nr_of_migrations++; + } + mci->employer = state; + } + enif_mutex_unlock(mci->mtx); +} + +static void remove_block(MyBlock* p) +{ + MyCrrInfo* mci = (MyCrrInfo*)((char*)BLK_TO_MBC(UMEM2BLK_TEST(p)) + crr_info_offset); + + enif_mutex_lock(mci->mtx); + mci->nblocks--; + if (p->next) + p->next->prevp = p->prevp; + *p->prevp = p->next; + enif_mutex_unlock(mci->mtx); +} + +static int rand_int(MigrationState* state, int low, int high) +{ + int x; + FATAL_ASSERT(high >= low); + x = myrand(&state->rand_state); + return low + (x % (high+1-low)); +} + + +static void do_cleanup(TestCaseState_t *tcs, MigrationState* state) +{ + if (state->nblocks == 0) { + state->phase = DONE; + testcase_printf(tcs, "%d: Done %d rounds", tcs->thr_nr, state->round); + testcase_printf(tcs, "%d: Cleanup all blocks", tcs->thr_nr); + testcase_printf(tcs, "%d: Empty carriers detected = %d", tcs->thr_nr, + state->nr_of_carriers); + testcase_printf(tcs, "%d: Migrations detected = %d", tcs->thr_nr, + state->nr_of_migrations); + testcase_printf(tcs, "%d: Max blocks in carrier = %d", tcs->thr_nr, + state->max_blocks_in_mbc); + } + else { + state->nblocks--; + if (state->blockv[state->nblocks]) { + remove_block(state->blockv[state->nblocks]); + FREE_TEST(state->blockv[state->nblocks]); + } + } +} + + +void +testcase_run(TestCaseState_t *tcs) +{ + MigrationState* state = (MigrationState*) tcs->extra; + + if (!tcs->extra) { + if (!IS_SMP_ENABLED) + testcase_skipped(tcs, "No SMP support"); + + tcs->extra = enif_alloc(sizeof(MigrationState)); + state = (MigrationState*) tcs->extra; + memset(state->blockv, 0, sizeof(state->blockv)); + myrand_init(&state->rand_state, tcs->thr_nr); + state->phase = GROWING; + state->nblocks = 0; + state->round = 0; + state->nr_of_migrations = 0; + state->nr_of_carriers = 0; + state->max_blocks_in_mbc = 0; + state->block_size = GET_TEST_MBC_SIZE() / (BLOCKS_PER_MBC+1); + if (MAX_BLOCK_PER_THR * state->block_size < tcs->free_mem) { + state->max_nblocks = MAX_BLOCK_PER_THR; + } else { + state->max_nblocks = tcs->free_mem / state->block_size; + } + state->goal_nblocks = rand_int(state, 1, state->max_nblocks); + } + + switch (state->phase) { + case GROWING: { + MyBlock* p; + FATAL_ASSERT(!state->blockv[state->nblocks]); + p = ALLOC_TEST(rand_int(state, state->block_size/2, state->block_size)); + FATAL_ASSERT(p); + add_block(p, state); + state->blockv[state->nblocks] = p; + if (++state->nblocks >= state->goal_nblocks) { + /*testcase_printf(tcs, "%d: Grown to %d blocks", tcs->thr_nr, state->nblocks);*/ + state->phase = SHRINKING; + state->goal_nblocks = rand_int(state, 0, state->goal_nblocks-1); + } + else + FATAL_ASSERT(!state->blockv[state->nblocks]); + break; + } + case SHRINKING: { + int ix = rand_int(state, 0, state->nblocks-1); + FATAL_ASSERT(state->blockv[ix]); + remove_block(state->blockv[ix]); + FREE_TEST(state->blockv[ix]); + state->blockv[ix] = state->blockv[--state->nblocks]; + state->blockv[state->nblocks] = NULL; + + if (state->nblocks <= state->goal_nblocks) { + /*testcase_printf(tcs, "%d: Shrunk to %d blocks", tcs->thr_nr, state->nblocks);*/ + if (++state->round >= MAX_ROUNDS) { + state->phase = CLEANUP; + } else { + state->phase = GROWING; + state->goal_nblocks = rand_int(state, state->goal_nblocks+1, state->max_nblocks); + } + } + break; + } + case CLEANUP: + do_cleanup(tcs, state); + break; + + default: + FATAL_ASSERT(!"Invalid phase"); + } + + if (state->phase == DONE) { + } + else { + testcase_continue(tcs); + } +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + MigrationState* state = (MigrationState*) tcs->extra; + + while (state->phase != DONE) + do_cleanup(tcs, state); + + enif_free(tcs->extra); + tcs->extra = NULL; +} + + +ERL_NIF_INIT(migration, testcase_nif_funcs, migration_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/migration.erl b/erts/emulator/test/alloc_SUITE_data/migration.erl new file mode 100644 index 0000000000..440a99becd --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/migration.erl @@ -0,0 +1,10 @@ +-module(migration). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c index 9c03f3a331..e5df3d647f 100644 --- a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c +++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c @@ -101,3 +101,6 @@ testcase_cleanup(TestCaseState_t *tcs) tcs->extra = NULL; } } + +ERL_NIF_INIT(mseg_clear_cache, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl new file mode 100644 index 0000000000..befd6c2e8e --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl @@ -0,0 +1,10 @@ +-module(mseg_clear_cache). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.c b/erts/emulator/test/alloc_SUITE_data/rbtree.c index 8d4d5535a8..38bbbdf90c 100644 --- a/erts/emulator/test/alloc_SUITE_data/rbtree.c +++ b/erts/emulator/test/alloc_SUITE_data/rbtree.c @@ -20,7 +20,7 @@ #include "testcase_driver.h" #include "allocator_test.h" -#define NO_BLOCKS 100000 +int NO_BLOCKS; #define RIGHT_VISITED (1 << 0) #define LEFT_VISITED (1 << 1) @@ -265,9 +265,10 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) ASSERT(tcs, curr_blacks == 0); ASSERT(tcs, i == -1); + /* testcase_printf(tcs, "Red-Black Tree OK! Max depth = %d; " "Black depth = %d\n", max_i+1, blacks < 0 ? 0 : blacks); - + */ return res; } @@ -468,6 +469,12 @@ testcase_run(TestCaseState_t *tcs) Allctr_t *a; rbtree_test_data *td; + NO_BLOCKS = 100*1000; + if (enif_is_identical(tcs->build_type, + enif_make_atom(tcs->curr_env,"valgrind"))) { + NO_BLOCKS /= 10; + } + /* Best fit... */ testcase_printf(tcs, "Setup...\n"); @@ -577,3 +584,6 @@ testcase_run(TestCaseState_t *tcs) testcase_printf(tcs, "aoffcaobf test succeeded!\n"); } + +ERL_NIF_INIT(rbtree, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.erl b/erts/emulator/test/alloc_SUITE_data/rbtree.erl new file mode 100644 index 0000000000..f5b7120ff2 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/rbtree.erl @@ -0,0 +1,10 @@ +-module(rbtree). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/realloc_copy.c b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c index e405f06225..c4147eb00d 100644 --- a/erts/emulator/test/alloc_SUITE_data/realloc_copy.c +++ b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c @@ -278,3 +278,5 @@ testcase_cleanup(TestCaseState_t *tcs) STOP_ALC((Allctr_t *) tcs->extra); } +ERL_NIF_INIT(realloc_copy, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl b/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl new file mode 100644 index 0000000000..cc6617bf64 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl @@ -0,0 +1,10 @@ +-module(realloc_copy). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.c b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c index bc674c56b7..7dcca544e5 100644 --- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.c +++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c @@ -23,141 +23,147 @@ #include <stdarg.h> #include <setjmp.h> #include <string.h> +#include <limits.h> #ifdef __WIN32__ -#undef HAVE_VSNPRINTF -#define HAVE_VSNPRINTF 1 -#define vsnprintf _vsnprintf +static void my_vsnprintf(char *outBuf, size_t size, const char *format, va_list ap) +{ + _vsnprintf(outBuf, size, format, ap); + outBuf[size-1] = 0; /* be sure string is terminated */ +} +#elif defined(HAVE_VSNPRINTF) +# define my_vsnprintf(B,S,F,A) (void)vsnprintf(B,S,F,A) +#else +# warning Using unsafe 'vsprintf' without buffer overflow protection +# define my_vsnprintf(B,S,F,A) (void)vsprintf(B,F,A) #endif -#ifndef HAVE_VSNPRINTF -#define HAVE_VSNPRINTF 0 -#endif +static void my_snprintf(char *outBuf, size_t size, const char *format, ...) +{ + va_list ap; + va_start(ap, format); + my_vsnprintf(outBuf, size, format, ap); + va_end(ap); +} #define COMMENT_BUF_SZ 4096 #define TESTCASE_FAILED 0 #define TESTCASE_SKIPPED 1 #define TESTCASE_SUCCEEDED 2 +#define TESTCASE_CONTINUE 3 typedef struct { TestCaseState_t visible; - ErlDrvPort port; - ErlDrvTermData port_id; int result; - jmp_buf done_jmp_buf; + jmp_buf* done_jmp_buf; char *comment; char comment_buf[COMMENT_BUF_SZ]; } InternalTestCaseState_t; -ErlDrvData testcase_drv_start(ErlDrvPort port, char *command); -void testcase_drv_stop(ErlDrvData drv_data); -void testcase_drv_run(ErlDrvData drv_data, char *buf, ErlDrvSizeT len); - -static ErlDrvEntry testcase_drv_entry = { - NULL, - testcase_drv_start, - testcase_drv_stop, - testcase_drv_run, - NULL, - NULL, - "testcase_drv", - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - 0, - NULL, - NULL, - NULL +ERL_NIF_TERM testcase_nif_start(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM testcase_nif_stop(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM testcase_nif_run(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +ErlNifFunc testcase_nif_funcs[] = +{ + {"start", 1, testcase_nif_start}, + {"run", 1, testcase_nif_run}, + {"stop", 1, testcase_nif_stop} }; +static ErlNifResourceType* testcase_rt; +static ERL_NIF_TERM print_atom; -DRIVER_INIT(testcase_drv) +int testcase_nif_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { - testcase_drv_entry.driver_name = testcase_name(); - return &testcase_drv_entry; + testcase_rt = enif_open_resource_type(env, NULL, "testcase_rt", NULL, + ERL_NIF_RT_CREATE, NULL); + + print_atom = enif_make_atom(env, "print"); + return 0; } -ErlDrvData -testcase_drv_start(ErlDrvPort port, char *command) -{ +ERL_NIF_TERM +testcase_nif_start(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ /* (ThrNr, FreeMeg, BuildType) */ + ERL_NIF_TERM ret; InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) - driver_alloc(sizeof(InternalTestCaseState_t)); - if (!itcs) { - return ERL_DRV_ERROR_GENERAL; + enif_alloc_resource(testcase_rt, sizeof(InternalTestCaseState_t)); + int free_megabyte; + const int max_megabyte = INT_MAX / (1024*1024); + const ERL_NIF_TERM* tpl; + int tpl_arity; + + if (!itcs + || !enif_get_tuple(env, argv[0], &tpl_arity, &tpl) + || tpl_arity != 3 + || !enif_get_int(env, tpl[0], &itcs->visible.thr_nr) + || !enif_get_int(env, tpl[1], &free_megabyte)) { + enif_make_badarg(env); } - + itcs->visible.free_mem = (free_megabyte < max_megabyte ? + free_megabyte : max_megabyte) * (1024*1024); itcs->visible.testcase_name = testcase_name(); + itcs->visible.build_type = tpl[2]; itcs->visible.extra = NULL; - itcs->port = port; - itcs->port_id = driver_mk_port(port); itcs->result = TESTCASE_FAILED; itcs->comment = ""; - return (ErlDrvData) itcs; + ret = enif_make_resource(env, itcs); + enif_release_resource(itcs); + return ret; } -void -testcase_drv_stop(ErlDrvData drv_data) +ERL_NIF_TERM +testcase_nif_stop(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - testcase_cleanup((TestCaseState_t *) drv_data); - driver_free((void *) drv_data); + InternalTestCaseState_t *itcs; + if (!enif_get_resource(env, argv[0], testcase_rt, (void**)&itcs)) + return enif_make_badarg(env); + testcase_cleanup(&itcs->visible); + return enif_make_atom(env,"ok"); } -void -testcase_drv_run(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) +ERL_NIF_TERM +testcase_nif_run(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) drv_data; - ErlDrvTermData result_atom; - ErlDrvTermData msg[12]; + InternalTestCaseState_t *itcs; + const char* result_atom; + jmp_buf the_jmp_buf; + + if (!enif_get_resource(env, argv[0], testcase_rt, (void**)&itcs)) + return enif_make_badarg(env); - itcs->visible.command = buf; - itcs->visible.command_len = len; + itcs->visible.curr_env = env; - if (setjmp(itcs->done_jmp_buf) == 0) { - testcase_run((TestCaseState_t *) itcs); + /* For some unknown reason, first call to setjmp crashes on win64 + * when jmp_buf is allocated as part of the resource. But it works when + * allocated on stack. It used to work when this was a driver. + */ + itcs->done_jmp_buf = &the_jmp_buf; + + if (setjmp(the_jmp_buf) == 0) { + testcase_run(&itcs->visible); itcs->result = TESTCASE_SUCCEEDED; } switch (itcs->result) { - case TESTCASE_SUCCEEDED: - result_atom = driver_mk_atom("succeeded"); - break; - case TESTCASE_SKIPPED: - result_atom = driver_mk_atom("skipped"); - break; - case TESTCASE_FAILED: + case TESTCASE_CONTINUE: + return enif_make_atom(env, "continue"); + + case TESTCASE_SUCCEEDED: result_atom = "succeeded"; break; + case TESTCASE_SKIPPED: result_atom = "skipped"; break; + case TESTCASE_FAILED: result_atom = "failed"; break; default: - result_atom = driver_mk_atom("failed"); - break; + result_atom = "failed"; + my_snprintf(itcs->comment_buf, sizeof(itcs->comment_buf), + "Unexpected test result code %d.", itcs->result); + itcs->comment = itcs->comment_buf; } - msg[0] = ERL_DRV_ATOM; - msg[1] = (ErlDrvTermData) result_atom; - - msg[2] = ERL_DRV_PORT; - msg[3] = itcs->port_id; - - msg[4] = ERL_DRV_ATOM; - msg[5] = driver_mk_atom(itcs->visible.testcase_name); - - msg[6] = ERL_DRV_STRING; - msg[7] = (ErlDrvTermData) itcs->comment; - msg[8] = (ErlDrvTermData) strlen(itcs->comment); - - msg[9] = ERL_DRV_TUPLE; - msg[10] = (ErlDrvTermData) 4; - - erl_drv_output_term(itcs->port_id, msg, 11); + return enif_make_tuple2(env, enif_make_atom(env, result_atom), + enif_make_string(env, itcs->comment, ERL_NIF_LATIN1)); } int @@ -172,34 +178,22 @@ testcase_assertion_failed(TestCaseState_t *tcs, void testcase_printf(TestCaseState_t *tcs, char *frmt, ...) { - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; - ErlDrvTermData msg[12]; + InternalTestCaseState_t* itcs = (InternalTestCaseState_t*)tcs; + ErlNifPid pid; + ErlNifEnv* msg_env = enif_alloc_env(); + ERL_NIF_TERM msg; va_list va; va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); - msg[0] = ERL_DRV_ATOM; - msg[1] = (ErlDrvTermData) driver_mk_atom("print"); + msg = enif_make_tuple2(msg_env, print_atom, + enif_make_string(msg_env, itcs->comment_buf, ERL_NIF_LATIN1)); - msg[2] = ERL_DRV_PORT; - msg[3] = itcs->port_id; + enif_send(itcs->visible.curr_env, enif_self(itcs->visible.curr_env, &pid), + msg_env, msg); - msg[4] = ERL_DRV_ATOM; - msg[5] = driver_mk_atom(itcs->visible.testcase_name); - - msg[6] = ERL_DRV_STRING; - msg[7] = (ErlDrvTermData) itcs->comment_buf; - msg[8] = (ErlDrvTermData) strlen(itcs->comment_buf); - - msg[9] = ERL_DRV_TUPLE; - msg[10] = (ErlDrvTermData) 4; - - erl_drv_output_term(itcs->port_id, msg, 11); + enif_free_env(msg_env); } @@ -208,17 +202,13 @@ void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...) InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; va_list va; va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); itcs->result = TESTCASE_SUCCEEDED; itcs->comment = itcs->comment_buf; - longjmp(itcs->done_jmp_buf, 1); + longjmp(*itcs->done_jmp_buf, 1); } void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...) @@ -226,17 +216,20 @@ void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...) InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; va_list va; va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); itcs->result = TESTCASE_SKIPPED; itcs->comment = itcs->comment_buf; - longjmp(itcs->done_jmp_buf, 1); + longjmp(*itcs->done_jmp_buf, 1); +} + +void testcase_continue(TestCaseState_t *tcs) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + itcs->result = TESTCASE_CONTINUE; + longjmp(*itcs->done_jmp_buf, 1); } void testcase_failed(TestCaseState_t *tcs, char *frmt, ...) @@ -246,37 +239,33 @@ void testcase_failed(TestCaseState_t *tcs, char *frmt, ...) size_t bufsz = sizeof(buf); va_list va; va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); itcs->result = TESTCASE_FAILED; itcs->comment = itcs->comment_buf; - if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + if (enif_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 && strcmp("true", buf) == 0) { fprintf(stderr, "Testcase \"%s\" failed: %s\n", itcs->visible.testcase_name, itcs->comment); abort(); } - longjmp(itcs->done_jmp_buf, 1); + longjmp(*itcs->done_jmp_buf, 1); } void *testcase_alloc(size_t size) { - return driver_alloc(size); + return enif_alloc(size); } void *testcase_realloc(void *ptr, size_t size) { - return driver_realloc(ptr, size); + return enif_realloc(ptr, size); } void testcase_free(void *ptr) { - driver_free(ptr); + enif_free(ptr); } diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h index 5d17eaec64..f0ca91bd06 100644 --- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h +++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h @@ -20,13 +20,15 @@ #ifndef TESTCASE_DRIVER_H__ #define TESTCASE_DRIVER_H__ -#include "erl_driver.h" +#include "erl_nif.h" #include <stdlib.h> typedef struct { + ErlNifEnv* curr_env; char *testcase_name; - char *command; - int command_len; + int thr_nr; + int free_mem; /* in bytes */ + ERL_NIF_TERM build_type; /* opt, debug, valgrind, ... */ void *extra; } TestCaseState_t; @@ -34,9 +36,11 @@ typedef struct { ((void) ((B) ? 1 : testcase_assertion_failed((TCS), __FILE__, __LINE__, #B))) +int testcase_nif_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); void testcase_printf(TestCaseState_t *tcs, char *frmt, ...); void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...); void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...); +void testcase_continue(TestCaseState_t *tcs); void testcase_failed(TestCaseState_t *tcs, char *frmt, ...); int testcase_assertion_failed(TestCaseState_t *tcs, char *file, int line, char *assertion); @@ -45,8 +49,11 @@ void *testcase_realloc(void *ptr, size_t size); void testcase_free(void *ptr); +/* Implemented by testcase: */ char *testcase_name(void); void testcase_run(TestCaseState_t *tcs); void testcase_cleanup(TestCaseState_t *tcs); -#endif +extern ErlNifFunc testcase_nif_funcs[3]; + +#endif /* TESTCASE_DRIVER_H__ */ diff --git a/erts/emulator/test/alloc_SUITE_data/threads.c b/erts/emulator/test/alloc_SUITE_data/threads.c index edad24ee6b..2f5f841e3d 100644 --- a/erts/emulator/test/alloc_SUITE_data/threads.c +++ b/erts/emulator/test/alloc_SUITE_data/threads.c @@ -86,7 +86,7 @@ static void fail(int t_no, char *frmt, ...) tc_failed = 1; - if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + if (enif_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 && strcmp("true", buf) == 0) { fprintf(stderr, "Testcase \"%s\" failed: %s\n", testcase_name(), err_buf); @@ -187,7 +187,6 @@ testcase_run(TestCaseState_t *tcs) for(i = 1; i <= NO_OF_THREADS; i++) { char *alc; - int res; threads[i].arg.no_ops_per_bl = NO_OF_OPS_PER_BL; @@ -397,7 +396,7 @@ alloc_op(int t_no, Allctr_t *a, block *bp, int id, int clean_up) bp->p = (unsigned char *) ALLOC(a, bp->s); if(!bp->p) fail(t_no, "ALLOC(%lu) failed [id=%d])\n", bp->s, id); - memset((void *) bp->p, id, (size_t) bp->s); + memset((void *) bp->p, (unsigned char)id, (size_t) bp->s); } else { unsigned char *p = (unsigned char *) REALLOC(a, bp->p, bp->as[bp->i]); @@ -407,7 +406,7 @@ alloc_op(int t_no, Allctr_t *a, block *bp, int id, int clean_up) if(bp->s < bp->as[bp->i]) { CHECK_BLOCK_DATA(t_no, p, bp->s, id); - memset((void *) p, id, (size_t) bp->as[bp->i]); + memset((void *) p, (unsigned char)id, (size_t) bp->as[bp->i]); } else CHECK_BLOCK_DATA(t_no, p, bp->as[bp->i], id); @@ -446,3 +445,6 @@ thread_func(void *arg) exit_thread(td->t_no, 1); return NULL; } + +ERL_NIF_INIT(threads, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/threads.erl b/erts/emulator/test/alloc_SUITE_data/threads.erl new file mode 100644 index 0000000000..a7b4965f5e --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/threads.erl @@ -0,0 +1,10 @@ +-module(threads). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 62a94e5281..a256cf4195 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -58,6 +58,7 @@ %% erlang t_erlang_hash/1, t_map_encode_decode/1, + t_gc_rare_map_overflow/1, %% non specific BIF related t_bif_build_and_check/1, @@ -121,6 +122,7 @@ all() -> [ %% erlang t_erlang_hash, t_map_encode_decode, + t_gc_rare_map_overflow, t_map_size, t_is_map, %% non specific BIF related @@ -2991,6 +2993,113 @@ do_badmap_17(Config) -> id(I) -> I. +%% OTP-13146 +%% Provoke major GC with a lot of "fat" maps on external format in msg queue +%% causing heap fragments to be allocated. +t_gc_rare_map_overflow(Config) -> + Pa = filename:dirname(code:which(?MODULE)), + {ok, Node} = test_server:start_node(gc_rare_map_overflow, slave, [{args, "-pa \""++Pa++"\""}]), + erts_debug:set_internal_state(available_internal_state, true), + try + Echo = spawn_link(Node, fun Loop() -> receive {From,Msg} -> From ! Msg + end, + Loop() + end), + FatMap = fatmap(34), + false = (flatmap =:= erts_internal:map_type(FatMap)), + + t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> erlang:garbage_collect() end), + + %% Repeat test for minor gc: + t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> minor_collect() end), + + unlink(Echo), + + %% Test fatmap in exit signal + Exiter = spawn_link(Node, fun Loop() -> receive {From,Msg} -> + "not_a_map" = Msg % badmatch! + end, + Loop() + end), + process_flag(trap_exit, true), + Exiter ! {self(), FatMap}, + {'EXIT', Exiter, {{badmatch,FatMap}, _}} = receive M -> M end, + ok + + after + process_flag(trap_exit, false), + erts_debug:set_internal_state(available_internal_state, false), + test_server:stop_node(Node) + end. + +t_gc_rare_map_overflow_do(Echo, FatMap, GcFun) -> + Master = self(), + true = receive M -> false after 0 -> true end, % assert empty msg queue + Echo ! {Master, token}, + repeat(1000, fun(_) -> Echo ! {Master, FatMap} end, void), + + timer:sleep(100), % Wait for maps to arrive in our msg queue + token = receive Tok -> Tok end, % and provoke move from outer to inner msg queue + + %% Do GC that will "overflow" and create heap frags due to all the fat maps + GcFun(), + + %% Now check that all maps in msg queueu are intact + %% Will crash emulator in OTP-18.1 + repeat(1000, fun(_) -> FatMap = receive FM -> FM end end, void), + ok. + +minor_collect() -> + Before = minor_gcs(), + erts_debug:set_internal_state(force_gc, self()), + erlang:yield(), + After = minor_gcs(), + io:format("minor_gcs: ~p -> ~p\n", [Before, After]). + +minor_gcs() -> + {garbage_collection, Info} = process_info(self(), garbage_collection), + {minor_gcs, GCS} = lists:keyfind(minor_gcs, 1, Info), + GCS. + +%% Generate a map with N (or N+1) keys that has an abnormal heap demand. +%% Done by finding keys that collide in the first 32-bit hash. +fatmap(N) -> + %%erts_debug:set_internal_state(available_internal_state, true), + Table = ets:new(void, [bag, private]), + + Seed0 = rand:seed_s(exsplus, {4711, 3141592, 2718281}), + Seed1 = fatmap_populate(Table, Seed0, (1 bsl 16)), + Keys = fatmap_generate(Table, Seed1, N, []), + ets:delete(Table), + maps:from_list([{K,K} || K <- Keys]). + +fatmap_populate(_, Seed, 0) -> Seed; +fatmap_populate(Table, Seed, N) -> + {I, NextSeed} = rand:uniform_s(1 bsl 48, Seed), + Hash = internal_hash(I), + ets:insert(Table, [{Hash, I}]), + fatmap_populate(Table, NextSeed, N-1). + + +fatmap_generate(_, _, N, Acc) when N =< 0 -> + Acc; +fatmap_generate(Table, Seed, N0, Acc0) -> + {I, NextSeed} = rand:uniform_s(1 bsl 48, Seed), + Hash = internal_hash(I), + case ets:member(Table, Hash) of + true -> + NewKeys = [I | ets:lookup_element(Table, Hash, 2)], + Acc1 = lists:usort(Acc0 ++ NewKeys), + N1 = N0 - (length(Acc1) - length(Acc0)), + fatmap_generate(Table, NextSeed, N1, Acc1); + false -> + fatmap_generate(Table, NextSeed, N0, Acc0) + end. + +internal_hash(Term) -> + erts_debug:get_internal_state({internal_hash, Term}). + + %% map external_format (fannerl). fannerl() -> <<131,116,0,0,0,28,100,0,13,108,101,97,114,110,105,110,103,95,114, diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index af2b955184..3d478654b1 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -42,7 +42,8 @@ otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1, dirty_nif_exception/1, call_dirty_nif_exception/1, nif_schedule/1, nif_exception/1, call_nif_exception/1, - nif_nan_and_inf/1, nif_atom_too_long/1 + nif_nan_and_inf/1, nif_atom_too_long/1, + nif_monotonic_time/1, nif_time_offset/1, nif_convert_time_unit/1 ]). -export([many_args_100/100]). @@ -72,7 +73,8 @@ all() -> otp_9828, otp_9668, consume_timeslice, nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception, - nif_exception, nif_nan_and_inf, nif_atom_too_long + nif_exception, nif_nan_and_inf, nif_atom_too_long, + nif_monotonic_time, nif_time_offset, nif_convert_time_unit ]. groups() -> @@ -1783,6 +1785,148 @@ nif_raise_exceptions(NifFunc) -> end end, ok, ExcTerms). +-define(ERL_NIF_TIME_ERROR, -9223372036854775808). +-define(TIME_UNITS, [seconds, milli_seconds, micro_seconds, nano_seconds]). + +nif_monotonic_time(Config) -> + ?ERL_NIF_TIME_ERROR = monotonic_time(invalid_time_unit), + mtime_loop(1000000). + +mtime_loop(0) -> + ok; +mtime_loop(N) -> + chk_mtime(?TIME_UNITS), + mtime_loop(N-1). + +chk_mtime([]) -> + ok; +chk_mtime([TU|TUs]) -> + A = erlang:monotonic_time(TU), + B = monotonic_time(TU), + C = erlang:monotonic_time(TU), + try + true = A =< B, + true = B =< C + catch + _ : _ -> + ?t:fail({monotonic_time_missmatch, TU, A, B, C}) + end, + chk_mtime(TUs). + +nif_time_offset(Config) -> + ?ERL_NIF_TIME_ERROR = time_offset(invalid_time_unit), + toffs_loop(1000000). + +toffs_loop(0) -> + ok; +toffs_loop(N) -> + chk_toffs(?TIME_UNITS), + toffs_loop(N-1). + +chk_toffs([]) -> + ok; +chk_toffs([TU|TUs]) -> + TO = erlang:time_offset(TU), + NifTO = time_offset(TU), + case TO =:= NifTO of + true -> + ok; + false -> + case erlang:system_info(time_warp_mode) of + no_time_warp -> + ?t:fail({time_offset_mismatch, TU, TO, NifTO}); + _ -> + %% Most frequent time offset change + %% is currently only every 15:th + %% second so this should currently + %% work... + NTO = erlang:time_offset(TU), + case NifTO =:= NTO of + true -> + ok; + false -> + ?t:fail({time_offset_mismatch, TU, TO, NifTO, NTO}) + end + end + end, + chk_toffs(TUs). + +nif_convert_time_unit(Config) -> + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, seconds, invalid_time_unit), + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, seconds), + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, invalid_time_unit), + lists:foreach(fun (Offset) -> + lists:foreach(fun (Diff) -> + chk_ctu(Diff+(Offset*1000*1000*1000)) + end, + [999999999999, + 99999999999, + 9999999999, + 999999999, + 99999999, + 9999999, + 999999, + 99999, + 999, + 99, + 9, + 1, + 11, + 101, + 1001, + 10001, + 100001, + 1000001, + 10000001, + 100000001, + 1000000001, + 100000000001, + 1000000000001, + 5, + 50, + 500, + 5000, + 50000, + 500000, + 5000000, + 50000000, + 500000000, + 5000000000, + 50000000000, + 500000000000]) + end, + [-4711, -1000, -475, -5, -4, -3, -2, -1, 0, + 1, 2, 3, 4, 5, 475, 1000, 4711]), + ctu_loop(1000000). + +ctu_loop(0) -> + ok; +ctu_loop(N) -> + chk_ctu(erlang:monotonic_time(nano_seconds)), + ctu_loop(N-1). + +chk_ctu(Time) -> + chk_ctu(Time, ?TIME_UNITS). + +chk_ctu(_Time, []) -> + ok; +chk_ctu(Time, [FromTU|FromTUs]) -> + chk_ctu(Time, FromTU, ?TIME_UNITS), + chk_ctu(Time, FromTUs). + +chk_ctu(_Time, _FromTU, []) -> + ok; +chk_ctu(Time, FromTU, [ToTU|ToTUs]) -> + T = erlang:convert_time_unit(Time, nano_seconds, FromTU), + TE = erlang:convert_time_unit(T, FromTU, ToTU), + TN = convert_time_unit(T, FromTU, ToTU), + case TE =:= TN of + false -> + ?t:fail({conversion_mismatch, FromTU, T, ToTU, TE, TN}); + true -> + chk_ctu(Time, FromTU, ToTUs) + end. + %% The NIFs: lib_version() -> undefined. call_history() -> ?nif_stub. @@ -1852,6 +1996,11 @@ make_map_remove_nif(_,_) -> ?nif_stub. maps_from_list_nif(_) -> ?nif_stub. sorted_list_from_maps_nif(_) -> ?nif_stub. +%% Time +monotonic_time(_) -> ?nif_stub. +time_offset(_) -> ?nif_stub. +convert_time_unit(_,_,_) -> ?nif_stub. + nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 98e1efe18f..8ebce4fef4 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -34,6 +34,10 @@ static ERL_NIF_TERM atom_self; static ERL_NIF_TERM atom_ok; static ERL_NIF_TERM atom_join; static ERL_NIF_TERM atom_binary_resource_type; +static ERL_NIF_TERM atom_seconds; +static ERL_NIF_TERM atom_milli_seconds; +static ERL_NIF_TERM atom_micro_seconds; +static ERL_NIF_TERM atom_nano_seconds; typedef struct @@ -138,6 +142,10 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) atom_ok = enif_make_atom(env,"ok"); atom_join = enif_make_atom(env,"join"); atom_binary_resource_type = enif_make_atom(env,"binary_resource_type"); + atom_seconds = enif_make_atom(env,"seconds"); + atom_milli_seconds = enif_make_atom(env,"milli_seconds"); + atom_micro_seconds = enif_make_atom(env,"micro_seconds"); + atom_nano_seconds = enif_make_atom(env,"nano_seconds"); *priv_data = data; return 0; @@ -1885,6 +1893,87 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER return enif_make_tuple2(env, list_f, list_b); } + +static ERL_NIF_TERM monotonic_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifTimeUnit time_unit; + + if (argc != 1) + return atom_false; + + if (enif_compare(argv[0], atom_seconds) == 0) + time_unit = ERL_NIF_SEC; + else if (enif_compare(argv[0], atom_milli_seconds) == 0) + time_unit = ERL_NIF_MSEC; + else if (enif_compare(argv[0], atom_micro_seconds) == 0) + time_unit = ERL_NIF_USEC; + else if (enif_compare(argv[0], atom_nano_seconds) == 0) + time_unit = ERL_NIF_NSEC; + else + time_unit = 4711; /* invalid time unit */ + + return enif_make_int64(env, enif_monotonic_time(time_unit)); +} + +static ERL_NIF_TERM time_offset(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifTimeUnit time_unit; + + if (argc != 1) + return atom_false; + + if (enif_compare(argv[0], atom_seconds) == 0) + time_unit = ERL_NIF_SEC; + else if (enif_compare(argv[0], atom_milli_seconds) == 0) + time_unit = ERL_NIF_MSEC; + else if (enif_compare(argv[0], atom_micro_seconds) == 0) + time_unit = ERL_NIF_USEC; + else if (enif_compare(argv[0], atom_nano_seconds) == 0) + time_unit = ERL_NIF_NSEC; + else + time_unit = 4711; /* invalid time unit */ + return enif_make_int64(env, enif_time_offset(time_unit)); +} + +static ERL_NIF_TERM convert_time_unit(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifSInt64 i64; + ErlNifTime val; + ErlNifTimeUnit from, to; + + if (argc != 3) + return atom_false; + + if (!enif_get_int64(env, argv[0], &i64)) + return enif_make_badarg(env); + + val = (ErlNifTime) i64; + + if (enif_compare(argv[1], atom_seconds) == 0) + from = ERL_NIF_SEC; + else if (enif_compare(argv[1], atom_milli_seconds) == 0) + from = ERL_NIF_MSEC; + else if (enif_compare(argv[1], atom_micro_seconds) == 0) + from = ERL_NIF_USEC; + else if (enif_compare(argv[1], atom_nano_seconds) == 0) + from = ERL_NIF_NSEC; + else + from = 4711; /* invalid time unit */ + + if (enif_compare(argv[2], atom_seconds) == 0) + to = ERL_NIF_SEC; + else if (enif_compare(argv[2], atom_milli_seconds) == 0) + to = ERL_NIF_MSEC; + else if (enif_compare(argv[2], atom_micro_seconds) == 0) + to = ERL_NIF_USEC; + else if (enif_compare(argv[2], atom_nano_seconds) == 0) + to = ERL_NIF_NSEC; + else + to = 4711; /* invalid time unit */ + + return enif_make_int64(env, enif_convert_time_unit(val, from, to)); +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -1954,7 +2043,10 @@ static ErlNifFunc nif_funcs[] = {"make_map_update_nif", 3, make_map_update_nif}, {"make_map_remove_nif", 2, make_map_remove_nif}, {"maps_from_list_nif", 1, maps_from_list_nif}, - {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif} + {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif}, + {"monotonic_time", 1, monotonic_time}, + {"time_offset", 1, time_offset}, + {"convert_time_unit", 3, convert_time_unit} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index 56ecf4195a..a6305d453c 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -32,7 +32,7 @@ run_queue_one/1, scheduler_wall_time/1, reductions/1, reductions_big/1, garbage_collection/1, io/1, - badarg/1]). + badarg/1, run_queues_lengths_active_tasks/1]). %% Internal exports. @@ -54,7 +54,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [{group, wall_clock}, {group, runtime}, reductions, reductions_big, {group, run_queue}, scheduler_wall_time, - garbage_collection, io, badarg]. + garbage_collection, io, badarg, + run_queues_lengths_active_tasks]. groups() -> [{wall_clock, [], @@ -409,3 +410,63 @@ badarg(Config) when is_list(Config) -> ?line case catch statistics(bad_atom) of {'EXIT', {badarg, _}} -> ok end. + +tok_loop() -> + tok_loop(). + +run_queues_lengths_active_tasks(Config) -> + TokLoops = lists:map(fun (_) -> + spawn_opt(fun () -> + tok_loop() + end, + [link, {priority, low}]) + end, + lists:seq(1,10)), + + TRQLs0 = statistics(total_run_queue_lengths), + TATs0 = statistics(total_active_tasks), + true = is_integer(TRQLs0), + true = is_integer(TATs0), + true = TRQLs0 >= 0, + true = TATs0 >= 11, + + NoScheds = erlang:system_info(schedulers), + RQLs0 = statistics(run_queue_lengths), + ATs0 = statistics(active_tasks), + NoScheds = length(RQLs0), + NoScheds = length(ATs0), + true = lists:sum(RQLs0) >= 0, + true = lists:sum(ATs0) >= 11, + + SO = erlang:system_flag(schedulers_online, 1), + + %% Give newly suspended schedulers some time to + %% migrate away work from their run queues... + receive after 1000 -> ok end, + + TRQLs1 = statistics(total_run_queue_lengths), + TATs1 = statistics(total_active_tasks), + true = TRQLs1 >= 10, + true = TATs1 >= 11, + NoScheds = erlang:system_info(schedulers), + + RQLs1 = statistics(run_queue_lengths), + ATs1 = statistics(active_tasks), + NoScheds = length(RQLs1), + NoScheds = length(ATs1), + TRQLs2 = lists:sum(RQLs1), + TATs2 = lists:sum(ATs1), + true = TRQLs2 >= 10, + true = TATs2 >= 11, + [TRQLs2|_] = RQLs1, + [TATs2|_] = ATs1, + + erlang:system_flag(schedulers_online, SO), + + lists:foreach(fun (P) -> + unlink(P), + exit(P, bang) + end, + TokLoops), + + ok. diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl index e4b6511d1f..2ecb4a28a7 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -113,13 +113,27 @@ runnable_procs(suite) -> runnable_procs(doc) -> ["Tests system_profiling with runnable_procs."]; runnable_procs(Config) when is_list(Config) -> + lists:foreach(fun (TsType) -> + Arg = case TsType of + no_timestamp -> + {timestamp, []}; + _ -> + {TsType, [TsType]} + end, + do_runnable_procs(Arg), + receive after 1000 -> ok end + end, + [no_timestamp, timestamp, monotonic_timestamp, + strict_monotonic_timestamp]). + +do_runnable_procs({TsType, TsTypeFlag}) -> Pid = start_profiler_process(), % start a ring of processes % FIXME: Set #laps and #nodes in config file Nodes = 10, Laps = 10, Master = ring(Nodes), - undefined = erlang:system_profile(Pid, [runnable_procs]), + undefined = erlang:system_profile(Pid, [runnable_procs]++TsTypeFlag), % loop a message ok = ring_message(Master, message, Laps), Events = get_profiler_events(), @@ -127,9 +141,9 @@ runnable_procs(Config) when is_list(Config) -> erlang:system_profile(undefined, []), put(master, Master), put(laps, Laps), - true = has_runnable_event(Events), + true = has_runnable_event(TsType, Events), Pids = sort_events_by_pid(Events), - ok = check_events(Pids), + ok = check_events(TsType, Pids), erase(), exit(Pid,kill), ok. @@ -139,8 +153,22 @@ runnable_ports(suite) -> runnable_ports(doc) -> ["Tests system_profiling with runnable_port."]; runnable_ports(Config) when is_list(Config) -> + lists:foreach(fun (TsType) -> + Arg = case TsType of + no_timestamp -> + {timestamp, []}; + _ -> + {TsType, [TsType]} + end, + do_runnable_ports(Arg, Config), + receive after 1000 -> ok end + end, + [no_timestamp, timestamp, monotonic_timestamp, + strict_monotonic_timestamp]). + +do_runnable_ports({TsType, TsTypeFlag}, Config) -> Pid = start_profiler_process(), - undefined = erlang:system_profile(Pid, [runnable_ports]), + undefined = erlang:system_profile(Pid, [runnable_ports]++TsTypeFlag), EchoPid = echo(Config), % FIXME: Set config to number_of_echos Laps = 10, @@ -149,9 +177,9 @@ runnable_ports(Config) when is_list(Config) -> Events = get_profiler_events(), kill_em_all = kill_echo(EchoPid), erlang:system_profile(undefined, []), - true = has_runnable_event(Events), + true = has_runnable_event(TsType, Events), Pids = sort_events_by_pid(Events), - ok = check_events(Pids), + ok = check_events(TsType, Pids), erase(), exit(Pid,kill), ok. @@ -166,8 +194,19 @@ scheduler(Config) when is_list(Config) -> {_, 1} -> {skipped, "No need for scheduler test when only one scheduler online."}; _ -> Nodes = 10, - ok = check_block_system(Nodes), - ok = check_multi_scheduling_block(Nodes) + lists:foreach(fun (TsType) -> + Arg = case TsType of + no_timestamp -> + {timestamp, []}; + _ -> + {TsType, [TsType]} + end, + ok = check_block_system(Arg, Nodes), + ok = check_multi_scheduling_block(Arg, Nodes), + receive after 1000 -> ok end + end, + [no_timestamp, timestamp, monotonic_timestamp, + strict_monotonic_timestamp]) end. % the profiler pid should not be profiled @@ -195,9 +234,9 @@ dont_profile_profiler(Config) when is_list(Config) -> %%% Check scheduler profiling -check_multi_scheduling_block(Nodes) -> +check_multi_scheduling_block({TsType, TsTypeFlag}, Nodes) -> Pid = start_profiler_process(), - undefined = erlang:system_profile(Pid, [scheduler]), + undefined = erlang:system_profile(Pid, [scheduler]++TsTypeFlag), {ok, Supervisor} = start_load(Nodes), wait(600), erlang:system_flag(multi_scheduling, block), @@ -205,23 +244,23 @@ check_multi_scheduling_block(Nodes) -> erlang:system_flag(multi_scheduling, unblock), {Pid, [scheduler]} = erlang:system_profile(undefined, []), Events = get_profiler_events(), - true = has_scheduler_event(Events), + true = has_scheduler_event(TsType, Events), stop_load(Supervisor), exit(Pid,kill), erase(), ok. -check_block_system(Nodes) -> +check_block_system({TsType, TsTypeFlag}, Nodes) -> Dummy = spawn(?MODULE, profiler_process, [[]]), Pid = start_profiler_process(), - undefined = erlang:system_profile(Pid, [scheduler]), + undefined = erlang:system_profile(Pid, [scheduler]++TsTypeFlag), {ok, Supervisor} = start_load(Nodes), wait(300), undefined = erlang:system_monitor(Dummy, [busy_port]), {Dummy, [busy_port]} = erlang:system_monitor(undefined, []), {Pid, [scheduler]} = erlang:system_profile(undefined, []), Events = get_profiler_events(), - true = has_scheduler_event(Events), + true = has_scheduler_event(TsType, Events), stop_load(Supervisor), exit(Pid,kill), exit(Dummy,kill), @@ -230,40 +269,49 @@ check_block_system(Nodes) -> %%% Check events -check_events([]) -> ok; -check_events([Pid | Pids]) -> +check_events(_TsType, []) -> ok; +check_events(TsType, [Pid | Pids]) -> Master = get(master), Laps = get(laps), CheckPids = get(pids), {Events, N} = get_pid_events(Pid), ok = check_event_flow(Events), - ok = check_event_ts(Events), + ok = check_event_ts(TsType, Events), IsMember = lists:member(Pid, CheckPids), case Pid of Master -> io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2+2, N, Pid]), N = Laps*2 + 2, - check_events(Pids); + check_events(TsType, Pids); Pid when IsMember == true -> io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2, N, Pid]), N = Laps*2, - check_events(Pids); + check_events(TsType, Pids); Pid -> - check_events(Pids) + check_events(TsType, Pids) end. %% timestamp consistency check for descending timestamps -check_event_ts(Events) -> - check_event_ts(Events, undefined). -check_event_ts([], _) -> ok; -check_event_ts([Event | Events], undefined) -> - check_event_ts(Events, Event); -check_event_ts([{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) -> - Time = timer:now_diff(TS1, TS0), +check_event_ts(TsType, Events) -> + check_event_ts(TsType, Events, undefined). +check_event_ts(_TsType, [], _) -> ok; +check_event_ts(TsType, [Event | Events], undefined) -> + check_event_ts(TsType, Events, Event); +check_event_ts(TsType, [{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) -> + Time = case TsType of + timestamp -> + timer:now_diff(TS1, TS0); + monotonic_timestamp -> + TS1 - TS0; + strict_monotonic_timestamp -> + {MT1, _} = TS1, + {MT0, _} = TS0, + MT1 - MT0 + end, if Time < 0.0 -> timestamp_error; - true -> check_event_ts(Events, Event) + true -> check_event_ts(TsType, Events, Event) end. %% consistency check for active vs. inactive activity (runnable) @@ -428,6 +476,44 @@ port_echo_loop(Port) -> %% Helpers %%% +check_ts(no_timestamp, Ts) -> + try + no_timestamp = Ts + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(timestamp, Ts) -> + try + {Ms,S,Us} = Ts, + true = is_integer(Ms), + true = is_integer(S), + true = is_integer(Us) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(monotonic_timestamp, Ts) -> + try + true = is_integer(Ts) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(strict_monotonic_timestamp, Ts) -> + try + {MT, UMI} = Ts, + true = is_integer(MT), + true = is_integer(UMI) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok. + start_load(N) -> Pid = spawn_link(?MODULE, run_load, [N, []]), {ok, Pid}. @@ -454,21 +540,24 @@ list_load() -> end, list_load(). - -has_scheduler_event(Events) -> +has_scheduler_event(TsType, Events) -> lists:any( fun (Pred) -> case Pred of - {profile, scheduler, _ID, _Activity, _NR, _TS} -> true; + {profile, scheduler, _ID, _Activity, _NR, TS} -> + check_ts(TsType, TS), + true; _ -> false end end, Events). -has_runnable_event(Events) -> +has_runnable_event(TsType, Events) -> lists:any( fun (Pred) -> case Pred of - {profile, _Pid, _Activity, _MFA, _TS} -> true; + {profile, _Pid, _Activity, _MFA, TS} -> + check_ts(TsType, TS), + true; _ -> false end end, Events). diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index 33076c7461..787870588d 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -320,7 +320,41 @@ timestamp(suite) -> timestamp(doc) -> ["Test that os:timestamp works."]; timestamp(Config) when is_list(Config) -> - repeating_timestamp_check(100000). + try + repeating_timestamp_check(100000) + catch + throw : {fail, Failure} -> + %% + %% Our time warping test machines currently warps + %% time every 6:th second. If we get a warp during + %% 10 seconds, assume this is a time warping test + %% and ignore the failure. + %% + case had_time_warp(10) of + true -> + {skip, "Seems to be time warp test run..."}; + false -> + test_server:fail(Failure) + end + end. + +os_system_time_offset() -> + erlang:convert_time_unit(os:system_time() - erlang:monotonic_time(), + native, micro_seconds). + +had_time_warp(Secs) -> + had_time_warp(os_system_time_offset(), Secs). + +had_time_warp(OrigOffs, 0) -> + false; +had_time_warp(OrigOffs, N) -> + receive after 1000 -> ok end, + case OrigOffs - os_system_time_offset() of + Diff when Diff > 500000; Diff < -500000 -> + true; + _Diff -> + had_time_warp(OrigOffs, N-1) + end. repeating_timestamp_check(0) -> ok; @@ -346,15 +380,15 @@ repeating_timestamp_check(N) -> NSecs = NA*1000000+NB+round(NC/1000000), case Secs - NSecs of TooLarge when TooLarge > 3600 -> - test_server:fail( - lists:flatten( + throw({fail, + lists:flatten( io_lib:format("os:timestamp/0 is ~w s more than erlang:now/0", - [TooLarge]))); + [TooLarge]))}); TooSmall when TooSmall < -3600 -> - test_server:fail( + throw({fail, lists:flatten( io_lib:format("os:timestamp/0 is ~w s less than erlang:now/0", - [-TooSmall]))); + [-TooSmall]))}); _ -> ok end, diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index a12c41a3aa..760666d077 100644 --- a/erts/emulator/test/trace_bif_SUITE.erl +++ b/erts/emulator/test/trace_bif_SUITE.erl @@ -67,7 +67,8 @@ trace_on_and_off(Config) when is_list(Config) -> ?line Pid = spawn(?MODULE, bif_process, []), ?line Self = self(), ?line 1 = erlang:trace(Pid, true, [call,timestamp]), - ?line {flags,[timestamp,call]} = erlang:trace_info(Pid,flags), + ?line {flags, Flags} = erlang:trace_info(Pid,flags), + ?line [call,timestamp] = lists:sort(Flags), ?line {tracer, Self} = erlang:trace_info(Pid,tracer), ?line 1 = erlang:trace(Pid, false, [timestamp]), ?line {flags,[call]} = erlang:trace_info(Pid,flags), @@ -111,93 +112,145 @@ do_trace_bif(Flags) -> trace_bif_timestamp(doc) -> "Test tracing BIFs with timestamps."; trace_bif_timestamp(Config) when is_list(Config) -> - do_trace_bif_timestamp([]). - + do_trace_bif_timestamp([], timestamp, [timestamp]), + do_trace_bif_timestamp([], timestamp, + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), + do_trace_bif_timestamp([], strict_monotonic_timestamp, + [strict_monotonic_timestamp]), + do_trace_bif_timestamp([], strict_monotonic_timestamp, + [monotonic_timestamp, strict_monotonic_timestamp]), + do_trace_bif_timestamp([], monotonic_timestamp, [monotonic_timestamp]). + trace_bif_timestamp_local(doc) -> "Test tracing BIFs with timestamps and local flag."; trace_bif_timestamp_local(Config) when is_list(Config) -> - do_trace_bif_timestamp([local]). - -do_trace_bif_timestamp(Flags) -> - ?line Pid=spawn(?MODULE, bif_process, []), - ?line 1 = erlang:trace(Pid, true, [call,timestamp]), - ?line erlang:trace_pattern({erlang,'_','_'}, [], Flags), - - ?line Pid ! {do_bif, time, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}), - - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), - - ?line Pid ! {do_time_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,time, []}}), - - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), + do_trace_bif_timestamp([local], timestamp, [timestamp]), + do_trace_bif_timestamp([local], timestamp, + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), + do_trace_bif_timestamp([local], strict_monotonic_timestamp, + [strict_monotonic_timestamp]), + do_trace_bif_timestamp([local], strict_monotonic_timestamp, + [monotonic_timestamp, strict_monotonic_timestamp]), + do_trace_bif_timestamp([local], monotonic_timestamp, [monotonic_timestamp]). + +do_trace_bif_timestamp(Flags, TsType, TsFlags) -> + io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]), + Pid=spawn(?MODULE, bif_process, []), + 1 = erlang:trace(Pid, true, [call]++TsFlags), + erlang:trace_pattern({erlang,'_','_'}, [], Flags), + + Ts0 = make_ts(TsType), + Pid ! {do_bif, time, []}, + Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}, + Ts0,TsType), + + Pid ! {do_bif, statistics, [runtime]}, + Ts2 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts1, TsType), + + Pid ! {do_time_bif}, + Ts3 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,time, []}}, + Ts2, TsType), + + Pid ! {do_statistics_bif}, + Ts4 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts3, TsType), + + check_ts(TsType, Ts4, make_ts(TsType)), %% We should be able to turn off the timestamp. - ?line 1 = erlang:trace(Pid, false, [timestamp]), + 1 = erlang:trace(Pid, false, TsFlags), - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), + Pid ! {do_statistics_bif}, + receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), + Pid ! {do_bif, statistics, [runtime]}, + receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), - ?line 1 = erlang:trace(Pid, false, [call]), - ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags), + 1 = erlang:trace(Pid, false, [call]), + erlang:trace_pattern({erlang,'_','_'}, false, Flags), - ?line exit(Pid, die), + exit(Pid, die), ok. trace_bif_return(doc) -> "Test tracing BIF's with return/return_to trace."; trace_bif_return(Config) when is_list(Config) -> - ?line Pid=spawn(?MODULE, bif_process, []), - ?line 1 = erlang:trace(Pid, true, [call,timestamp,return_to]), - ?line erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], - [local]), - - - ?line Pid ! {do_bif, time, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,time,0}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), - - - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,statistics,1}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), - - - ?line Pid ! {do_time_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,time, []}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,time,0}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), - - - - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,statistics,1}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), + do_trace_bif_return(timestamp, [timestamp]), + do_trace_bif_return(timestamp, + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), + do_trace_bif_return(strict_monotonic_timestamp, + [strict_monotonic_timestamp]), + do_trace_bif_return(strict_monotonic_timestamp, + [monotonic_timestamp, strict_monotonic_timestamp]), + do_trace_bif_return(monotonic_timestamp, [monotonic_timestamp]). + +do_trace_bif_return(TsType, TsFlags) -> + io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]), + Pid=spawn(?MODULE, bif_process, []), + 1 = erlang:trace(Pid, true, [call,return_to]++TsFlags), + erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], + [local]), + + Ts0 = make_ts(TsType), + Pid ! {do_bif, time, []}, + Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}, + Ts0, TsType), + Ts2 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,time,0}}, + Ts1, TsType), + Ts3 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts2, TsType), + + + Pid ! {do_bif, statistics, [runtime]}, + Ts4 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts3, TsType), + Ts5 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,statistics,1}}, + Ts4, TsType), + Ts6 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts5, TsType), + + + Pid ! {do_time_bif}, + Ts7 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,time, []}}, + Ts6, TsType), + Ts8 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,time,0}}, + Ts7, TsType), + Ts9 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts8, TsType), + + + + Pid ! {do_statistics_bif}, + Ts10 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts9, TsType), + Ts11 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,statistics,1}}, + Ts10, TsType), + Ts12 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts11, TsType), + check_ts(TsType, Ts12, make_ts(TsType)), ok. @@ -213,10 +266,11 @@ receive_trace_msg(Mess) -> ?t:fail() end. -receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}) -> +receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, call, {erlang, F, A}, _Ts} -> - ok; + {trace_ts, Pid, call, {erlang, F, A}, Ts} -> + check_ts(TsType, PrevTs, Ts), + Ts; Other -> io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" "Got: ~p~n", @@ -227,10 +281,11 @@ receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}) -> ?t:fail() end. -receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}) -> +receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, return_from, {erlang, F, A}, _Value, _Ts} -> - ok; + {trace_ts, Pid, return_from, {erlang, F, A}, _Value, Ts} -> + check_ts(TsType, PrevTs, Ts), + Ts; Other -> io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" "Got: ~p~n", @@ -241,10 +296,11 @@ receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}) -> ?t:fail() end. -receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) -> +receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, return_to, {M, F, A}, _Ts} -> - ok; + {trace_ts, Pid, return_to, {M, F, A}, Ts} -> + check_ts(TsType, PrevTs, Ts), + Ts; Other -> io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" "Got: ~p~n", @@ -255,6 +311,33 @@ receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) -> ?t:fail() end. +make_ts(timestamp) -> + erlang:now(); +make_ts(monotonic_timestamp) -> + erlang:monotonic_time(); +make_ts(strict_monotonic_timestamp) -> + MT = erlang:monotonic_time(), + UMI = erlang:unique_integer([monotonic]), + {MT, UMI}. + +check_ts(timestamp, PrevTs, Ts) -> + {Ms, S, Us} = Ts, + true = is_integer(Ms), + true = is_integer(S), + true = is_integer(Us), + true = PrevTs < Ts, + Ts; +check_ts(monotonic_timestamp, PrevTs, Ts) -> + true = is_integer(Ts), + true = PrevTs =< Ts, + Ts; +check_ts(strict_monotonic_timestamp, PrevTs, Ts) -> + {MT, UMI} = Ts, + true = is_integer(MT), + true = is_integer(UMI), + true = PrevTs < Ts, + Ts. + bif_process() -> receive {do_bif, Name, Args} -> |