Skip to content

Commit 1846e78

Browse files
committed
flambda-backend: Fix backtrace_dynlink
1 parent ea1674c commit 1846e78

File tree

4 files changed

+90
-12
lines changed

4 files changed

+90
-12
lines changed
Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,16 @@
1-
Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38
1+
Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 46, characters 13-38
22
Called from Dynlink_internal_native.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 112, characters 8-25
33
Called from Dynlink_internal_native.Native.run.(fun) in file "otherlibs/dynlink/dynlink.ml" (inlined), line 132, characters 25-58
44
Called from Stdlib__List.iter in file "list.ml" (inlined), line 116, characters 12-15
55
Called from Dynlink_internal_native.Native.run in file "otherlibs/dynlink/dynlink.ml", line 132, characters 4-107
66
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 367, characters 13-72
77
Called from Stdlib__List.iter in file "list.ml" (inlined), line 116, characters 12-15
88
Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 8-408
9-
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-71
9+
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 76, characters 4-71
1010
execution of module initializers in the shared library failed: Failure("SUCCESS")
1111
Raised at Stdlib.failwith in file "stdlib.ml" (inlined), line 34, characters 17-33
12-
Called from Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 3, characters 4-22
13-
Re-raised at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 8, characters 5-12
12+
Called from Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 43, characters 4-22
13+
Re-raised at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 49, characters 5-12
1414
Called from Dynlink_internal_native.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 112, characters 8-25
1515
Called from Dynlink_internal_native.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 112, characters 8-25
1616
Re-raised at Dynlink_internal_native.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 124, characters 6-137
@@ -21,4 +21,4 @@ Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_co
2121
Called from Stdlib__List.iter in file "list.ml" (inlined), line 116, characters 12-15
2222
Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 8-408
2323
Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 376, characters 8-17
24-
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-71
24+
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 76, characters 4-71

testsuite/tests/backtrace/backtrace_dynlink.ml

Lines changed: 38 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,14 +33,51 @@ reference = "${test_source_directory}/backtrace_dynlink.flambda.reference"
3333
(* https://github.com/ocaml-multicore/ocaml-multicore/issues/440 *)
3434
(* https://github.com/ocaml-multicore/ocaml-multicore/pull/499 *)
3535

36+
(* Postprocess backtrace to ignore differences between dune and make
37+
builds (in the former, Dynlink.Native is Dynlink_internal_native.Native) *)
38+
let begins_with ?(from = 0) str ~prefix =
39+
(* From utils/misc.ml *)
40+
let rec helper idx =
41+
if idx < 0 then true
42+
else
43+
String.get str (from + idx) = String.get prefix idx && helper (idx-1)
44+
in
45+
let n = String.length str in
46+
let m = String.length prefix in
47+
if n >= from + m then helper (m-1) else false
48+
49+
let process_backtrace bt =
50+
let bt = String.split_on_char '\n' bt in
51+
let bt =
52+
List.map (fun line ->
53+
let prefix = "Called from Dynlink.Native" in
54+
if begins_with line ~prefix
55+
then
56+
"Called from Dynlink_internal_native.Native" ^
57+
(String.sub line (String.length prefix)
58+
(String.length line - String.length prefix))
59+
else
60+
let prefix = "Re-raised at Dynlink.Native" in
61+
if begins_with line ~prefix
62+
then
63+
"Re-raised at Dynlink_internal_native.Native" ^
64+
(String.sub line (String.length prefix)
65+
(String.length line - String.length prefix))
66+
else
67+
line
68+
)
69+
bt
70+
in
71+
String.concat "\n" bt
72+
3673
let () =
3774
Dynlink.allow_unsafe_modules true;
3875
try
3976
(Dynlink.loadfile [@inlined never]) "backtrace_dynlink_plugin.cmxs"
4077
with
4178
| Dynlink.Error err ->
4279
print_endline @@ Dynlink.error_message err;
43-
Printexc.print_backtrace stdout;
80+
print_string (process_backtrace (Printexc.get_backtrace ()))
4481
| exn ->
4582
Printexc.to_string exn |> print_endline;
4683
print_endline "ERROR"
Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,14 @@
1-
Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38
1+
Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 46, characters 13-38
22
Called from Dynlink_internal_native.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 112, characters 8-25
33
Called from Stdlib__List.iter in file "list.ml", line 116, characters 12-15
44
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 367, characters 13-72
55
Called from Stdlib__List.iter in file "list.ml", line 116, characters 12-15
66
Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 8-408
7-
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-71
7+
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 76, characters 4-71
88
execution of module initializers in the shared library failed: Failure("SUCCESS")
99
Raised at Stdlib.failwith in file "stdlib.ml", line 34, characters 17-33
10-
Called from Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 3, characters 4-22
11-
Re-raised at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 8, characters 5-12
10+
Called from Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 43, characters 4-22
11+
Re-raised at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 49, characters 5-12
1212
Called from Dynlink_internal_native.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 112, characters 8-25
1313
Called from Dynlink_internal_native.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 112, characters 8-25
1414
Re-raised at Dynlink_internal_native.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 124, characters 6-137
@@ -17,4 +17,4 @@ Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_co
1717
Called from Stdlib__List.iter in file "list.ml", line 116, characters 12-15
1818
Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 8-408
1919
Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 376, characters 8-17
20-
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-71
20+
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 76, characters 4-71
Lines changed: 42 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,49 @@
1+
(* CR mshinwell: Find a way of doing this postprocessing properly and
2+
removing the duplication with backtrace_dynlink.ml *)
3+
4+
(* Postprocess backtrace to ignore differences between dune and make
5+
builds (in the former, Dynlink.Native is Dynlink_internal_native.Native) *)
6+
let begins_with ?(from = 0) str ~prefix =
7+
(* From utils/misc.ml *)
8+
let rec helper idx =
9+
if idx < 0 then true
10+
else
11+
String.get str (from + idx) = String.get prefix idx && helper (idx-1)
12+
in
13+
let n = String.length str in
14+
let m = String.length prefix in
15+
if n >= from + m then helper (m-1) else false
16+
17+
let process_backtrace bt =
18+
let bt = String.split_on_char '\n' bt in
19+
let bt =
20+
List.map (fun line ->
21+
let prefix = "Called from Dynlink.Native" in
22+
if begins_with line ~prefix
23+
then
24+
"Called from Dynlink_internal_native.Native" ^
25+
(String.sub line (String.length prefix)
26+
(String.length line - String.length prefix))
27+
else
28+
let prefix = "Re-raised at Dynlink.Native" in
29+
if begins_with line ~prefix
30+
then
31+
"Re-raised at Dynlink_internal_native.Native" ^
32+
(String.sub line (String.length prefix)
33+
(String.length line - String.length prefix))
34+
else
35+
line
36+
)
37+
bt
38+
in
39+
String.concat "\n" bt
40+
141
let () =
242
try
343
failwith "SUCCESS"
444
with
545
| e ->
646
let c = Printexc.get_callstack 10 in
7-
Printexc.print_raw_backtrace stdout c;
47+
process_backtrace (Printexc.raw_backtrace_to_string c)
48+
|> print_string;
849
raise e

0 commit comments

Comments
 (0)