From 3ee539bf94fa9c894bdb0e81262d080e1c895371 Mon Sep 17 00:00:00 2001
From: Claudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Date: Wed, 4 Feb 2004 15:47:55 +0000
Subject: [PATCH] report files are now produced (and removed) during regression
 testing

---
 helm/gTopLevel/regtest.ml       | 82 ++++++++++++++++++---------------
 helm/gTopLevel/tests/.cvsignore |  2 +-
 2 files changed, 47 insertions(+), 37 deletions(-)

diff --git a/helm/gTopLevel/regtest.ml b/helm/gTopLevel/regtest.ml
index ecccf4579..625ac6440 100644
--- a/helm/gTopLevel/regtest.ml
+++ b/helm/gTopLevel/regtest.ml
@@ -31,6 +31,7 @@ let rawsep = "###"
 let sep = Pcre.regexp (sprintf "^%s" rawsep)
 let print s = print_string s
 let print_endline s = print_endline s
+let print_endline_to_channel ch s = output_string ch (s ^ "\n")
 
 type state = Term | EMetasenv | ETerm | EType | EReduced
 
@@ -109,41 +110,49 @@ let parse_regtest =
       etype = Buffer.contents etype;
       ereduced = Buffer.contents ereduced }
 
-let as_expected expected found = (* ignores "term" field *)
-  let outcome = ref true in
-  if expected.eterm <> found.eterm then begin
-    print_endline "Term mismatch";
-    print_endline "  expected:";
-    print_endline ("  " ^ expected.eterm);
-    print_endline "  found:";
-    print_endline ("  " ^ found.eterm);
-    outcome := false;
-  end;
-  if expected.emetasenv <> found.emetasenv then begin
-    print_endline "Metasenv mismatch";
-    print_endline "  expected:";
-    print_endline ("  " ^ expected.emetasenv);
-    print_endline "  found:";
-    print_endline ("  " ^ found.emetasenv);
-    outcome := false;
-  end;
-  if expected.etype <> found.etype then begin
-    print_endline "Type mismatch";
-    print_endline "  expected:";
-    print_endline ("  " ^ expected.etype);
-    print_endline "  found:";
-    print_endline ("  " ^ found.etype);
-    outcome := false;
-  end;
-  if expected.ereduced <> found.ereduced then begin
-    print_endline "Reduced term mismatch";
-    print_endline "  expected:";
-    print_endline ("  " ^ expected.ereduced);
-    print_endline "  found:";
-    print_endline ("  " ^ found.ereduced);
-    outcome := false;
-  end;
-  !outcome
+let as_expected report_fname expected found = (* ignores "term" field *)
+  let eterm_ok = expected.eterm = found.eterm in
+  let emetasenv_ok = expected.emetasenv = found.emetasenv in
+  let etype_ok = expected.etype = found.etype in
+  let ereduced_ok = expected.ereduced = found.ereduced in
+  let outcome = eterm_ok && emetasenv_ok && etype_ok && ereduced_ok in
+  if outcome then
+   (if Sys.file_exists report_fname then Sys.remove report_fname)
+  else
+   begin
+    let och = open_out report_fname in
+    let print_endline = print_endline_to_channel och in
+    if not eterm_ok then begin
+      print_endline "### Term mismatch ###";
+      print_endline "# expected:";
+      print_endline ("  " ^ expected.eterm);
+      print_endline "# found:";
+      print_endline ("  " ^ found.eterm);
+    end;
+    if not emetasenv_ok then begin
+      print_endline "### Metasenv mismatch ###";
+      print_endline "# expected:";
+      print_endline ("  " ^ expected.emetasenv);
+      print_endline "# found:";
+      print_endline ("  " ^ found.emetasenv);
+    end;
+    if not etype_ok then begin
+      print_endline "### Type mismatch ###";
+      print_endline "# expected:";
+      print_endline ("  " ^ expected.etype);
+      print_endline "# found:";
+      print_endline ("  " ^ found.etype);
+    end;
+    if expected.ereduced <> found.ereduced then begin
+      print_endline "### Reduced term mismatch ###";
+      print_endline "# expected:";
+      print_endline ("  " ^ expected.ereduced);
+      print_endline "# found:";
+      print_endline ("  " ^ found.ereduced);
+    end;
+    close_out och ;
+   end;
+  outcome
 
 let test_this raw_term =
   let empty_context = [] in
@@ -222,6 +231,7 @@ let main generate dump fnames =
      (function fname ->
        let env_fname = fname ^ ".env" in
        let test_fname = fname ^ ".test" in
+       let report_fname = fname ^ ".report" in
        restore_environment env_fname ;
        let time = Unix.gettimeofday () in
        print ("Processing " ^ fname ^":\t") ;
@@ -230,7 +240,7 @@ let main generate dump fnames =
           let expected = parse_regtest test_fname in
           let actual = test_this expected.term in
           if dump then dump_environment env_fname ;
-          if as_expected expected actual then
+          if as_expected report_fname expected actual then
            (incr ok ; true)
           else
            (nok := fname :: !nok ; false)
diff --git a/helm/gTopLevel/tests/.cvsignore b/helm/gTopLevel/tests/.cvsignore
index 03bd4129b..8fa95a300 100644
--- a/helm/gTopLevel/tests/.cvsignore
+++ b/helm/gTopLevel/tests/.cvsignore
@@ -1 +1 @@
-*.env
+*.env *.report
-- 
2.39.2