Merge pull request ocaml#13107 from stedolan/statmemprof-testsuite-ro…

…bustness

Improve robustness of statmemprof testsuite

(cherry picked from commit 08dcdc5)

runtime/callback.c

@@ -55,17 +55,23 @@
 Caml_inline value alloc_and_clear_stack_parent(caml_domain_state* domain_state)
 {
   struct stack_info* parent_stack = Stack_parent(domain_state->current_stack);
-  value cont = caml_alloc_2(Cont_tag, Val_ptr(parent_stack), Val_long(0));
-  Stack_parent(domain_state->current_stack) = NULL;
-  return cont;
+  if (parent_stack == NULL) {
+    return Val_unit;
+  } else {
+    value cont = caml_alloc_2(Cont_tag, Val_ptr(parent_stack), Val_long(0));
+    Stack_parent(domain_state->current_stack) = NULL;
+    return cont;
+  }
 }
 
 Caml_inline void restore_stack_parent(caml_domain_state* domain_state,
                                       value cont)
 {
-  struct stack_info* parent_stack = Ptr_val(Op_val(cont)[0]);
   CAMLassert(Stack_parent(domain_state->current_stack) == NULL);
-  Stack_parent(domain_state->current_stack) = parent_stack;
+  if (Is_block(cont)) {
+    struct stack_info* parent_stack = Ptr_val(Op_val(cont)[0]);
+    Stack_parent(domain_state->current_stack) = parent_stack;
+  }
 }
 
 

testsuite/tests/statmemprof/comballoc.byte.reference

@@ -1,49 +1,40 @@
 2: 0.42 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 3: 0.42 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 4: 0.42 true
-Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 11-20
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
 Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 2: 0.01 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 3: 0.01 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 4: 0.01 true
-Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 11-20
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
 Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 2: 0.83 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 3: 0.83 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 4: 0.83 true
-Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 11-20
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
 Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 OK

testsuite/tests/statmemprof/comballoc.ml

@@ -15,7 +15,7 @@ module MP = Gc.Memprof
 
 (* A single 5-word allocation - header plus 4 content words *)
 
-let f5 n = (n,n,n,n)
+let[@inline never] f5 n = (n,n,n,n)
 
 (* A combined 12-word allocation: 5 words, 4 words, and 3 words *)
 
@@ -78,7 +78,9 @@ let test sampling_rate =
   done
 
 let () =
-  List.iter test [0.42; 0.01; 0.83]
+  test 0.42;
+  test 0.01;
+  test 0.83
 
 
 let no_callback_after_stop trigger =

testsuite/tests/statmemprof/comballoc.opt.reference

@@ -1,49 +1,40 @@
 2: 0.42 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 3: 0.42 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 4: 0.42 true
-Raised by primitive operation at Comballoc.f5 in file "comballoc.ml" (inlined), line 18, characters 11-20
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
 Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 2: 0.01 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 3: 0.01 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 4: 0.01 true
-Raised by primitive operation at Comballoc.f5 in file "comballoc.ml" (inlined), line 18, characters 11-20
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
 Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 2: 0.83 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 3: 0.83 false
 Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 4: 0.83 true
-Raised by primitive operation at Comballoc.f5 in file "comballoc.ml" (inlined), line 18, characters 11-20
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
 Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
 Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
-Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 81, characters 2-35
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 OK

testsuite/tests/statmemprof/custom.ml

@@ -1,6 +1,7 @@
 (* TEST *)
 
 module MP = Gc.Memprof
+let () = Gc.set { (Gc.get ()) with minor_heap_size = 262144 }
 
 let bigstring_create sz =
   Bigarray.Array1.create Bigarray.char Bigarray.c_layout sz

testsuite/tests/statmemprof/exception_comballoc.ml

@@ -28,7 +28,7 @@ module AllocSet = Set.Make(Int3Tuples)
 (* A combined 7-block 33-word allocation *)
 
 let[@inline never] f33 n =
-  ((n, n, (n, n, n, (n,n,n,n,n))), (n, n, (n, n, n, (n,n,n,n,n))))
+  ((n, n, (n, n, n, (n,n,n,n,n))), (n, n, (n, n, n, (n,n,n,n,0))))
 
 (* Raise exceptions from allocation callbacks.
 

testsuite/tests/statmemprof/lists_in_minor.ml

@@ -11,7 +11,7 @@ let rec allocate_list accu = function
 
 let[@inline never] allocate_lists len cnt =
   for j = 0 to cnt-1 do
-    ignore (allocate_list [] len)
+    ignore (Sys.opaque_identity (allocate_list [] len))
   done
 
 let check_distrib len cnt rate =

testsuite/tests/statmemprof/moved_while_blocking.ml

@@ -105,9 +105,7 @@ let () =
   let th = Thread.create thread_fn () in
   let _:Gc.Memprof.t = Gc.Memprof.(start ~sampling_rate:1.
     { null_tracker with
-      alloc_minor = (fun info -> if info.size = 1 then
-                                     (say "    minor alloc\n"; Some ())
-                                 else None);
+      alloc_minor = (fun info -> say "    minor alloc\n"; Some ());
       alloc_major = (fun _ -> say "    major alloc\n"; Some "major block\n");
       promote = (fun () ->
         say "    promoting...\n";