From 9f88404bc36018d5cf4bdca5cbeaa1831d1c5c63 Mon Sep 17 00:00:00 2001 From: Luke Maurer Date: Thu, 24 Nov 2022 12:04:23 +0000 Subject: [PATCH 1/3] Add a test for frametable setup in natdynlinked libraries Previously, we could miss that `caml_shared_startup` wasn't being invoked (see PR #980), causing memory corruption in rare cases due to the frametable missing information on `caml_curry_*` functions. --- ocaml/testsuite/tests/lib-dynlink-native/plugin2.ml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/ocaml/testsuite/tests/lib-dynlink-native/plugin2.ml b/ocaml/testsuite/tests/lib-dynlink-native/plugin2.ml index 109c129d1a8..1d64c1e79fd 100644 --- a/ocaml/testsuite/tests/lib-dynlink-native/plugin2.ml +++ b/ocaml/testsuite/tests/lib-dynlink-native/plugin2.ml @@ -1,8 +1,20 @@ (*external ex: int -> int = "caml_ex"*) +let foo a1 a2 a3 a4 a5 a6 a7 a8 a9 = + Printexc.print_raw_backtrace stdout (Printexc.get_callstack 4); + fun a10 a11 a12 a13 a14 a15 a16 a17 a18 -> () + +(* Ensure that the frametable is set up correctly so that a [caml_curry_18] + frame can be traversed *) +let[@inline never] test_frametable () = + (Sys.opaque_identity foo) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18; + (* force non-tail call *) + let () = () in () + let () = Api.reg_mod "Plugin2"; Api.add_cb (fun () -> print_endline "Callback from plugin2"); (* let i = ex 3 in*) List.iter (fun i -> Printf.printf "%i\n" i) Plugin.facts; + test_frametable (); Printf.printf "XXX\n" From d3e2a379b39e2c27895dabc494a430f8eb87e8bf Mon Sep 17 00:00:00 2001 From: Luke Maurer Date: Thu, 24 Nov 2022 12:53:33 +0000 Subject: [PATCH 2/3] Promote test output --- ocaml/testsuite/tests/lib-dynlink-native/main.reference | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ocaml/testsuite/tests/lib-dynlink-native/main.reference b/ocaml/testsuite/tests/lib-dynlink-native/main.reference index e9e4ee45dd4..e6d6be749a6 100644 --- a/ocaml/testsuite/tests/lib-dynlink-native/main.reference +++ b/ocaml/testsuite/tests/lib-dynlink-native/main.reference @@ -7,6 +7,9 @@ Registering module Plugin2 2 6 1 +Raised by primitive operation at Plugin2.foo in file "plugin2.ml", line 4, characters 38-64 +Called from Plugin2.test_frametable in file "plugin2.ml", line 10, characters 2-72 +Called from Plugin2 in file "plugin2.ml", line 19, characters 2-20 XXX Loading plugin_thread.so Registering module Plugin_thread From 3de8052edecd50513c0d85aea28a7859517810b5 Mon Sep 17 00:00:00 2001 From: Luke Maurer Date: Thu, 24 Nov 2022 16:38:04 +0000 Subject: [PATCH 3/3] Be more robust in forcing a non-tail call --- ocaml/testsuite/tests/lib-dynlink-native/plugin2.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/testsuite/tests/lib-dynlink-native/plugin2.ml b/ocaml/testsuite/tests/lib-dynlink-native/plugin2.ml index 1d64c1e79fd..84342bf49d0 100644 --- a/ocaml/testsuite/tests/lib-dynlink-native/plugin2.ml +++ b/ocaml/testsuite/tests/lib-dynlink-native/plugin2.ml @@ -9,7 +9,7 @@ let foo a1 a2 a3 a4 a5 a6 a7 a8 a9 = let[@inline never] test_frametable () = (Sys.opaque_identity foo) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18; (* force non-tail call *) - let () = () in () + Sys.opaque_identity () let () = Api.reg_mod "Plugin2";