diff --git a/testsuite/tests/typing-local/local.ml b/testsuite/tests/typing-local/local.ml index fdc4c506aaf..0a1b6f10d58 100644 --- a/testsuite/tests/typing-local/local.ml +++ b/testsuite/tests/typing-local/local.ml @@ -2573,3 +2573,39 @@ Line 3, characters 23-24: ^ Error: This value escapes its region |}] + + +(* 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 *) + +(* on construction of array, we ensure elements are global *) + +let f (local_ x : string) = + [|x; "foo"|] +[%%expect{| +Line 2, characters 4-5: +2 | [|x; "foo"|] + ^ +Error: This value escapes its region +|}] + +let f (x : string) = + [|x; "foo"|] +[%%expect{| +val f : string -> string array = +|}] + + +(* on pattern matching of array, + elements are strengthened to global + even if array itself is local *) +let f (local_ a : string array) = + match a with + | [| x; _ |] -> ref x + | _ -> ref "foo" + +[%%expect{| +val f : local_ string array -> string ref = +|}] \ No newline at end of file diff --git a/testsuite/tests/typing-local/nosyntax.ml b/testsuite/tests/typing-local/nosyntax.ml index 66c1fbff54f..3a6c23d0c98 100644 --- a/testsuite/tests/typing-local/nosyntax.ml +++ b/testsuite/tests/typing-local/nosyntax.ml @@ -28,7 +28,10 @@ let local_ref (f : lfn -> unit) = f (fun s -> let _ = [|s;s;s|] in 1) [%%expect{| -val local_ref : (lfn -> unit) -> unit = +Line 2, characters 24-25: +2 | f (fun s -> let _ = [|s;s;s|] in 1) + ^ +Error: This value escapes its region |}] type foo = { diff --git a/typing/typecore.ml b/typing/typecore.ml index 54a0cabfd72..e95372b2cb0 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -2250,7 +2250,8 @@ and type_pat_aux end | Ppat_array spl -> let ty_elt = solve_Ppat_array ~refine loc env expected_ty in - map_fold_cont (fun p -> type_pat Value p ty_elt) spl (fun pl -> + map_fold_cont (fun p -> type_pat ~alloc_mode:(simple_pat_mode Value_mode.global) + Value p ty_elt) spl (fun pl -> rvp k { pat_desc = Tpat_array pl; pat_loc = loc; pat_extra=[]; @@ -4152,7 +4153,7 @@ and type_expect_ let to_unify = Predef.type_array ty in with_explanation (fun () -> unify_exp_types loc env to_unify (generic_instance ty_expected)); - let argument_mode = mode_subcomponent expected_mode in + let argument_mode = mode_global in let argl = List.map (fun sarg -> type_expect env argument_mode sarg (mk_expected ty))