From 9e3b813aae5018c2ad9d3ecf11ec5bfc87f1bef7 Mon Sep 17 00:00:00 2001
From: Thomas Refis <thomas.refis@gmail.com>
Date: Thu, 6 Sep 2018 16:58:50 +0100
Subject: expect_test: show typer state not properly cleaned

---
 testsuite/tests/tool-expect-test/clean_typer.ml | 85 +++++++++++++++++++++++++
 testsuite/tests/tool-expect-test/ocamltests     |  1 +
 2 files changed, 86 insertions(+)
 create mode 100644 testsuite/tests/tool-expect-test/clean_typer.ml
 create mode 100644 testsuite/tests/tool-expect-test/ocamltests

diff --git a/testsuite/tests/tool-expect-test/clean_typer.ml b/testsuite/tests/tool-expect-test/clean_typer.ml
new file mode 100644
index 0000000000..f22f667c7f
--- /dev/null
+++ b/testsuite/tests/tool-expect-test/clean_typer.ml
@@ -0,0 +1,85 @@
+(* TEST
+    * expect
+*)
+
+module Variants = struct
+  type bar = [ `Bar ]
+  type foo = private [< `Foo | `Bar ]
+end
+
+open Variants
+
+module M : sig
+  type +'a t
+
+  val foo : unit -> foo t
+  val bar : unit -> bar t
+end = struct
+  type 'a t = 'a list
+
+  let foo () = []
+  let bar () = []
+end
+
+module type Foo = sig
+  val x : foo M.t -> unit
+end
+
+let ffoo t (module F : Foo) =
+  F.x t
+
+module type Bar = sig
+  val x : bar M.t -> unit
+end
+
+let fbar t (module B : Bar) =
+  B.x t
+
+let (foo : foo M.t) = M.foo ()
+let (bar : bar M.t) = M.bar ()
+[%%expect {|
+module Variants :
+  sig type bar = [ `Bar ] type foo = private [< `Bar | `Foo ] end
+module M :
+  sig
+    type +'a t
+    val foo : unit -> Variants.foo t
+    val bar : unit -> Variants.bar t
+  end
+module type Foo = sig val x : Variants.foo M.t -> unit end
+val ffoo : Variants.foo M.t -> (module Foo) -> unit = <fun>
+module type Bar = sig val x : Variants.bar M.t -> unit end
+val fbar : Variants.bar M.t -> (module Bar) -> unit = <fun>
+val foo : Variants.foo M.t = <abstr>
+val bar : Variants.bar M.t = <abstr>
+|}]
+
+let f1 = ffoo foo;;
+[%%expect {|
+val f1 : (module Foo) -> unit = <fun>
+|}]
+
+let f2 = ffoo bar;;
+[%%expect {|
+Line 1, characters 14-17:
+  let f2 = ffoo bar;;
+                ^^^
+Error: This expression has type Variants.bar M.t
+       but an expression was expected of type Variants.foo M.t
+       Type Variants.bar = [ `Bar ] is not compatible with type Variants.foo
+       The first variant type does not allow tag(s) `Foo
+|}]
+
+let f3 = fbar foo;;
+[%%expect {|
+Uncaught exception: Stack overflow
+
+|}, Principal{|
+Line 1, characters 14-17:
+  let f3 = fbar foo;;
+                ^^^
+Error: This expression has type Variants.foo M.t
+       but an expression was expected of type Variants.bar M.t
+       Type Variants.foo is not compatible with type Variants.bar = [ `Bar ]
+       The second variant type does not allow tag(s) `Foo
+|}]
diff --git a/testsuite/tests/tool-expect-test/ocamltests b/testsuite/tests/tool-expect-test/ocamltests
new file mode 100644
index 0000000000..c7e19b8732
--- /dev/null
+++ b/testsuite/tests/tool-expect-test/ocamltests
@@ -0,0 +1 @@
+clean_typer.ml
-- 
cgit v1.2.1


From 17d1d782e216b85f910bed9ce2f8627c7dc546e4 Mon Sep 17 00:00:00 2001
From: Thomas Refis <thomas.refis@gmail.com>
Date: Thu, 6 Sep 2018 17:00:56 +0100
Subject: expect_test: cleanup typer state

---
 testsuite/tests/tool-expect-test/clean_typer.ml | 3 ---
 testsuite/tools/Makefile                        | 2 +-
 testsuite/tools/expect_test.ml                  | 2 ++
 3 files changed, 3 insertions(+), 4 deletions(-)

diff --git a/testsuite/tests/tool-expect-test/clean_typer.ml b/testsuite/tests/tool-expect-test/clean_typer.ml
index f22f667c7f..3009a17719 100644
--- a/testsuite/tests/tool-expect-test/clean_typer.ml
+++ b/testsuite/tests/tool-expect-test/clean_typer.ml
@@ -72,9 +72,6 @@ Error: This expression has type Variants.bar M.t
 
 let f3 = fbar foo;;
 [%%expect {|
-Uncaught exception: Stack overflow
-
-|}, Principal{|
 Line 1, characters 14-17:
   let f3 = fbar foo;;
                 ^^^
diff --git a/testsuite/tools/Makefile b/testsuite/tools/Makefile
index 97e50ff9b3..c14fade18c 100644
--- a/testsuite/tools/Makefile
+++ b/testsuite/tools/Makefile
@@ -17,7 +17,7 @@ include $(BASEDIR)/../config/Makefile
 expect_MAIN=expect_test
 expect_PROG=$(expect_MAIN)$(EXE)
 expect_COMPFLAGS=-I $(OTOPDIR)/parsing -I $(OTOPDIR)/utils \
-          -I $(OTOPDIR)/driver -I $(OTOPDIR)/toplevel
+          -I $(OTOPDIR)/driver -I $(OTOPDIR)/typing -I $(OTOPDIR)/toplevel
 expect_LIBRARIES=../../compilerlibs/ocamlcommon \
           ../../compilerlibs/ocamlbytecomp \
           ../../compilerlibs/ocamltoplevel
diff --git a/testsuite/tools/expect_test.ml b/testsuite/tools/expect_test.ml
index 2bace33432..2940a32f95 100644
--- a/testsuite/tools/expect_test.ml
+++ b/testsuite/tools/expect_test.ml
@@ -250,6 +250,7 @@ let eval_expect_file _fname ~file_contents =
     let _ : bool =
       List.fold_left phrases ~init:true ~f:(fun acc phrase ->
         acc &&
+        let snap = Btype.snapshot () in
         try
           exec_phrase ppf phrase
         with exn ->
@@ -260,6 +261,7 @@ let eval_expect_file _fname ~file_contents =
               (Printexc.to_string exn)
               (Printexc.raw_backtrace_to_string bt)
           end;
+          Btype.backtrack snap;
           false
       )
     in
-- 
cgit v1.2.1