Extend `open` to arbritrary module expressions in structures and to

applicative module paths in signatures

8 files changed, 221 insertions, 2 deletions

diff --git a/testsuite/tests/generalized-open/accepted_batch.ml b/testsuite/tests/generalized-open/accepted_batch.ml
new file mode 100644
index 0000000000..7c82a76c89
--- /dev/null
+++ b/testsuite/tests/generalized-open/accepted_batch.ml
@@ -0,0 +1,34 @@
+(* TEST *)
+
+open Set.Make(String)
+
+let e = empty
+
+open struct
+  let x = singleton "hidden"
+end
+
+let () = iter print_endline (union x (of_list ["a"; "b"]))
+
+let f =
+  let open Set.Make(Int32) in
+  let e2 = empty in
+  let open struct
+    let y = 3
+  end in
+  (e, e2, y)
+
+module type S = sig
+  open Set.Make(Bool)
+
+  type nonrec t = t
+end
+
+let hd _ = ()
+
+open (List : sig val map : ('a -> 'b) -> 'a list -> 'b list end)
+
+let l =
+  hd (map succ [0; 1; 2; 3])
+
+let y = map succ []
diff --git a/testsuite/tests/generalized-open/accepted_batch.reference b/testsuite/tests/generalized-open/accepted_batch.reference
new file mode 100644
index 0000000000..9c2240259e
--- /dev/null
+++ b/testsuite/tests/generalized-open/accepted_batch.reference
@@ -0,0 +1,3 @@
+a
+b
+hidden
diff --git a/testsuite/tests/generalized-open/accepted_expect.ml b/testsuite/tests/generalized-open/accepted_expect.ml
new file mode 100644
index 0000000000..ba526cb8b6
--- /dev/null
+++ b/testsuite/tests/generalized-open/accepted_expect.ml
@@ -0,0 +1,63 @@
+(* TEST
+   * expect
+*)
+
+open Set.Make(String);;
+[%%expect{|
+|}]
+
+let e = empty;;
+[%%expect{|
+val e : t = <abstr>
+|}]
+
+open struct
+  let x = singleton "hidden"
+end;;
+[%%expect{|
+|}];;
+
+elements (union x (of_list ["a"; "b"]));;
+[%%expect{|
+- : elt list = ["a"; "b"; "hidden"]
+|}]
+
+let f =
+  let open Set.Make(Int32) in
+  let e2 = empty in
+  let open struct
+    let y = 3
+  end in
+  (e, e2, y);;
+[%%expect{|
+val f : t * Set.Make(Int32).t * int = (<abstr>, <abstr>, 3)
+|}]
+
+module type S = sig
+  open Set.Make(Bool)
+
+  type nonrec t = t
+end;;
+[%%expect{|
+module type S = sig type nonrec t = Set.Make(Bool).t end
+|}]
+
+let hd _ = ();;
+[%%expect{|
+val hd : 'a -> unit = <fun>
+|}]
+
+open (List : sig val map : ('a -> 'b) -> 'a list -> 'b list end);;
+[%%expect{|
+|}]
+
+let l = map succ [0;1;2;3]
+let () = hd l;;
+[%%expect{|
+val l : int list = [1; 2; 3; 4]
+|}]
+
+let y = map succ [];;
+[%%expect{|
+val y : int list = []
+|}]
diff --git a/testsuite/tests/generalized-open/funct_body.compilers.reference b/testsuite/tests/generalized-open/funct_body.compilers.reference
new file mode 100644
index 0000000000..316b98a6ec
--- /dev/null
+++ b/testsuite/tests/generalized-open/funct_body.compilers.reference
@@ -0,0 +1,5 @@
+File "funct_body.ml", line 30, characters 12-20:
+30 |     include (val !r)
+                 ^^^^^^^^
+Error: This expression creates fresh types.
+       It is not allowed inside applicative functors.
diff --git a/testsuite/tests/generalized-open/funct_body.ml b/testsuite/tests/generalized-open/funct_body.ml
new file mode 100644
index 0000000000..4490f77392
--- /dev/null
+++ b/testsuite/tests/generalized-open/funct_body.ml
@@ -0,0 +1,47 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "2"
+** check-ocamlc.byte-output
+*)
+
+module type T = sig
+  type t
+  val x : t
+  val f : t -> unit
+end
+
+module Int = struct
+  type t = int
+  let x = 42
+  let f = print_int
+end
+
+module String = struct
+  type t = string
+  let x = "Forty Two"
+  let f = print_endline
+end
+
+let r = ref (module Int : T)
+
+module F (X : sig end) = struct
+  open struct
+    include (val !r)
+  end
+  type s = t
+  let x : s = x
+  let f : s -> unit = f
+end
+
+module M = struct end
+
+module N = F(M)
+
+let () =
+  r := (module String : T)
+
+module O = F(M)
+
+let () =
+  O.f N.x
diff --git a/testsuite/tests/generalized-open/ocamltests b/testsuite/tests/generalized-open/ocamltests
new file mode 100644
index 0000000000..ea47985d22
--- /dev/null
+++ b/testsuite/tests/generalized-open/ocamltests
@@ -0,0 +1,4 @@
+accepted_batch.ml
+accepted_expect.ml
+funct_body.ml
+shadowing.ml
diff --git a/testsuite/tests/generalized-open/shadowing.ml b/testsuite/tests/generalized-open/shadowing.ml
new file mode 100644
index 0000000000..589807d367
--- /dev/null
+++ b/testsuite/tests/generalized-open/shadowing.ml
@@ -0,0 +1,59 @@
+(* TEST
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+ocamlc_byte_exit_status = "0"
+** check-ocamlc.byte-output
+*)
+
+module Make_sure_val : sig
+  val x : int
+end = struct
+  let x = 3
+
+  open struct
+    let x = 'c'
+  end
+end
+
+type t = A
+
+open struct
+  type t = B
+end
+
+type ext = ..
+
+module Make_sure_ec : sig
+  type ext += C of int
+end = struct
+  type ext += C of int
+
+  open struct
+    type ext += D of char
+  end
+end
+
+
+module M = struct type t = int end
+
+open struct
+  module M = struct type u = char end
+end
+
+module type S = sig type t = int end
+
+open struct
+  module type S = sig type u = char end
+end
+
+class c = object method x = 3 end
+
+open struct
+  class c = object method y = 'c' end
+end
+
+class type ct = object method x : int end
+
+open struct
+  class type ct = object method y : int end
+end
diff --git a/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference b/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference
index ccaa11c219..414aa824e1 100644
--- a/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference
+++ b/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference
@@ -56,7 +56,9 @@
                           expression (shortcut_ext_attr.ml[13,261+3]..[13,261+29])
                             attribute "foo"
                               []
-                            Pexp_open Fresh ""M" (shortcut_ext_attr.ml[13,261+22]..[13,261+23])"
+                            Pexp_open Fresh
+                            module_expr (shortcut_ext_attr.ml[13,261+22]..[13,261+23])
+                              Pmod_ident "M" (shortcut_ext_attr.ml[13,261+22]..[13,261+23])
                             expression (shortcut_ext_attr.ml[13,261+27]..[13,261+29])
                               Pexp_construct "()" (shortcut_ext_attr.ml[13,261+27]..[13,261+29])
                               None
@@ -758,7 +760,9 @@
     Pstr_extension "foo"
     [
       structure_item (shortcut_ext_attr.ml[94,1905+0]..[94,1905+16])
-        Pstr_open Fresh "M" (shortcut_ext_attr.ml[94,1905+15]..[94,1905+16])
+        Pstr_open Fresh
+        module_expr (shortcut_ext_attr.ml[94,1905+15]..[94,1905+16])
+          Pmod_ident "M" (shortcut_ext_attr.ml[94,1905+15]..[94,1905+16])
           attribute "foo"
             []
     ]