Skip to content

Commit 6fd673c

Browse files
Redefine the directives to throw an error on failure
The stdlib pre-4.14 defines them to be `ignore`d but they can be made to throw the error like in 4.14. At least some of them, for which the underlying functions are exposed in the interface.
1 parent cfedb20 commit 6fd673c

File tree

1 file changed

+19
-2
lines changed

1 file changed

+19
-2
lines changed

lib/top/compat_top.ml

Lines changed: 19 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -170,6 +170,7 @@ let ctype_get_desc ty =
170170

171171
exception Exit_with_status of int
172172

173+
173174
let execute_phrase print_outcome ppf phr =
174175
#if OCAML_VERSION >= (4, 12, 0)
175176
match Toploop.execute_phrase print_outcome ppf phr with
@@ -189,14 +190,30 @@ let patch_directive name directive =
189190
Toploop.add_directive patched_name directive directive_info;
190191
patched_name
191192

193+
(* port of Topdirs.action_on_suberror *)
194+
let action_on_suberror b =
195+
if not b && not !Sys.interactive then
196+
raise (Exit_with_status 125)
197+
198+
(* [load] cannot be patched to return errors because the underlying code is not exposed:
199+
It would require [Topdirs.load_file] with the first argument to be [false] but the exposed
200+
version hardcodes it to [true].
201+
*)
192202
let mdx_load = patch_directive "load" (Directive_string (Topdirs.dir_load std_err))
193-
let mdx_use = patch_directive "use" (Directive_string (Topdirs.dir_use std_err))
203+
204+
let dir_use ppf name =
205+
action_on_suberror (Toploop.use_file ppf name)
206+
207+
let mdx_use = patch_directive "use" (Directive_string (dir_use std_err))
194208
let mdx_install_printer = patch_directive "install_printer" (Directive_ident (Topdirs.dir_install_printer std_err))
195209
let mdx_remove_printer = patch_directive "remove_printer" (Directive_ident (Topdirs.dir_remove_printer std_err))
196210
#endif
197211

198212
#if OCAML_VERSION > (4, 11, 0) && OCAML_VERSION < (4, 14, 0)
199-
let mdx_use_output = patch_directive "use_output" (Directive_string (Topdirs.dir_use_output std_err))
213+
214+
let dir_use_output ppf name = action_on_suberror (Toploop.use_output ppf name)
215+
216+
let mdx_use_output = patch_directive "use_output" (Directive_string (dir_use_output std_err))
200217
#endif
201218

202219
#if OCAML_VERSION < (4, 13, 0)

0 commit comments

Comments
 (0)