Skip to content

Commit

Permalink
Port upstream's #12260 (ocaml-flambda#2067)
Browse files Browse the repository at this point in the history
  • Loading branch information
xclerc authored Nov 24, 2023
1 parent afb2a38 commit a28b942
Show file tree
Hide file tree
Showing 4 changed files with 34 additions and 23 deletions.
25 changes: 12 additions & 13 deletions native_toplevel/opttoploop.ml
Original file line number Diff line number Diff line change
Expand Up @@ -96,18 +96,17 @@ type directive_info = {

let remembered = ref Ident.empty

let rec remember phrase_name i = function
| [] -> ()
| Sig_module (_, _, { md_type = Mty_alias _; _ }, _, _)
:: rest ->
remember phrase_name i rest
| Sig_value (id, _, _) :: rest
| Sig_module (id, _, _, _, _) :: rest
| Sig_typext (id, _, _, _) :: rest
| Sig_class (id, _, _, _) :: rest ->
remembered := Ident.add id (phrase_name, i) !remembered;
remember phrase_name (succ i) rest
| _ :: rest -> remember phrase_name i rest
let rec remember phrase_name signature =
let exported = List.filter Includemod.is_runtime_component signature in
List.iteri (fun i sg ->
match sg with
| Sig_value (id, _, _)
| Sig_module (id, _, _, _, _)
| Sig_typext (id, _, _, _)
| Sig_class (id, _, _, _) ->
remembered := Ident.add id (phrase_name, i) !remembered
| _ -> ())
exported

let toplevel_value id =
try Ident.find_same id !remembered
Expand Down Expand Up @@ -450,7 +449,7 @@ let execute_phrase print_outcome ppf phr =
Translmod.transl_implementation compilation_unit (str, coercion)
~style:Plain_block
in
remember compilation_unit 0 sg';
remember compilation_unit sg';
compilation_unit, close_phrase res, required_globals, size
else
let size, res = Translmod.transl_store_phrases compilation_unit str in
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -7,4 +7,7 @@ val _bar : ('a, 'b) A.t -> 'a option = <fun>
- : string = ""
- : char = 'd'
- : float = 42.
external foo : int -> int -> int = "%addint"
module S = String
val x : int = 42

7 changes: 7 additions & 0 deletions ocaml/testsuite/tests/tool-toplevel/topeval.ml
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,13 @@ let List.(String.(_)) = 'd'
let List.(_) : float = 42.0
;;

(* issue #12257: external or module alias followed by regular value triggers
an exception in ocamlnat *)
external foo : int -> int -> int = "%addint"
module S = String
let x = 42
;;

(* Check that frametables are correctly loaded by triggering GC *)
let () =
Gc.minor ();
Expand Down
22 changes: 12 additions & 10 deletions ocaml/toplevel/native/topeval.ml
Original file line number Diff line number Diff line change
Expand Up @@ -39,15 +39,17 @@ let global_symbol comp_unit =

let remembered = ref Ident.empty

let rec remember phrase_name i = function
| [] -> ()
| Sig_value (id, _, _) :: rest
| Sig_module (id, _, _, _, _) :: rest
| Sig_typext (id, _, _, _) :: rest
| Sig_class (id, _, _, _) :: rest ->
remembered := Ident.add id (phrase_name, i) !remembered;
remember phrase_name (succ i) rest
| _ :: rest -> remember phrase_name i rest
let remember phrase_name signature =
let exported = List.filter Includemod.is_runtime_component signature in
List.iteri (fun i sg ->
match sg with
| Sig_value (id, _, _)
| Sig_module (id, _, _, _, _)
| Sig_typext (id, _, _, _)
| Sig_class (id, _, _, _) ->
remembered := Ident.add id (phrase_name, i) !remembered
| _ -> ())
exported

let toplevel_value id =
try Ident.find_same id !remembered
Expand Down Expand Up @@ -210,7 +212,7 @@ let execute_phrase print_outcome ppf phr =
Translmod.transl_implementation phrase_comp_unit (str, Tcoerce_none)
~style:Plain_block
in
remember compilation_unit 0 sg';
remember compilation_unit sg';
compilation_unit, close_phrase res, required_globals, size
else
let size, res = Translmod.transl_store_phrases phrase_comp_unit str in
Expand Down

0 comments on commit a28b942

Please sign in to comment.