175 lines
6.1 KiB
Diff
175 lines
6.1 KiB
Diff
From 2e40ed7452896a5ad043ca1297112d2a5bf6189b Mon Sep 17 00:00:00 2001
|
|
From: David Allsopp <david.allsopp@metastack.com>
|
|
Date: Mon, 20 Apr 2020 16:13:26 +0100
|
|
Subject: [PATCH 5/7] Merge pull request #9457 from dra27/fix-mod_use
|
|
|
|
Fix #mod_use in toplevel
|
|
|
|
(cherry picked from commit f4dc3003d579e45f6ddeb6ffceb4c283a9e15bc7)
|
|
---
|
|
Changes | 2 +-
|
|
testsuite/tests/tool-toplevel/mod.ml | 1 +
|
|
testsuite/tests/tool-toplevel/mod_use.ml | 9 +++++++++
|
|
toplevel/opttoploop.ml | 19 +++++++++++--------
|
|
toplevel/toploop.ml | 19 +++++++++++--------
|
|
5 files changed, 33 insertions(+), 17 deletions(-)
|
|
create mode 100644 testsuite/tests/tool-toplevel/mod.ml
|
|
create mode 100644 testsuite/tests/tool-toplevel/mod_use.ml
|
|
|
|
diff --git a/Changes b/Changes
|
|
index f16158f12..a65573604 100644
|
|
--- a/Changes
|
|
+++ b/Changes
|
|
@@ -164,7 +164,7 @@ Working version
|
|
points to the grammar.
|
|
(Andreas Abel, review by Xavier Leroy)
|
|
|
|
-- #9283: add a new toplevel directive `#use_output "<command>"` to
|
|
+- #9283, #9455, #9457: add a new toplevel directive `#use_output "<command>"` to
|
|
run a command and evaluate its output.
|
|
(Jérémie Dimino, review by David Allsopp)
|
|
|
|
diff --git a/testsuite/tests/tool-toplevel/mod.ml b/testsuite/tests/tool-toplevel/mod.ml
|
|
new file mode 100644
|
|
index 000000000..cd298427b
|
|
--- /dev/null
|
|
+++ b/testsuite/tests/tool-toplevel/mod.ml
|
|
@@ -0,0 +1 @@
|
|
+let answer = 42
|
|
diff --git a/testsuite/tests/tool-toplevel/mod_use.ml b/testsuite/tests/tool-toplevel/mod_use.ml
|
|
new file mode 100644
|
|
index 000000000..e068ffc3a
|
|
--- /dev/null
|
|
+++ b/testsuite/tests/tool-toplevel/mod_use.ml
|
|
@@ -0,0 +1,9 @@
|
|
+(* TEST
|
|
+ files = "mod.ml"
|
|
+ * expect
|
|
+*)
|
|
+
|
|
+#mod_use "mod.ml"
|
|
+[%%expect {|
|
|
+module Mod : sig val answer : int end
|
|
+|}];;
|
|
diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml
|
|
index cd4210bbe..ad9a2569e 100644
|
|
--- a/toplevel/opttoploop.ml
|
|
+++ b/toplevel/opttoploop.ml
|
|
@@ -449,7 +449,7 @@ let preprocess_phrase ppf phr =
|
|
if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
|
|
phr
|
|
|
|
-let use_channel ppf wrap_mod ic name filename =
|
|
+let use_channel ppf ~wrap_in_module ic name filename =
|
|
let lb = Lexing.from_channel ic in
|
|
Location.init lb filename;
|
|
(* Skip initial #! line if any *)
|
|
@@ -461,7 +461,7 @@ let use_channel ppf wrap_mod ic name filename =
|
|
(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
|
|
+ (if wrap_in_module then
|
|
parse_mod_use_file name lb
|
|
else
|
|
!parse_use_file lb);
|
|
@@ -485,27 +485,30 @@ let use_output ppf command =
|
|
| 0 ->
|
|
let ic = open_in_bin fn in
|
|
Misc.try_finally ~always:(fun () -> close_in ic)
|
|
- (fun () -> use_channel ppf false ic "" "(command-output)")
|
|
+ (fun () ->
|
|
+ use_channel ppf ~wrap_in_module:false ic "" "(command-output)")
|
|
| n ->
|
|
fprintf ppf "Command exited with code %d.@." n;
|
|
false)
|
|
|
|
-let use_file ppf wrap_mode name =
|
|
+let use_file ppf ~wrap_in_module name =
|
|
match name with
|
|
| "" ->
|
|
- use_channel ppf wrap_mode stdin name "(stdin)"
|
|
+ use_channel ppf ~wrap_in_module 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)
|
|
+ (fun () -> use_channel ppf ~wrap_in_module 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
|
|
+let mod_use_file ppf name =
|
|
+ use_file ppf ~wrap_in_module:true name
|
|
+let use_file ppf name =
|
|
+ use_file ppf ~wrap_in_module:false name
|
|
|
|
let use_silently ppf name =
|
|
protect_refs [ R (use_print_results, false) ] (fun () -> use_file ppf name)
|
|
diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
|
|
index 02f629f9d..09e550796 100644
|
|
--- a/toplevel/toploop.ml
|
|
+++ b/toplevel/toploop.ml
|
|
@@ -394,7 +394,7 @@ let preprocess_phrase ppf phr =
|
|
if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
|
|
phr
|
|
|
|
-let use_channel ppf wrap_mod ic name filename =
|
|
+let use_channel ppf ~wrap_in_module ic name filename =
|
|
let lb = Lexing.from_channel ic in
|
|
Warnings.reset_fatal ();
|
|
Location.init lb filename;
|
|
@@ -408,7 +408,7 @@ let use_channel ppf wrap_mod ic name filename =
|
|
(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
|
|
+ (if wrap_in_module then
|
|
parse_mod_use_file name lb
|
|
else
|
|
!parse_use_file lb);
|
|
@@ -431,27 +431,30 @@ let use_output ppf command =
|
|
| 0 ->
|
|
let ic = open_in_bin fn in
|
|
Misc.try_finally ~always:(fun () -> close_in ic)
|
|
- (fun () -> use_channel ppf false ic "" "(command-output)")
|
|
+ (fun () ->
|
|
+ use_channel ppf ~wrap_in_module:false ic "" "(command-output)")
|
|
| n ->
|
|
fprintf ppf "Command exited with code %d.@." n;
|
|
false)
|
|
|
|
-let use_file ppf wrap_mode name =
|
|
+let use_file ppf ~wrap_in_module name =
|
|
match name with
|
|
| "" ->
|
|
- use_channel ppf wrap_mode stdin name "(stdin)"
|
|
+ use_channel ppf ~wrap_in_module 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)
|
|
+ (fun () -> use_channel ppf ~wrap_in_module 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
|
|
+let mod_use_file ppf name =
|
|
+ use_file ppf ~wrap_in_module:true name
|
|
+let use_file ppf name =
|
|
+ use_file ppf ~wrap_in_module:false name
|
|
|
|
let use_silently ppf name =
|
|
protect_refs [ R (use_print_results, false) ] (fun () -> use_file ppf name)
|
|
--
|
|
2.24.1
|
|
|