int main(int argc, char *argv[])
{
mps_arena_t arena;
mps_thr_t thread;
testlib_init(argc, argv);
die(mps_arena_create(&arena, mps_arena_class_vm(),
testArenaSIZE),
"arena_create");
die(mps_thread_reg(&thread, arena), "thread_reg");
test(arena, mps_class_amc());
test(arena, mps_class_amcz());
test(arena, mps_class_ams());
test(arena, mps_class_awl());
test(arena, mps_class_lo());
test(arena, mps_class_snc());
mps_thread_dereg(thread);
mps_arena_destroy(arena);
printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
return 0;
}
static void test(void *stack_pointer)
{
mps_arena_t arena;
mps_pool_t pool;
mps_fmt_t format;
mps_ap_t ap;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena");
cdie(mps_fmt_create_k(&format, arena, mps_args_none), "create format");
cdie(mps_pool_create(&pool, arena, mps_class_lo(), format), "create pool");
mps_pool_destroy(pool);
comment("Destroyed pool.");
cdie(mps_ap_create(&ap, pool, mps_rank_exact()), "create ap");
mps_ap_destroy(ap);
comment("Destroyed ap.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void *stack_pointer)
{
mps_arena_t arena;
mps_pool_t pool;
mps_fmt_t format;
mps_ap_t ap;
mps_addr_t obj;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena");
cdie(mps_fmt_create_k(&format, arena, mps_args_none), "create format");
cdie(mps_pool_create(&pool, arena, mps_class_lo(), format), "create pool");
cdie(mps_ap_create(&ap, pool), "create ap");
cdie(mps_reserve(&obj, ap, 256), "reserve");
(void)mps_commit(ap, &obj, 256);
mps_free(pool, obj, 256);
comment("Freed.");
mps_free(pool, obj, 256);
comment("Freed again.");
mps_pool_destroy(pool);
comment("Destroyed pool");
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
int main(void)
{
mps_arena_t arena;
mps_pool_t pool;
mps_fmt_t format;
mps_ap_t ap;
mps_addr_t p;
mps_root_t root;
locv_fmt.align = sizeof(void *); /* .fmt.align.delayed */
die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
"mps_arena_create");
die(mps_root_create_table(&root, arena, mps_rank_exact(),
(mps_rm_t)0,
roots, (sizeof(roots)/sizeof(*roots))),
"RootCreate");
die(mps_fmt_create_A(&format, arena, &locv_fmt), "FormatCreate");
die(mps_pool_create(&pool, arena, mps_class_lo(), format), "LOCreate");
die(mps_ap_create(&ap, pool, mps_rank_exact()), "APCreate");
die(mps_reserve(&p, ap, sizeof(void *)), "mps_reserve min");
*(mps_word_t *)p = sizeof(void *);
cdie(mps_commit(ap, p, sizeof(void *)), "commit min");
die(mps_reserve(&roots[1], ap, 2*sizeof(void *)), "mps_reserve 2*min");
p = roots[1];
*(mps_word_t *)p = 2*sizeof(void *);
cdie(mps_commit(ap, p, 2*sizeof(void *)), "commit 2*min");
die(mps_reserve(&p, ap, (size_t)4096), "mps_reserve 4096");
*(mps_word_t *)p = 4096;
cdie(mps_commit(ap, p, (size_t)4096), "commit 4096");
die(mps_reserve(&p, ap, sizeof(void *)), "mps_reserve last");
*(mps_word_t *)p = sizeof(void *);
cdie(mps_commit(ap, p, sizeof(void *)), "commit last");
{
size_t count = 0;
mps_arena_formatted_objects_walk(arena, stepper, &count, 0);
cdie(count == 4, "walk 4 objects");
}
mps_ap_destroy(ap);
mps_pool_destroy(pool);
mps_fmt_destroy(format);
mps_root_destroy(root);
mps_arena_destroy(arena);
fflush(stdout); /* synchronize */
fprintf(stderr, "\nConclusion: Failed to find any defects.\n");
return 0;
}
/* v serves two purposes:
* A pseudo stack base for the stack root.
* Pointer to a guff structure, which packages some values needed
* (arena and thr mostly) */
static void *setup(void *v, size_t s)
{
struct guff_s *guff;
mps_arena_t arena;
mps_pool_t leafpool;
mps_pool_t tablepool;
mps_fmt_t dylanfmt;
mps_fmt_t dylanweakfmt;
mps_ap_t leafap, exactap, weakap, bogusap;
mps_root_t stack;
mps_thr_t thr;
guff = (struct guff_s *)v;
(void)s;
arena = guff->arena;
thr = guff->thr;
die(mps_root_create_reg(&stack, arena, MPS_RANK_AMBIG, 0, thr,
mps_stack_scan_ambig, v, 0),
"Root Create\n");
die(mps_fmt_create_A(&dylanfmt, arena, dylan_fmt_A()),
"Format Create\n");
die(mps_fmt_create_A(&dylanweakfmt, arena, dylan_fmt_A_weak()),
"Format Create (weak)\n");
die(mps_pool_create(&leafpool, arena, mps_class_lo(), dylanfmt),
"Leaf Pool Create\n");
die(mps_pool_create(&tablepool, arena, mps_class_awl(), dylanweakfmt,
dylan_weak_dependent),
"Table Pool Create\n");
die(mps_ap_create(&leafap, leafpool, MPS_RANK_EXACT),
"Leaf AP Create\n");
die(mps_ap_create(&exactap, tablepool, MPS_RANK_EXACT),
"Exact AP Create\n");
die(mps_ap_create(&weakap, tablepool, MPS_RANK_WEAK),
"Weak AP Create\n");
die(mps_ap_create(&bogusap, tablepool, MPS_RANK_EXACT),
"Bogus AP Create\n");
test(leafap, exactap, weakap, bogusap);
mps_ap_destroy(bogusap);
mps_ap_destroy(weakap);
mps_ap_destroy(exactap);
mps_ap_destroy(leafap);
mps_pool_destroy(tablepool);
mps_pool_destroy(leafpool);
mps_fmt_destroy(dylanweakfmt);
mps_fmt_destroy(dylanfmt);
mps_root_destroy(stack);
return NULL;
}
static void test(void)
{
mps_arena_t arena;
mps_pool_t pool;
mps_fmt_t format;
mps_fmt_A_s fmtA;
mps_ap_t ap;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena");
fmtA.align = (mps_align_t) 1;
fmtA.scan = &zilch;
fmtA.skip = &myskip;
fmtA.copy = &zilch;
fmtA.fwd = &zilch;
fmtA.isfwd = &zilch;
fmtA.pad = &zilch;
cdie(
mps_fmt_create_A(&format, arena, &fmtA),
"create format");
cdie(
mps_pool_create(&pool, arena, mps_class_lo(), format),
"create pool");
/*
cdie(
mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
*/
mps_ap_destroy(ap);
comment("Destroyed ap.");
mps_pool_destroy(pool);
comment("Destroyed pool.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void)
{
mps_arena_t arena;
mps_pool_t pool;
mps_fmt_t format;
mps_fmt_A_s fmtA;
mps_addr_t obj;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena");
fmtA.align = (mps_align_t) 1;
fmtA.scan = &zilch;
fmtA.skip = &myskip;
fmtA.copy = &zilch;
fmtA.fwd = &zilch;
fmtA.isfwd = &zilch;
fmtA.pad = &zilch;
cdie(
mps_fmt_create_A(&format, arena, &fmtA),
"create format");
cdie(
mps_pool_create(&pool, arena, mps_class_lo(), format),
"create pool");
/*
cdie(mps_alloc(&obj, pool, 152), "allocate");
*/
mps_free(pool, obj, 152);
comment("Freed.");
mps_free(pool, obj, 152);
comment("Freed again.");
mps_pool_destroy(pool);
comment("Destroyed pool");
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void)
{
mps_space_t space;
mps_pool_t pool;
mps_fmt_t format;
mps_fmt_A_s fmtA;
mps_addr_t obj;
cdie(mps_space_create(&space), "create space");
fmtA.align = (mps_align_t) 1;
fmtA.scan = &zilch;
fmtA.skip = &myskip;
fmtA.copy = &zilch;
fmtA.fwd = &zilch;
fmtA.isfwd = &zilch;
fmtA.pad = &zilch;
cdie(
mps_fmt_create_A(&format, space, &fmtA),
"create format");
cdie(
mps_pool_create(&pool, space, mps_class_lo(), format),
"create pool");
cdie(mps_alloc(&obj, pool, 152), "allocate");
mps_free(pool, obj, 152);
comment("Freed.");
mps_free(pool, obj, 152);
comment("Freed again.");
mps_pool_destroy(pool);
comment("Destroyed pool");
mps_space_destroy(space);
comment("Destroyed space.");
}
static void test(void) {
mps_pool_t poollo;
mps_thr_t thread;
mps_root_t root0, root1;
mps_fmt_t format;
mps_ap_t aplo;
mycell *a;
long int j;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t)1024*1024*30),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_reg(&root0, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(mps_root_create_table(&root1, arena, mps_rank_ambig(), 0,
(mps_addr_t *)&exfmt_root, 1),
"create table root");
cdie(mps_fmt_create_A(&format, arena, &fmtA),
"create format");
cdie(mps_pool_create(&poollo, arena, mps_class_lo(), format),
"create pool");
cdie(mps_ap_create(&aplo, poollo, mps_rank_exact()),
"create ap");
/* alloc lots in an LO pool; it should be collected away */
for(j=0; j<1000; j++) {
a = allocdumb(aplo, 1024ul*1024, mps_rank_exact());
}
/* (total allocated is 1000 M) */
mps_arena_park(arena);
mps_root_destroy(root0);
mps_root_destroy(root1);
comment("Destroyed roots.");
mps_ap_destroy(aplo);
comment("Destroyed ap.");
mps_pool_destroy(poollo);
comment("Destroyed pool.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_thread_dereg(thread);
comment("Deregistered thread.");
mps_arena_destroy(arena);
comment("Destroyed arena.");
pass();
}
static void test(void)
{
mps_pool_t poolamc, poolawl, poollo;
mps_thr_t thread;
mps_root_t root0, root1;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, apawl, aplo;
mycell *a, *b, *c, *d;
long int j;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t)1024*1024*30),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_reg(&root0, arena, MPS_RANK_AMBIG, 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(mps_root_create_table(&root1, arena, MPS_RANK_AMBIG, 0,
(mps_addr_t*)&exfmt_root, 1),
"create table root");
cdie(mps_fmt_create_A(&format, arena, &fmtA),
"create format");
die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mmqa_pool_create_chain(&poolamc, arena, mps_class_amc(), format, chain),
"create pool(amc)");
cdie(mps_pool_create(&poolawl, arena, mps_class_awl(), format),
"create pool(awl)");
cdie(mps_pool_create(&poollo, arena, mps_class_lo(), format),
"create pool");
cdie(mps_ap_create(&apawl, poolawl, MPS_RANK_WEAK),
"create ap(amc)");
cdie(mps_ap_create(&apamc, poolamc, MPS_RANK_EXACT),
"create ap(awl)");
cdie(mps_ap_create(&aplo, poollo, MPS_RANK_EXACT),
"create ap");
mps_message_type_enable(arena, mps_message_type_finalization());
/* register loads of objects for finalization (1000*4) */
a = allocone(apamc, 2, 1);
b = a;
for (j=0; j<1000; j++) {
a = allocone(apamc, 2, MPS_RANK_EXACT);
c = allocone(apawl, 2, MPS_RANK_WEAK);
d = allocone(aplo, 2, MPS_RANK_EXACT); /* rank irrelevant here! */
mps_finalize(arena, (mps_addr_t*)&a);
mps_finalize(arena, (mps_addr_t*)&c);
mps_finalize(arena, (mps_addr_t*)&d);
mps_finalize(arena, (mps_addr_t*)&d);
final_count += 4;
}
/* throw them all away and collect everything */
a = NULL;
b = NULL;
c = NULL;
d = NULL;
mps_root_destroy(root0);
mps_root_destroy(root1);
comment("Destroyed roots.");
mps_arena_collect(arena);
while(mps_message_poll(arena) == 0) {
a = allocdumb(apawl, 1024, MPS_RANK_WEAK);
a = allocdumb(apamc, 1024, MPS_RANK_EXACT);
a = allocdumb(aplo, 1024, MPS_RANK_EXACT);
mps_arena_collect(arena);
}
/* how many are left? (n.b. ideally this would be 0 but
there's no guarantee)
*/
/* now to test leaving messages open for a long time! */
mps_ap_destroy(apawl);
mps_ap_destroy(apamc);
mps_ap_destroy(aplo);
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poolawl);
mps_pool_destroy(poollo);
comment("Destroyed pools.");
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void)
{
mps_arena_t arena;
mps_pool_t poolamc, poollo;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, aplo;
mycell *a, *b, *c, *d, *e, *f, *g;
int i;
int j;
RC;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
die(mps_thread_reg(&thread, arena), "register thread");
die(mps_root_create_reg(&root, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
die(mps_fmt_create_A(&format, arena, &fmtA), "create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mmqa_pool_create_chain(&poolamc, arena, mps_class_amc(), format, chain),
"create pool(amc)");
cdie(
mps_pool_create(&poollo, arena, mps_class_lo(), format),
"create pool");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap(amc)");
cdie(
mps_ap_create(&aplo, poollo, mps_rank_exact()),
"create ap");
b = allocone(apamc, 1, 1);
for (j = 1; j < 100; j++) {
comment("%i of 100.", j);
UC;
a = allocone(apamc, 5, 1);
b = a;
c = a;
d = a;
e = a;
f = a;
g = a;
for (i = 1; i < 1000; i++) {
UC;
c = allocone(apamc, 20, 1);
d = allocone(apamc, 20, 1);
if (ranint(8) == 0) e = c;
if (ranint(8) == 0) f = c;
if (ranint(8) == 0) g = c;
UC;
setref(b, 0, c);
UC;
setref(c, 1, d);
UC;
setref(c, 2, e);
UC;
setref(c, 3, f);
UC;
setref(c, 4, g);
UC;
b = c;
}
DC;
DMC;
}
mps_ap_destroy(apamc);
mps_ap_destroy(aplo);
mps_pool_destroy(poolamc);
mps_pool_destroy(poollo);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void)
{
/* a is a table of exact roots
b a table of ambiguous roots
f a table of non-roots
*/
mycell *a[4], *b[4], *f[4];
mps_addr_t addr;
int i, j, k;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
addr = &a[0];
cdie(
mps_root_create_table(&root, arena, mps_rank_exact(), 0, addr, 4),
"create a root table");
addr = &b[0];
cdie(
mps_root_create_table(&root1, arena, mps_rank_ambig(), 0, addr, 4),
"create b root table");
cdie(
mps_fmt_create_A(&format, arena, &fmtA),
"create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
cdie(
mps_pool_create(&poolamc, arena, mps_class_amc(), format, chain),
"create pool");
cdie(
mps_pool_create(&poollo, arena, mps_class_lo(), format),
"create pool");
cdie(
mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
"create pool");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&aplo, poollo, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&apawl, poolawl, mps_rank_exact()),
"create ap");
newstamp = 0;
for (i=0; i<4; i++) {
addr = &a[i];
die(allocrdumb(addr, aplo, 64, mps_rank_exact()), "alloc failed");
addr = &b[i];
die(allocrone(addr, apawl, 5, mps_rank_exact()), "alloc failed");
b[i]->data.ref[0].addr = a[i];
addr = &a[i];
die(allocrone(addr, apamc, 5, mps_rank_exact()), "alloc failed");
a[i]->data.ref[0].addr = b[i];
}
for (j=0; j<100; j++) {
comment("%i of 100", j);
for (i=0; i<10000; i++) {
k = ranint(4);
addr = &a[k];
die(allocrdumb(addr, aplo, 64, mps_rank_exact()), "alloc failed");
k = ranint(4);
addr = &b[k];
die(allocrone(addr, apawl, 5, mps_rank_exact()), "alloc failed");
b[k]->data.ref[0].addr = a[ranint(4)];
b[k]->data.ref[1].addr = b[ranint(4)];
addr = &a[k];
die(allocrone(addr, apamc, 5, mps_rank_exact()), "alloc failed");
f[k] = a[k]->data.ref[2].addr;
a[k]->data.ref[2].addr = b[ranint(4)];
}
comment("walking...");
mps_arena_park(arena);
mps_arena_collect(arena);
oldstamp = newstamp;
newstamp += 1;
mps_arena_formatted_objects_walk(arena, stepper,
(void *) MAGICPOINT, MAGICSIZE);
mps_arena_release(arena);
comment("tracing...");
oldstamp = newstamp;
newstamp += 1;
tracegraph((mycell *) exfmt_root);
tracegraph(a[0]);
tracegraph(a[1]);
tracegraph(a[2]);
tracegraph(a[3]);
tracegraph(b[0]);
tracegraph(b[1]);
tracegraph(b[2]);
tracegraph(b[3]);
comment("f[0] = %p", f[0]); /* avoid compiler warning about used f */
comment("ok");
}
mps_arena_park(arena);
mps_ap_destroy(apamc);
mps_ap_destroy(aplo);
mps_ap_destroy(apawl);
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poollo);
mps_pool_destroy(poolawl);
comment("Destroyed pools.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_chain_destroy(chain);
comment("Destroyed chain.");
mps_root_destroy(root);
mps_root_destroy(root1);
comment("Destroyed roots.");
mps_thread_dereg(thread);
comment("Deregistered thread.");
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void)
{
mps_arena_t arena;
mps_pool_t poolamc, poollo;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, aplo;
mycell *a[100];
int i;
int j;
int k,z;
alloccomments = 1;
formatcomments = 1;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
die(mps_thread_reg(&thread, arena), "register thread");
die(mps_root_create_reg(&root, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
die(mps_fmt_create_A(&format, arena, &fmtA), "create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mmqa_pool_create_chain(&poolamc, arena, mps_class_amc(), format, chain),
"create pool(amc)");
die(mps_pool_create(&poollo, arena, mps_class_lo(), format),
"create pool(lo)");
cdie(
mps_ap_create(&aplo, poollo, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
for(i=0; i<100; i++) {
a[i] = allocone(aplo, 6, 1);
}
for(i=0; i<10000; i++) {
j = ranint(100);
comment("New object %i", j);
a[j] = allocone(aplo, 5+ranint(50), 1);
k = ranint(50);
z = ranint(5);
comment("setting %i (%p) %i", k, a[k], z);
setref(a[k], z, a[j]);
(void)allocdumb(apamc, 0x400*64, 0);
}
mps_arena_park(arena);
mps_ap_destroy(aplo);
mps_ap_destroy(apamc);
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poollo);
comment("Destroyed pools.");
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void) {
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
locell *a;
int i;
alloclocomments = 0;
allowlocopies = 0;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(
mps_root_create_reg(&root, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(
mps_fmt_create_A(&format, arena, &fmtLO),
"create format");
cdie(
mps_pool_create(&pool, arena, mps_class_lo(), format),
"create pool");
cdie(
mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
a = string_ch("Hello there");
(void)string_ch("Wibble wobble foo");
(void)string_ch("Ba ");
for (i=0; i<10000; i++) {
a = conc(string_ch("B"), a);
(void)conc(string_ch("Hello there"), string_ch(" folks!"));
}
mps_arena_park(arena);
mps_ap_destroy(ap);
comment("Destroyed ap.");
mps_pool_destroy(pool);
comment("Destroyed pool.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_root_destroy(root);
comment("Destroyed root.");
mps_thread_dereg(thread);
comment("Deregistered thread.");
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
