Module aliases save locks instead of walking them immediately (#3398)

testsuite/tests/templates/basic/bad_instance_wrong_mode.ml

@@ -2,4 +2,6 @@ let (f @ portable) () =
   let module Monoid_utils_of_list_monoid =
     Monoid_utils(Monoid)(List_monoid) [@jane.non_erasable.instances]
   in
+  (* module alias doesn't walk locks; using it does. *)
+  let _ = Monoid_utils_of_list_monoid.concat in
   ()

testsuite/tests/templates/basic/bad_instance_wrong_mode.reference

@@ -1,4 +1,4 @@
-File "bad_instance_wrong_mode.ml", line 3, characters 4-68:
-3 |     Monoid_utils(Monoid)(List_monoid) [@jane.non_erasable.instances]
-        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Modules are nonportable, so cannot be used inside a function that is portable.
+File "bad_instance_wrong_mode.ml", line 6, characters 10-44:
+6 |   let _ = Monoid_utils_of_list_monoid.concat in
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The value "Monoid_utils_of_list_monoid.concat" is nonportable, so cannot be used inside a function that is portable.

testsuite/tests/typing-modes/module.ml

@@ -1,4 +1,5 @@
 (* TEST
+    flags+="-extension mode_alpha";
    expect;
 *)
 
@@ -24,7 +25,7 @@ end
 val portable_use : 'a @ portable -> unit = <fun>
 module type S = sig val x : 'a -> unit end
 module type SL = sig type 'a t end
-module M : sig type 'a t = int val x : 'a -> unit end
+module M : sig type 'a t = int val x : 'a -> unit @@ portable end
 module F : functor (X : S) -> sig type t = int val x : 'a -> unit end
 |}]
 
@@ -180,3 +181,82 @@ val foo : unit -> unit = <fun>
 |}]
 
 (* Pmty_alias is not testable *)
+
+(* module alias *)
+module type S = sig
+    val foo : 'a -> 'a
+    val baz : 'a -> 'a @@ portable
+end
+
+module M : S = struct
+    let foo = fun x -> x
+    let baz = fun x -> x
+end
+[%%expect{|
+module type S = sig val foo : 'a -> 'a val baz : 'a -> 'a @@ portable end
+module M : S
+|}]
+
+let (bar @ portable) () =
+    let module N = M in
+    M.baz ();
+    N.baz ()
+[%%expect{|
+val bar : unit -> unit = <fun>
+|}]
+
+let (bar @ portable) () =
+    let module N = M in
+    N.foo ()
+[%%expect{|
+Line 3, characters 4-9:
+3 |     N.foo ()
+        ^^^^^
+Error: The value "N.foo" is nonportable, so cannot be used inside a function that is portable.
+|}]
+
+let (bar @ portable) () =
+    let module N = M in
+    M.foo ()
+[%%expect{|
+Line 3, characters 4-9:
+3 |     M.foo ()
+        ^^^^^
+Error: The value "M.foo" is nonportable, so cannot be used inside a function that is portable.
+|}]
+
+(* chained aliases. Creating alias of alias is fine. *)
+let (bar @ portable) () =
+    let module N = M in
+    let module N' = N in
+    M.baz ();
+    N.baz ();
+    N'.baz ()
+[%%expect{|
+val bar : unit -> unit = <fun>
+|}]
+
+(* locks are accumulated and not lost *)
+let (bar @ portable) () =
+    let module N = M in
+    let module N' = N in
+    N'.foo ()
+[%%expect{|
+Line 4, characters 4-10:
+4 |     N'.foo ()
+        ^^^^^^
+Error: The value "N'.foo" is nonportable, so cannot be used inside a function that is portable.
+|}]
+
+(* module aliases in structures still walk locks. *)
+let (bar @ portable) () =
+    let module N = struct
+        module L = M
+    end in
+    N.L.foo ()
+[%%expect{|
+Line 3, characters 19-20:
+3 |         module L = M
+                       ^
+Error: Modules are nonportable, so cannot be used inside a function that is portable.
+|}]

testsuite/tests/typing-modes/val_modalities.ml

@@ -900,3 +900,64 @@ let () =
   ()
 [%%expect{|
 |}]
+
+(* CR zqian: finer treatment of packing and unpacking *)
+module type Empty = sig end
+
+module type S = sig
+  val foo : 'a -> 'a
+  val baz : 'a -> 'a @@ portable
+end
+
+module M : S = struct
+  let foo = fun x -> x
+  let baz = fun x -> x
+end
+[%%expect{|
+module type Empty = sig end
+module type S = sig val foo : 'a -> 'a val baz : 'a -> 'a @@ portable end
+module M : S
+|}]
+
+let (bar @ portable) () =
+    let m = (module M : Empty) in
+    ()
+[%%expect{|
+Line 2, characters 20-21:
+2 |     let m = (module M : Empty) in
+                        ^
+Error: Modules are nonportable, so cannot be used inside a function that is portable.
+|}]
+
+let m = (module M : S)
+[%%expect{|
+val m : (module S) = <module>
+|}]
+
+let (bar @ portable) () =
+    let module M' = (val m : Empty) in
+    ()
+[%%expect{|
+Line 2, characters 25-26:
+2 |     let module M' = (val m : Empty) in
+                             ^
+Error: The value "m" is nonportable, so cannot be used inside a function that is portable.
+|}]
+
+(* CR zqian: this mode crossing should work *)
+module M : sig
+  val x : int
+end = struct
+  let x = 42
+end
+
+let (foo @ portable) () =
+  let _ = M.x in
+  ()
+[%%expect{|
+module M : sig val x : int end
+Line 8, characters 10-13:
+8 |   let _ = M.x in
+              ^^^
+Error: The value "M.x" is nonportable, so cannot be used inside a function that is portable.
+|}]