Permalink
Browse files

fix gc-roots test case for no-naked-pointers

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14913 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
1 parent 577ea36 commit 5791532c5d2ac81bc52ef6e6795d5dc5652e2514 @mshinwell mshinwell committed May 23, 2014
Showing with 8 additions and 4 deletions.
  1. +8 −4 testsuite/tests/gc-roots/globrootsprim.c
@@ -16,10 +16,12 @@
#include "mlvalues.h"
#include "memory.h"
#include "alloc.h"
+#include "gc.h"
-struct block { value v; };
+struct block { value header; value v; };
-#define Block_val(v) ((struct block *) (v))
+#define Block_val(v) ((struct block*) &((value*) v)[-1])
+#define Val_block(b) ((value) &((b)->v))
value gb_get(value vblock)
{
@@ -29,9 +31,10 @@ value gb_get(value vblock)
value gb_classic_register(value v)
{
struct block * b = caml_stat_alloc(sizeof(struct block));
+ b->header = Make_header(1, 0, Caml_black);
b->v = v;
caml_register_global_root(&(b->v));
- return (value) b;
+ return Val_block(b);
}
value gb_classic_set(value vblock, value newval)
@@ -49,9 +52,10 @@ value gb_classic_remove(value vblock)
value gb_generational_register(value v)
{
struct block * b = caml_stat_alloc(sizeof(struct block));
+ b->header = Make_header(1, 0, Caml_black);
b->v = v;
caml_register_generational_global_root(&(b->v));
- return (value) b;
+ return Val_block(b);
}
value gb_generational_set(value vblock, value newval)

0 comments on commit 5791532

Please sign in to comment.