OCaml 5: restore nnp tests (#267)

* Restore NNP tests

* Restore some additional tests

Author: ncik-roberts

testsuite/tests/lib-random/full_int.ml

@@ -0,0 +1,10 @@
+(* TEST *)
+
+(* Ensure that a bound which is negative on 31-bit OCaml but positive on 32-bit
+   OCaml produces the same result on 64-bit OCaml. *)
+let bound = 0x6FFFFFFF in
+if bound < 0 then (* 31-bit integers *)
+  print_endline "6beb775a"
+else (* 32 or 64-bit integers *)
+  let s = Random.State.make [| 42 |] in
+  Printf.printf "%x\n" (Random.State.full_int s bound)

testsuite/tests/lib-random/full_int.reference

@@ -0,0 +1 @@
+6beb775a

testsuite/tests/lib-string/test_string.reference

@@ -0,0 +1,15 @@
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+let t =
+  let t = Thread.create (fun _ -> ())() in
+  Thread.join t
+
+let () =
+  Thread.exit ()

testsuite/tests/lib-threads/pr9971.ml

@@ -0,0 +1,20 @@
+#include <string.h>
+#include "caml/mlvalues.h"
+#include "caml/gc.h"
+#include "caml/memory.h"
+
+static int colors[4] = { Caml_white, Caml_gray, Caml_blue, Caml_black };
+
+value make_block(value header_size, value color, value size)
+{
+  intnat sz = Nativeint_val(size);
+  value * p = caml_stat_alloc((1 + sz) * sizeof(value));
+  p[0] = Make_header(Nativeint_val(header_size), 0, colors[Int_val(color)]);
+  memset(p + 1, 0x80, sz * sizeof(value));
+  return (value) (p + 1);
+}
+
+value make_raw_pointer (value v)
+{
+  return (value) Nativeint_val(v);
+}

testsuite/tests/runtime-naked-pointers/cstubs.c

@@ -0,0 +1,11 @@
+type color = White | Gray | Blue | Black
+
+external make_block: nativeint -> color -> nativeint -> Obj.t
+         = "make_block"
+
+external make_raw_pointer: nativeint -> Obj.t
+         = "make_raw_pointer"
+
+let do_gc root =
+  Gc.compact();   (* full major + compaction *)
+  root

testsuite/tests/runtime-naked-pointers/np.ml

@@ -0,0 +1,12 @@
+(* TEST
+   modules = "cstubs.c np.ml"
+   * bytecode
+   * native
+*)
+
+open Np
+
+(* Out-of-heap object with black header is accepted even in no-naked-pointers
+   mode.  GC doesn't scan black objects. *)
+
+let x = do_gc [ make_block 100n Black 100n ]

testsuite/tests/runtime-naked-pointers/np1.ml

@@ -0,0 +1,13 @@
+(* TEST
+   modules = "cstubs.c np.ml"
+   * bytecode
+   * native
+*)
+
+open Np
+
+(* Out-of-heap object with black header is accepted even in no-naked-pointers
+   mode.  GC doesn't scan black objects.  However, if the size in the
+   head is crazily big, the naked pointer detector will warn. *)
+
+let x = do_gc [ make_block (-1n) Black 100n ]

testsuite/tests/runtime-naked-pointers/np2.ml

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+exec ${test_source_directory}/runtest.sh

testsuite/tests/runtime-naked-pointers/np2.run

@@ -0,0 +1,15 @@
+(* TEST
+   modules = "cstubs.c np.ml"
+   * naked_pointers
+   ** bytecode
+   ** native
+*)
+
+open Np
+
+(* Out-of-heap object with non-black header is OK in naked pointers mode only *)
+(* Note that the header size can be wrong as it should not be used by the GC *)
+
+let x = do_gc [ make_block 10000n White 10n;
+                make_block 1n Blue 0n;
+                make_block (-1n) Gray 5n ]

testsuite/tests/runtime-naked-pointers/np3.ml

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+exec ${test_source_directory}/runtest.sh

testsuite/tests/runtime-naked-pointers/np3.run

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+exec ${test_source_directory}/runtest.sh

testsuite/tests/runtime-naked-pointers/np4.run

@@ -0,0 +1,10 @@
+#!/bin/sh
+
+if grep -q "#define NAKED_POINTERS_CHECKER" ${ocamlsrcdir}/runtime/caml/m.h \
+&& (echo ${program} | grep -q '\.opt')
+then
+  (${program} > ${output}) 2>&1 | grep -q '^Out-of-heap '
+  exit $?
+else
+  exec ${program} > ${output}
+fi