Skip to content

Commit b03bf0b

Browse files
authored
Fix ocamlobjinfo on flambda2 .cmx files (#1029)
1 parent 0266787 commit b03bf0b

File tree

2 files changed

+36
-15
lines changed

2 files changed

+36
-15
lines changed

ocaml/testsuite/tests/tool-ocamlobjinfo/question.ml

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,13 @@ program = "question.cmxs"
88
**** check-ocamlopt.byte-output
99
***** ocamlobjinfo
1010
****** check-program-output
11+
12+
***** ocamlobjinfo
13+
program = "question.cmx"
14+
(* The cmx output varies too much to check. We're just happy it didn't
15+
segfault on us. *)
1116
*)
1217

13-
let answer = 42
18+
(* We use a function rather than a value of type int to ensure that there
19+
is an Flambda 2 code section. *)
20+
let answer () = 42

tools/flambda_backend_objinfo.ml

Lines changed: 28 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,12 @@
1515
(* *)
1616
(**************************************************************************)
1717

18+
(* CR-someday lmaurer: This file should do no parsing or low-level binary I/O
19+
_whatsoever_. No magic numbers, no sections, and _especially_ no
20+
[input_value]. Any such code here is necessarily duplicated code, and worse,
21+
particularly fiddly duplicated code that segfaults rather than producing
22+
compile-time errors. *)
23+
1824
(* Dump info on .cmi, .cmo, .cmx, .cma, .cmxa, .cmxs files
1925
and on bytecode executables. *)
2026

@@ -160,41 +166,49 @@ let print_generic_fns gfns =
160166

161167

162168
let print_cmx_infos (ui, crc) =
163-
print_general_infos Compilation_unit.output ui.ui_unit crc ui.ui_defines
164-
(fun f -> List.iter f ui.ui_imports_cmi)
165-
(fun f -> List.iter f ui.ui_imports_cmx);
166-
begin match ui.ui_export_info with
167-
| Clambda approx ->
169+
print_general_infos Compilation_unit.output ui.uir_unit crc ui.uir_defines
170+
(fun f -> List.iter f ui.uir_imports_cmi)
171+
(fun f -> List.iter f ui.uir_imports_cmx);
172+
begin match ui.uir_export_info with
173+
| Clambda_raw approx ->
168174
if not !no_approx then begin
169175
printf "Clambda approximation:\n";
170176
Format.fprintf Format.std_formatter " %a@." Printclambda.approx approx
171177
end else
172178
Format.printf "Clambda unit@.";
173-
| Flambda1 export ->
179+
| Flambda1_raw export ->
174180
if not !no_approx || not !no_code then
175181
printf "Flambda export information:\n"
176182
else
177183
printf "Flambda unit\n";
178184
if not !no_approx then begin
179-
Compilation_unit.set_current (Some ui.ui_unit);
180-
let root_symbols = List.map Symbol.for_compilation_unit ui.ui_defines in
185+
Compilation_unit.set_current (Some ui.uir_unit);
186+
let root_symbols = List.map Symbol.for_compilation_unit ui.uir_defines in
181187
Format.printf "approximations@ %a@.@."
182188
Export_info.print_approx (export, root_symbols)
183189
end;
184190
if not !no_code then
185191
Format.printf "functions@ %a@.@."
186192
Export_info.print_functions export
187-
| Flambda2 None ->
193+
| Flambda2_raw None ->
188194
printf "Flambda 2 unit (with no export information)\n"
189-
| Flambda2 (Some cmx) ->
195+
| Flambda2_raw (Some cmx) ->
190196
printf "Flambda 2 export information:\n";
191197
flush stdout;
198+
let cmx =
199+
Flambda2_cmx.Flambda_cmx_format.from_raw cmx
200+
~sections:Flambda_backend_utils.File_sections.empty
201+
in
202+
(* CR ncourant: I think it would be better to actually read the
203+
sections here (the cost is almost zero anyway), in case the
204+
printing code uses them at some point. (They might even be
205+
currently read, I'm not sure). *)
192206
Format.printf "%a\n%!" Flambda2_cmx.Flambda_cmx_format.print cmx
193207
end;
194-
print_generic_fns ui.ui_generic_fns;
195-
printf "Force link: %s\n" (if ui.ui_force_link then "YES" else "no");
208+
print_generic_fns ui.uir_generic_fns;
209+
printf "Force link: %s\n" (if ui.uir_force_link then "YES" else "no");
196210
printf "Functions with neither allocations nor indirect calls:\n";
197-
String.Set.iter print_line ui.ui_checks.ui_noalloc_functions
211+
String.Set.iter print_line ui.uir_checks.ui_noalloc_functions
198212

199213
let print_cmxa_infos (lib : Cmx_format.library_infos) =
200214
printf "Extra C object files:";
@@ -320,7 +334,7 @@ let dump_obj_by_kind filename ic obj_kind =
320334
| Some cmt -> print_cmt_infos cmt
321335
end
322336
| Cmx _config ->
323-
let ui = (input_value ic : unit_infos) in
337+
let ui = (input_value ic : unit_infos_raw) in
324338
let crc = Digest.input ic in
325339
close_in ic;
326340
print_cmx_infos (ui, crc)

0 commit comments

Comments
 (0)