From 7849115b075308168eafc18913652e0dc458a19a Mon Sep 17 00:00:00 2001
From: Antal Spector-Zabusky <antal.b.sz@gmail.com>
Date: Fri, 4 Jun 2021 18:59:57 -0400
Subject: [PATCH] Bug fix: `equal_private` was being used in too many places

`equal_private` should only be used when checking inclusion for
private *type abbreviations*, but was being used incorrectly for
private data types and private row types as well.
---
 typing/includecore.ml | 34 ++++++++++++++++++++++++----------
 1 file changed, 24 insertions(+), 10 deletions(-)

diff --git a/typing/includecore.ml b/typing/includecore.ml
index df6a51309..61ddad5dc 100644
--- a/typing/includecore.ml
+++ b/typing/includecore.ml
@@ -516,7 +516,7 @@ let private_object env fields1 params1 fields2 params2 =
     | () -> None
   end
 
-let type_manifest env ty1 params1 ty2 params2 priv2 =
+let type_manifest env ty1 params1 ty2 params2 priv2 kind2 =
   let ty1' = Ctype.expand_head env ty1 and ty2' = Ctype.expand_head env ty2 in
   match ty1'.desc, ty2'.desc with
   | Tvariant row1, Tvariant row2
@@ -537,14 +537,28 @@ let type_manifest env ty1 params1 ty2 params2 priv2 =
       | Some err -> Some (Private_object(ty1, ty2, err))
     end
   | _ -> begin
-    match
-      match priv2 with
-      | Private -> Ctype.equal_private env params1 ty1 params2 ty2
-      | Public -> Ctype.equal env true (params1 @ [ty1]) (params2 @ [ty2])
-    with
-    | exception Ctype.Equality trace -> Some (Manifest (env, trace))
-    | () -> None
-  end
+      let is_private_abbrev_2 =
+        match priv2, kind2 with
+        | Private, Type_abstract -> begin
+            (* Same checks as the [when] guards from above, inverted *)
+            match ty2'.desc with
+            | Tvariant row ->
+                not (is_absrow env (Btype.row_more row))
+            | Tobject (fi, _) ->
+                not (is_absrow env (snd (Ctype.flatten_fields fi)))
+            | _ -> true
+          end
+        | _, _ -> false
+      in
+      match
+        if is_private_abbrev_2 then
+          Ctype.equal_private env params1 ty1 params2 ty2
+        else
+          Ctype.equal env true (params1 @ [ty1]) (params2 @ [ty2])
+      with
+      | exception Ctype.Equality err -> Some (Manifest(env,err))
+      | () -> None
+    end
 
 let type_declarations ?(equality = false) ~loc env ~mark name
       decl1 path decl2 =
@@ -565,7 +579,7 @@ let type_declarations ?(equality = false) ~loc env ~mark name
         end
     | (Some ty1, Some ty2) ->
          type_manifest env ty1 decl1.type_params ty2 decl2.type_params
-           decl2.type_private
+           decl2.type_private decl2.type_kind
     | (None, Some ty2) ->
         let ty1 =
           Btype.newgenty (Tconstr(path, decl2.type_params, ref Mnil))
-- 
2.39.0.windows.2

