From 4e8d63ace93a06cb416618714408ae1c41223812 Mon Sep 17 00:00:00 2001
From: Grégoire Duchêne <gduchene@awhk.org>
Date: Mon, 29 Sep 2014 14:41:29 +0200
Subject: Added the -t CLI option

This option makes tamasheq print any exception that escaped the eval
function. Thus, instead of crashing, tamasheq will exit normally.

This option is used in run_tests.sh when some of the tests do fail on
purpose (see tests/AssertFalse.ml).
---
 run_tests.sh               |  2 +-
 src/Tamasheq.ml            | 18 ++++++++++++++----
 tests/AssertFalse.expected |  1 +
 tests/AssertFalse.ml       |  1 +
 4 files changed, 17 insertions(+), 5 deletions(-)
 create mode 100644 tests/AssertFalse.expected
 create mode 100644 tests/AssertFalse.ml

diff --git a/run_tests.sh b/run_tests.sh
index 8d6e75b..e828c67 100755
--- a/run_tests.sh
+++ b/run_tests.sh
@@ -10,7 +10,7 @@ for input in *.ml; do
     name="${input%\.ml}"
     output="$tmp/${input/ml/output}"
 
-    if ../tamasheq -denv -o "$tmp" "$input" > "$output" 2>&1; then
+    if ../tamasheq -denv -o "$tmp" "$input" -t > "$output" 2>&1; then
         if cmp -s "$expected" "$output"; then
             printf "%-20s\tSUCCESS\n" "$name" >&2
             rm "$tmp/$name"*
diff --git a/src/Tamasheq.ml b/src/Tamasheq.ml
index d5e17b0..22f9d8f 100644
--- a/src/Tamasheq.ml
+++ b/src/Tamasheq.ml
@@ -27,6 +27,7 @@ let files  = Queue.create ()
 let hooks  = Queue.create ()
 let intfs  = Queue.create ()
 let outdir = ref "."
+let test   = ref false
 
 let load_mli filename outdir =
   let open Pparse    in
@@ -108,6 +109,7 @@ let () =
     "-dlam", Unit   (fun () -> denv := not (!dlam)), " Print the Lambda AST";
     "-h"   , String (fun s  -> Queue.add s hooks)  , "<hook> Run <hook>";
     "-o"   , String (fun s  -> outdir := s)        , "<dir> Output files in <dir>";
+    "-t"   , Unit   (fun s  -> test := not (!test)), " Always exit successfully";
     "--"   , Rest   (fun s  -> Queue.add s argsk)  , " (undocumented)";
   ]
   in
@@ -144,8 +146,16 @@ let () =
         List.iter (Printlambda.lambda pp >> Format.print_newline) lambda
       ;
 
-      List.iter (fun l -> ignore @$ eval env [] l) lambda;
-
-      if !denv then
-        Environment.dump env stderr
+      try
+        begin
+          List.iter (fun l -> ignore @$ eval env [] l) lambda;
+
+          if !denv then
+            Environment.dump env stderr
+        end
+      with exn ->
+        if !test then
+          prerr_endline @$ Printexc.to_string exn
+        else
+          raise exn
     end
diff --git a/tests/AssertFalse.expected b/tests/AssertFalse.expected
new file mode 100644
index 0000000..1b12ae5
--- /dev/null
+++ b/tests/AssertFalse.expected
@@ -0,0 +1 @@
+File "AssertFalse.ml", line 1, characters 8-14: Assertion failed
diff --git a/tests/AssertFalse.ml b/tests/AssertFalse.ml
new file mode 100644
index 0000000..ff92592
--- /dev/null
+++ b/tests/AssertFalse.ml
@@ -0,0 +1 @@
+let x = assert false
-- 
cgit v1.2.3-70-g09d2