Add a new toplevel directive #use_output "<command>"

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
Co-authored-by: David Allsopp <david.allsopp@metastack.com>

Changes

@@ -143,6 +143,10 @@ Working version
   points to the grammar.
   (Andreas Abel, review by Xavier Leroy)
 
+- #9283: add a new toplevel directive `#use_output "<command>"` to
+  run a command and evaluate its output.
+  (Jérémie Dimino, review by David Allsopp)
+
 ### Manual and documentation:
 
 - #9141: beginning of the ocamltest reference manual

manual/manual/cmds/top.etex

@@ -198,6 +198,10 @@ will result in an ``unbound value "quit"'' error.
     they were typed on standard input. The reading of the file stops at
     the first error encountered.
 
+  \item["#use_output \""\var{command}"\";;"]
+    Execute a command and evaluate its output as if it had been captured
+    to a file and passed to "#use".
+
   \item["#mod_use \""\var{file-name}"\";;"]
     Similar to "#use" but also wrap the code into a top-level module of the
     same name as capitalized file name without extensions, following

testsuite/tests/tool-toplevel/use_command.ml

@@ -0,0 +1,25 @@
+(* TEST
+   * expect
+*)
+
+(* Test a success case *)
+#use_output {|echo let x = 42|}
+[%%expect {|
+val x : int = 42
+|}];;
+
+(* When the command fails *)
+#use_output {|false|}
+[%%expect {|
+Command exited with code 1.
+|}];;
+
+(* When the code is invalid *)
+#use_output {|echo 1 :: x|}
+[%%expect {|
+File "(command-output)", line 1, characters 5-6:
+1 | 1 :: x
+         ^
+Error: This expression has type int but an expression was expected of type
+         int list
+|}];;

toplevel/opttopdirs.ml

@@ -115,8 +115,11 @@ let _ = Hashtbl.add directive_table "load" (Directive_string (dir_load std_out))
 (* Load commands from a file *)
 
 let dir_use ppf name = ignore(Opttoploop.use_file ppf name)
+let dir_use_output ppf name = ignore(Opttoploop.use_output ppf name)
 
 let _ = Hashtbl.add directive_table "use" (Directive_string (dir_use std_out))
+let _ = Hashtbl.add directive_table "use_output"
+    (Directive_string (dir_use_output std_out))
 
 (* Install, remove a printer *)
 

toplevel/opttopdirs.mli

@@ -23,6 +23,7 @@ val dir_remove_directory : string -> unit
 val dir_cd : string -> unit
 val dir_load : formatter -> string -> unit
 val dir_use : formatter -> string -> unit
+val dir_use_output : formatter -> string -> unit
 val dir_install_printer : formatter -> Longident.t -> unit
 val dir_remove_printer : formatter -> Longident.t -> unit
 

toplevel/opttoploop.ml

@@ -449,40 +449,60 @@ let preprocess_phrase ppf phr =
   if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
   phr
 
