Merge pull request #9185 from hhugo/fix-unused-open

fix spurious 'unused open' warning with classes and polymorphic variants

(cherry picked from commit d2c4e791fad6340c74abf741af3e79eb1f9c20d7)

4 files changed, 56 insertions, 4 deletions

diff --git a/Changes b/Changes
index d53d408ad6..258f74605d 100644
--- a/Changes
+++ b/Changes
@@ -379,13 +379,13 @@ OCaml 4.10.0
 - #8833: Hint for (type) redefinitions in toplevel session
   (Florian Angeletti, review by Gabriel Scherer)
 
-- #2127: Refactor lookup functions
+- #2127, #9185: Refactor lookup functions
   Included observable changes:
     - makes the location of usage warnings and alerts for constructors more
       precise
     - don't warn about a constructor never being used to build values when it
       has been defined as private
-  (Leo White, review by Thomas Refis)
+  (Leo White, Hugo Heuzard review by Thomas Refis, Florian Angeletti)
 
 - #8702, #8777: improved error messages for fixed row polymorphic variants
   (Florian Angeletti, report by Leo White, review by Thomas Refis)
diff --git a/testsuite/tests/messages/precise_locations.ml b/testsuite/tests/messages/precise_locations.ml
index a6bc225dfb..efbc15a46d 100644
--- a/testsuite/tests/messages/precise_locations.ml
+++ b/testsuite/tests/messages/precise_locations.ml
@@ -19,7 +19,7 @@ function (x :
 Line 2, characters 1-4:
 2 | #bar) -> ();;
      ^^^
-Error: Unbound class bar
+Error: Unbound class type bar
 |}];;
 
 function
diff --git a/testsuite/tests/typing-warnings/open_warnings.ml b/testsuite/tests/typing-warnings/open_warnings.ml
index 48f7f94068..e6c656910d 100644
--- a/testsuite/tests/typing-warnings/open_warnings.ml
+++ b/testsuite/tests/typing-warnings/open_warnings.ml
@@ -177,3 +177,53 @@ Line 2, characters 12-13:
 Warning 37: unused constructor A.
 module T5_bis : sig end
 |}]
+
+
+module T6 : sig end = struct
+  (* GPR9170 *)
+  module M = struct
+    type t = [`A | `B]
+  end
+  module type S = sig
+    open M
+    val f: #t -> unit
+  end
+  let _ = fun ((module S : S)) -> S.f `A
+end;;
+[%%expect {|
+Line 8, characters 11-13:
+8 |     val f: #t -> unit
+               ^^
+Alert deprecated: old syntax for polymorphic variant type
+module T6 : sig end
+|}]
+
+module T7 : sig end = struct
+  (* GPR9170 *)
+  module M = struct
+    class type t = object end
+  end
+  module type S = sig
+    open M
+    val f: #t -> unit
+  end
+  let _ = fun ((module S : S)) -> S.f (object end)
+end;;
+[%%expect {|
+module T7 : sig end
+|}]
+
+module T8 : sig end = struct
+  (* GPR9170 *)
+  module M = struct
+    class t = object end
+  end
+  module type S = sig
+    open M
+    val f: #t -> unit
+  end
+  let _ = fun ((module S : S)) -> S.f (object end)
+end;;
+[%%expect {|
+module T8 : sig end
+|}]
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index d886928fd2..a55e53d00a 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -266,6 +266,7 @@ and transl_type_aux env policy styp =
           in check decl;
           Location.deprecated styp.ptyp_loc
             "old syntax for polymorphic variant type";
+          ignore(Env.lookup_type ~loc:lid.loc lid.txt env);
           (path, decl,true)
         with Not_found -> try
           let lid2 =
@@ -275,9 +276,10 @@ and transl_type_aux env policy styp =
             | Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type"
           in
           let path, decl = Env.find_type_by_name lid2 env in
+          ignore(Env.lookup_cltype ~loc:lid.loc lid.txt env);
           (path, decl, false)
         with Not_found ->
-          ignore (Env.lookup_class ~loc:lid.loc lid.txt env); assert false
+          ignore (Env.lookup_cltype ~loc:lid.loc lid.txt env); assert false
       in
       if List.length stl <> decl.type_arity then
         raise(Error(styp.ptyp_loc, env,