diff --git a/testsuite/tests/typing-local/local.ml b/testsuite/tests/typing-local/local.ml index 77e9ccd23b7..f708607dec1 100644 --- a/testsuite/tests/typing-local/local.ml +++ b/testsuite/tests/typing-local/local.ml @@ -1,4 +1,5 @@ (* TEST + flags = "-extension immutable_arrays" * expect *) let leak n = @@ -2509,38 +2510,98 @@ Line 3, characters 24-26: Error: This value escapes its region |}] +(* Test of array.*) -(* test of arrays *) -(* as elements of arrays are mutable *) -(* it is only safe for them to be at global mode *) -(* cf: similarly reference cell can contain only global values *) +(* Immutable arrays are like tuples or normal record: local array contains local +elements, both at construction and at projection; global array contains global +elements. *) -(* on construction of array, we ensure elements are global *) +(* constructing global iarray from local elements is rejected *) +let f (local_ x : string) = ref [: x; "foo" :] +[%%expect{| +Line 1, characters 35-36: +1 | let f (local_ x : string) = ref [: x; "foo" :] + ^ +Error: This value escapes its region +|}] + +(* constructing local iarray from local elements is fine *) +let f (local_ x : string) = local_ [:x; "foo":] +[%%expect{| +val f : local_ string -> local_ string iarray = +|}] + +(* constructing global iarray from global elements is fine *) +let f (x : string) = ref [:x; "foo":] +[%%expect{| +val f : string -> string iarray ref = +|}] -let f (local_ x : string) = - [|x; "foo"|] +(* projecting out of local array gives local elements *) +let f (local_ a : string iarray) = + match a with + | [: x; _ :] -> ref x + | _ -> ref "foo" [%%expect{| -Line 2, characters 4-5: -2 | [|x; "foo"|] - ^ +Line 3, characters 22-23: +3 | | [: x; _ :] -> ref x + ^ Error: This value escapes its region |}] -let f (x : string) = - [|x; "foo"|] +(* a test that was passing type check *) +let unsafe_globalize (local_ s : string) : string = + match local_ [:s:] with + | [:s':] -> s' + | _ -> assert false +[%%expect{| +Line 3, characters 14-16: +3 | | [:s':] -> s' + ^^ +Error: This local value escapes its region + Hint: Cannot return local value without an explicit "local_" annotation +|}] + +let f (local_ a : string iarray) = + match a with + | [: x; _ :] -> x + | _ -> "foo" +[%%expect{| +val f : local_ string iarray -> local_ string = +|}] + +(* projecting out of global iarray gives global elements *) +let f (a : string iarray) = + match a with + | [: x :] -> ref x + | _ -> ref "foo" +[%%expect{| +val f : string iarray -> string ref = +|}] + +(* Mutable array, like references, is dangerous. They must contain global + elements regardless of the array's mode. *) + +(* constructing local array from local elements is rejected *) +let f (local_ x : string) = local_ [| x |] [%%expect{| -val f : string -> string array = +Line 1, characters 38-39: +1 | let f (local_ x : string) = local_ [| x |] + ^ +Error: This value escapes its region |}] +(* constructing local array from global elements is allowed *) +let f (x : string) = local_ [| x |] +[%%expect{| +val f : string -> local_ string array = +|}] -(* on pattern matching of array, - elements are strengthened to global - even if array itself is local *) +(* projecting out of local array gives global elements *) let f (local_ a : string array) = match a with - | [| x; _ |] -> ref x + | [| x |] -> ref x | _ -> ref "foo" - [%%expect{| val f : local_ string array -> string ref = |}] diff --git a/typing/typecore.ml b/typing/typecore.ml index e823ceeecec..8209061ae4c 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -2275,14 +2275,19 @@ and type_pat_aux shouldn't be too bad. We can inline this when we upstream this code and combine the two array pattern constructors. *) let ty_elt = solve_Ppat_array ~refine loc env mutability expected_ty in - map_fold_cont (fun p -> type_pat ~alloc_mode:(simple_pat_mode Value_mode.global) - tps Value p ty_elt) spl (fun pl -> - rvp k { - pat_desc = Tpat_array (mutability, pl); - pat_loc = loc; pat_extra=[]; - pat_type = instance expected_ty; - pat_attributes; - pat_env = !env }) + map_fold_cont (fun p -> + let alloc_mode = + match mutability with + | Mutable -> simple_pat_mode Value_mode.global + | Immutable -> alloc_mode + in + type_pat ~alloc_mode tps Value p ty_elt) spl (fun pl -> + rvp k { + pat_desc = Tpat_array (mutability, pl); + pat_loc = loc; pat_extra=[]; + pat_type = instance expected_ty; + pat_attributes; + pat_env = !env }) in match Jane_syntax.Pattern.of_ast sp with | Some (jpat, attrs) -> begin