-let use_file ppf wrap_mod name =
-  try
-    let (filename, ic, must_close) =
-      if name = "" then
-        ("(stdin)", stdin, false)
-      else begin
-        let filename = Load_path.find name in
-        let ic = open_in_bin filename in
-        (filename, ic, true)
-      end
-    in
-    let lb = Lexing.from_channel ic in
-    Location.init lb filename;
-    (* Skip initial #! line if any *)
-    Lexer.skip_hash_bang lb;
-    let success =
-      protect_refs [ R (Location.input_name, filename) ] (fun () ->
-        try
-          List.iter
-            (fun ph ->
-              let ph = preprocess_phrase ppf ph in
-              if not (execute_phrase !use_print_results ppf ph) then raise Exit)
-            (if wrap_mod then
-               parse_mod_use_file name lb
-             else
-               !parse_use_file lb);
-          true
-        with
-        | Exit -> false
-        | Sys.Break -> fprintf ppf "Interrupted.@."; false
-        | x -> Location.report_exception ppf x; false) in
-    if must_close then close_in ic;
-    success
-  with Not_found -> fprintf ppf "Cannot find file %s.@." name; false
+let use_channel ppf wrap_mod ic name filename =
+  let lb = Lexing.from_channel ic in
+  Location.init lb filename;
+  (* Skip initial #! line if any *)
+  Lexer.skip_hash_bang lb;
+  let success =
+    protect_refs [ R (Location.input_name, filename) ] (fun () ->
+      try
+        List.iter
+          (fun ph ->
+            let ph = preprocess_phrase ppf ph in
+            if not (execute_phrase !use_print_results ppf ph) then raise Exit)
+          (if wrap_mod then
+             parse_mod_use_file name lb
+           else
+             !parse_use_file lb);
+        true
+      with
+      | Exit -> false
+      | Sys.Break -> fprintf ppf "Interrupted.@."; false
+      | x -> Location.report_exception ppf x; false) in
+  success
+
+let use_output ppf command =
+  let fn = Filename.temp_file "ocaml" "_toploop.ml" in
+  Misc.try_finally ~always:(fun () ->
+      try Sys.remove fn with Sys_error _ -> ())
+    (fun () ->
+       match
+         Printf.ksprintf Sys.command "%s > %s"
+           command
+           (Filename.quote fn)
+       with
+       | 0 ->
+         let ic = open_in_bin fn in
+         Misc.try_finally ~always:(fun () -> close_in ic)
+           (fun () -> use_channel ppf false ic "" "(command-output)")
+       | n ->
+         fprintf ppf "Command exited with code %d.@." n;
+         false)
+
+let use_file ppf wrap_mode name =
+  match name with
+  | "" ->
+    use_channel ppf wrap_mode stdin name "(stdin)"
+  | _ ->
+    match Load_path.find name with
+    | filename ->
+      let ic = open_in_bin filename in
+      Misc.try_finally ~always:(fun () -> close_in ic)
+        (fun () -> use_channel ppf false ic name filename)
+    | exception Not_found ->
+      fprintf ppf "Cannot find file %s.@." name;
+      false
 
 let mod_use_file ppf name = use_file ppf true name
 let use_file ppf name = use_file ppf false name

toplevel/opttoploop.mli

@@ -55,6 +55,7 @@ val preprocess_phrase :
         (* Preprocess the given toplevel phrase using regular and ppx
            preprocessors. Return the updated phrase. *)
 val use_file : formatter -> string -> bool
+val use_output : formatter -> string -> bool
 val use_silently : formatter -> string -> bool
 val mod_use_file : formatter -> string -> bool
         (* Read and execute commands from a file.

toplevel/topdirs.ml

@@ -240,6 +240,7 @@ let load_file = load_file false
 (* Load commands from a file *)
 
 let dir_use ppf name = ignore(Toploop.use_file ppf name)
+let dir_use_output ppf name = ignore(Toploop.use_output ppf name)
 let dir_mod_use ppf name = ignore(Toploop.mod_use_file ppf name)
 
 let _ = add_directive "use" (Directive_string (dir_use std_out))
@@ -248,6 +249,13 @@ let _ = add_directive "use" (Directive_string (dir_use std_out))
       doc = "Read, compile and execute source phrases from the given file.";
     }
 
+let _ = add_directive "use_output" (Directive_string (dir_use_output std_out))
+    {
+      section = section_run;
+      doc = "Execute a command and read, compile and execute source phrases \
+             from its output.";
+    }
+
 let _ = add_directive "mod_use" (Directive_string (dir_mod_use std_out))
     {
       section = section_run;
@@ -255,7 +263,6 @@ let _ = add_directive "mod_use" (Directive_string (dir_mod_use std_out))
              wraps the contents in a module.";
     }
 
-
 (* Install, remove a printer *)
 
 let filter_arrow ty =

toplevel/topdirs.mli

@@ -23,6 +23,7 @@ val dir_remove_directory : string -> unit
 val dir_cd : string -> unit
 val dir_load : formatter -> string -> unit
 val dir_use : formatter -> string -> unit
+val dir_use_output : formatter -> string -> unit
 val dir_install_printer : formatter -> Longident.t -> unit
 val dir_remove_printer : formatter -> Longident.t -> unit
 val dir_trace : formatter -> Longident.t -> unit

toplevel/toploop.ml

@@ -394,43 +394,61 @@ let preprocess_phrase ppf phr =
   if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
   phr
 
-let use_file ppf wrap_mod name =
-  try
-    let (filename, ic, must_close) =
-      if name = "" then
-        ("(stdin)", stdin, false)
-      else begin
-        let filename = Load_path.find name in
-        let ic = open_in_bin filename in
-        (filename, ic, true)
-      end
-    in
-    let lb = Lexing.from_channel ic in
-    Warnings.reset_fatal ();
-    Location.init lb filename;
-    (* Skip initial #! line if any *)
-    Lexer.skip_hash_bang lb;
-    let success =
-      protect_refs [ R (Location.input_name, filename);
-                     R (Location.input_lexbuf, Some lb); ]
-        (fun () ->
-        try
-          List.iter
-            (fun ph ->
-              let ph = preprocess_phrase ppf ph in
-              if not (execute_phrase !use_print_results ppf ph) then raise Exit)
-            (if wrap_mod then
-               parse_mod_use_file name lb
-             else
-               !parse_use_file lb);
-          true
-        with
-        | Exit -> false
-        | Sys.Break -> fprintf ppf "Interrupted.@."; false
-        | x -> Location.report_exception ppf x; false) in
-    if must_close then close_in ic;
-    success
-  with Not_found -> fprintf ppf "Cannot find file %s.@." name; false
+let use_channel ppf wrap_mod ic name filename =
+  let lb = Lexing.from_channel ic in
+  Warnings.reset_fatal ();
+  Location.init lb filename;
+  (* Skip initial #! line if any *)
+  Lexer.skip_hash_bang lb;
+  protect_refs [ R (Location.input_name, filename);
+                 R (Location.input_lexbuf, Some lb); ]
+    (fun () ->
+    try
+      List.iter
+        (fun ph ->
+          let ph = preprocess_phrase ppf ph in
+          if not (execute_phrase !use_print_results ppf ph) then raise Exit)
+        (if wrap_mod then
+           parse_mod_use_file name lb
+         else
+           !parse_use_file lb);
+      true
+    with
+    | Exit -> false
+    | Sys.Break -> fprintf ppf "Interrupted.@."; false
+    | x -> Location.report_exception ppf x; false)
+
+let use_output ppf command =
+  let fn = Filename.temp_file "ocaml" "_toploop.ml" in
+  Misc.try_finally ~always:(fun () ->
+      try Sys.remove fn with Sys_error _ -> ())
+    (fun () ->
+       match
+         Printf.ksprintf Sys.command "%s > %s"
+           command
+           (Filename.quote fn)
+       with
+       | 0 ->
+         let ic = open_in_bin fn in
+         Misc.try_finally ~always:(fun () -> close_in ic)
+           (fun () -> use_channel ppf false ic "" "(command-output)")
+       | n ->
+         fprintf ppf "Command exited with code %d.@." n;
+         false)
+
+let use_file ppf wrap_mode name =
+  match name with
+  | "" ->
+    use_channel ppf wrap_mode stdin name "(stdin)"
+  | _ ->
+    match Load_path.find name with
+    | filename ->
+      let ic = open_in_bin filename in
+      Misc.try_finally ~always:(fun () -> close_in ic)
+        (fun () -> use_channel ppf false ic name filename)
+    | exception Not_found ->
+      fprintf ppf "Cannot find file %s.@." name;
+      false
 
 let mod_use_file ppf name = use_file ppf true name
 let use_file ppf name = use_file ppf false name

toplevel/toploop.mli

@@ -75,6 +75,7 @@ val preprocess_phrase :
         (* Preprocess the given toplevel phrase using regular and ppx
            preprocessors. Return the updated phrase. *)
 val use_file : formatter -> string -> bool
+val use_output : formatter -> string -> bool
 val use_silently : formatter -> string -> bool
 val mod_use_file : formatter -> string -> bool
         (* Read and execute commands from a file.