PR#6752: revert to strict scope

Changes

@@ -112,7 +112,13 @@ OCaml 4.04.0:
 - PR#6505: Missed Type-error leads to a segfault upon record access
   (Jacques Garrigue, extra report by Stephen Dolan)
 
+* PR#6752: Extensible variant types and scope escaping
+  Revert to strict scope, see comments on Mantis.
+  (Jacques Garrigue, following discussion with Jeremy Yallop,
+   Nicolas Ojeda Bar and Alain Frisch)
+
 - PR#7112: Aliased arguments ignored for equality of module types
+  (Jacques Garrigue, report by Leo White)
 
 - PR#7257, GPR#583: revert a 4.03 change of behavior on (Unix.sleep 0.),
   it now calls (nano)sleep for 0 seconds as in (< 4.03) versions.

testsuite/tests/typing-modules-bugs/pr6752_bad.ml

@@ -0,0 +1,46 @@
+(* Sorry, we have to disable this as this requires accepting
+   potentially badly formed programs (after expliciting) *)
+
+module Common0 =
+ struct
+   type msg = Msg
+
+   let handle_msg = ref (function _ -> failwith "Unable to handle message")
+   let extend_handle f =
+   let old = !handle_msg in
+   handle_msg := f old
+
+   let q : _ Queue.t = Queue.create ()
+   let add msg = Queue.add msg q
+   let handle_queue_messages () = Queue.iter !handle_msg q
+ end
+
+let q' : Common0.msg Queue.t = Common0.q
+
+module Common =
+ struct
+   type msg = ..
+
+   let handle_msg = ref (function _ -> failwith "Unable to handle message")
+   let extend_handle f =
+   let old = !handle_msg in
+   handle_msg := f old
+
+   let q : _ Queue.t = Queue.create ()
+   let add msg = Queue.add msg q
+   let handle_queue_messages () = Queue.iter !handle_msg q
+ end
+
+module M1 =
+ struct
+   type Common.msg += Reload of string | Alert of string
+
+   let handle fallback = function
+     Reload s -> print_endline ("Reload "^s)
+   | Alert s -> print_endline ("Alert "^s)
+   | x -> fallback x
+
+   let () = Common.extend_handle handle
+   let () = Common.add (Reload "config.file")
+   let () = Common.add (Alert "Initialisation done")
+ end

testsuite/tests/typing-modules-bugs/pr6752_ok.ml

@@ -1,3 +1,5 @@
+(* Adding a type annotation is sufficient to make typing go through *)
+
 module Common0 =
  struct
    type msg = Msg
@@ -7,7 +9,7 @@ module Common0 =
    let old = !handle_msg in
    handle_msg := f old
 
-   let q : _ Queue.t = Queue.create ()
+   let q : msg Queue.t = Queue.create ()
    let add msg = Queue.add msg q
    let handle_queue_messages () = Queue.iter !handle_msg q
  end
@@ -23,7 +25,7 @@ module Common =
    let old = !handle_msg in
    handle_msg := f old
 
-   let q : _ Queue.t = Queue.create ()
+   let q : msg Queue.t = Queue.create ()
    let add msg = Queue.add msg q
    let handle_queue_messages () = Queue.iter !handle_msg q
  end

typing/env.ml

@@ -1338,7 +1338,7 @@ let prefix_idents_and_subst root sub sg =
   pl, sub, lazy (subst_signature sub sg)
 
 let set_nongen_level sub path =
-  Subst.set_nongen_level sub (Path.binding_time path)
+  Subst.set_nongen_level sub (Path.binding_time path - 1)
 
 let prefix_idents_and_subst root sub sg =
   let sub = set_nongen_level sub root in