Merge pull request #9609 from gasche/unboxed-abstract-with-manifest

gasche · web-flow · commit 4088367fbcb2 · 2020-05-28T08:46:22.000+02:00
separability and with-constraints: fix for bug #9607
diff --git a/Changes b/Changes
@@ -123,7 +123,7 @@ OCaml 4.11
   For instance, "val f: #F(X).t -> unit" is now allowed.
   (Florian Angeletti, review by Gabriel Scherer, suggestion by Leo White)
 
-- MPR#7364, GPR#2188: improvement of the unboxability check for types
+- #7364, #2188, #9609: improvement of the unboxability check for types
   with a single constructor. Mutually-recursive type declarations can
   now contain unboxed types. This is based on the paper
     https://arxiv.org/abs/1811.02300
diff --git a/testsuite/tests/typing-unboxed/test.ml b/testsuite/tests/typing-unboxed/test.ml
@@ -468,3 +468,16 @@ external idub : iub -> iub = "%identity";;
 type iub = I of int [@@unboxed]
 external idub : iub -> iub = "%identity"
 |}];;
+
+(* #9607: separability was not computed on with-constraints *)
+module type T  = sig type 'k t end
+module M : T with type 'k t = string = struct
+  type 'k t = string
+end
+type t = T : 'k M.t -> t [@@unboxed]
+
+[%%expect{|
+module type T = sig type 'k t end
+module M : sig type 'k t = string end
+type t = T : 'k M.t -> t [@@unboxed]
+|}];;
diff --git a/testsuite/tests/typing-unboxed/test.ocaml.reference b/testsuite/tests/typing-unboxed/test.ocaml.reference
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
@@ -1440,15 +1440,40 @@ let transl_with_constraint env id row_path orig_decl sdecl =
   | Some ty -> raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl)))
   end;
   let decl = name_recursion sdecl id decl in
-  let type_variance =
+  let new_type_variance =
     try Typedecl_variance.compute_decl
           env ~check:true decl (Typedecl_variance.variance_of_sdecl sdecl)
     with Typedecl_variance.Error (loc, err) ->
       raise (Error (loc, Variance err)) in
-  let type_immediate =
+  let new_type_immediate =
     (* Typedecl_immediacy.compute_decl never raises *)
     Typedecl_immediacy.compute_decl env decl in
-  let decl = {decl with type_variance; type_immediate} in
+  let new_type_separability =
+    try Typedecl_separability.compute_decl env decl
+    with Typedecl_separability.Error (loc, err) ->
+      raise (Error (loc, Separability err)) in
+  let decl =
+    (* we intentionally write this without a fragile { decl with ... }
+       to ensure that people adding new fields to type declarations
+       consider whether they need to recompute it here; for an example
+       of bug caused by the previous approach, see #9607 *)
+    {
+      type_params = decl.type_params;
+      type_arity = decl.type_arity;
+      type_kind = decl.type_kind;
+      type_private = decl.type_private;
+      type_manifest = decl.type_manifest;
+      type_unboxed = decl.type_unboxed;
+      type_is_newtype = decl.type_is_newtype;
+      type_expansion_scope = decl.type_expansion_scope;
+      type_loc = decl.type_loc;
+      type_attributes = decl.type_attributes;
+      type_uid = decl.type_uid;
+
+      type_variance = new_type_variance;
+      type_immediate = new_type_immediate;
+      type_separability = new_type_separability;
+    } in
   Ctype.end_def();
   generalize_decl decl;
   {
