erts: Improve alloc_SUITE:migration test

In the quest to improve code coverage in cpool_fetch

4 files changed, 231 insertions, 46 deletions

diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 0aa45acd82..c3f4fe5a63 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -3642,6 +3642,10 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3)
 	    *(void**)a3 = orig_destroying_mbc;
 	    return offset;
 	}
+	case 0xf17: {
+	    ErtsAllocatorThrSpec_t* ts = &erts_allctr_thr_spec[ERTS_ALC_A_TEST];
+	    return ts->allctr[0]->largest_mbc_size;
+	}
 	default:
 	    break;
 	}
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index 866008e3e0..aa6a1fbcdc 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -65,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),
@@ -113,7 +113,13 @@ cpool(suite) -> [];
 cpool(doc) ->   [];
 cpool(Cfg) -> ?line drv_case(Cfg).
 
-migration(Cfg) -> drv_case(Cfg, concurrent, "+MZe true").
+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
@@ -207,6 +213,7 @@ run_drv_case(Config, Mode) ->
     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),
@@ -218,6 +225,9 @@ run_drv_case(Config, Mode) ->
 	    Result = concurrent(CaseName)
     end,
 
+    wait_for_memory_deallocations(),
+    print_stats(CaseName),
+
     true = erlang:delete_module(CaseName),
     slave_end(SlaveState),
     Result.
@@ -236,6 +246,41 @@ 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),
@@ -250,8 +295,10 @@ many_shot(CaseName, I, Mem) ->
     Result1 = repeat_while(fun() ->
 				   Result0 = CaseName:run(State),
 				   handle_result(State, Result0)
-			   end),
+			   end,
+			   10*1000, I),
     CaseName:stop(State),
+    flush_log(),
     Result1.
 
 concurrent(CaseName) ->
@@ -272,11 +319,23 @@ concurrent(CaseName) ->
 		  PRs),
     ok.
 
-repeat_while(Fun) ->
-    %%io:format("~p calls fun\n", [self()]),
-    case Fun() of
-	continue -> repeat_while(Fun);
-	R -> R
+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() ->
@@ -308,6 +367,12 @@ handle_result(_State, Result0) ->
     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)
 			++ "-"
@@ -318,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).
 
diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h
index dd0227e725..97ee58cdad 100644
--- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h
+++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h
@@ -157,5 +157,6 @@ typedef void* erts_cond;
 #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/migration.c b/erts/emulator/test/alloc_SUITE_data/migration.c
index 9f6535c834..b006360043 100644
--- a/erts/emulator/test/alloc_SUITE_data/migration.c
+++ b/erts/emulator/test/alloc_SUITE_data/migration.c
@@ -27,6 +27,7 @@
 #include <errno.h>
 #endif
 #include <stdio.h>
+#include <stdlib.h>
 #include <stdarg.h>
 #include <string.h>
 #include "testcase_driver.h"
@@ -57,15 +58,52 @@ testcase_name(void)
     return "migration";
 }
 
-void
-testcase_cleanup(TestCaseState_t *tcs)
+/* 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)
 {
-    enif_free(tcs->extra);
-    tcs->extra = NULL;
+    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));
 }
 
-#define MAX_BLOCK_PER_THR 100
-#define MAX_ROUNDS 10
+#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;
@@ -74,15 +112,23 @@ typedef struct MyBlock_ {
 
 typedef struct {
     MyBlock* blockv[MAX_BLOCK_PER_THR];
+    MyRandState rand_state;
     enum { GROWING, SHRINKING, CLEANUP, DONE } phase;
-    int ix;
+    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;
 
 
@@ -99,6 +145,7 @@ static void my_creating_mbc(Allctr_t *allctr, Carrier_t *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)
@@ -131,17 +178,28 @@ static int migration_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_in
     return 0;
 }
 
-static void add_block(MyBlock* p)
+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);
-    mci->nblocks++;
+    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);
 }
 
@@ -157,6 +215,38 @@ static void remove_block(MyBlock* p)
     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)
 {
@@ -169,61 +259,85 @@ testcase_run(TestCaseState_t *tcs)
 	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->ix = 0;
+	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->ix]);
-	p = ALLOC_TEST((1 << 18) / 5);
+	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->blockv[state->ix] = p;
-	do {
-	    if (++state->ix >= MAX_BLOCK_PER_THR) {
-		state->phase = SHRINKING;
-		state->ix = 0;
-		break;
-	    }
-	} while (state->blockv[state->ix] != NULL);
+	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:
-	FATAL_ASSERT(state->blockv[state->ix]);
-	remove_block(state->blockv[state->ix]);
-	FREE_TEST(state->blockv[state->ix]);
-	state->blockv[state->ix] = NULL;
-
-	state->ix += 1 + ((state->ix % 3) == 0);
-	if (state->ix >= MAX_BLOCK_PER_THR) {
+    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);
 	    }
-	    state->ix = 0;
 	}
 	break;
-
+    }
     case CLEANUP:
-	if (state->blockv[state->ix]) {
-	    remove_block(state->blockv[state->ix]);
-	    FREE_TEST(state->blockv[state->ix]);
-	}
-	if (++state->ix >= MAX_BLOCK_PER_THR)
-	    state->phase = DONE;
+	do_cleanup(tcs, state);
 	break;
 
     default:
 	FATAL_ASSERT(!"Invalid phase");
     }
 
-    if (state->phase != DONE)
+    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);