Register all classes defs but only non-row types

Update the test suite
ocaml · Nov 3, 2021 · fd1878b · fd1878b
1 parent 80d4c6d
commit fd1878b
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 5 deletions.
diff --git a/testsuite/tests/shapes/simple.ml b/testsuite/tests/shapes/simple.ml
@@ -115,14 +115,19 @@ and M2 : sig type t val x : t end
 class c = object end
 [%%expect{|
 {
+ ("#c", type) -> <.32>;
+ ("c", type) -> <.32>;
  ("c", class) -> <.32>;
+ ("c", class type) -> <.32>;
  }
 class c : object  end
 |}]
 
 class type c = object end
 [%%expect{|
 {
+ ("#c", type) -> <.34>;
+ ("c", type) -> <.34>;
  ("c", class type) -> <.34>;
  }
 class type c = object  end

diff --git a/typing/typemod.ml b/typing/typemod.ml
@@ -2493,8 +2493,10 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr =
         let shape_map = List.fold_left
           (fun shape_map -> function
             | Sig_type (id, vd, _, _) ->
-              Env.register_uid vd.type_uid vd.type_loc;
-              Shape.Map.add_type shape_map id vd.type_uid
+              if not (Btype.is_row_name (Ident.name id)) then begin
+                Env.register_uid vd.type_uid vd.type_loc;
+                Shape.Map.add_type shape_map id vd.type_uid
+              end else shape_map
             | _ -> assert false
           )
           shape_map
@@ -2700,7 +2702,11 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr =
             Signature_names.check_type names loc cls.cls_obj_id;
             Signature_names.check_type names loc cls.cls_typesharp_id;
             Env.register_uid cls.cls_decl.cty_uid loc;
-            Shape.Map.add_class acc cls.cls_id cls.cls_decl.cty_uid
+            let map f id acc = f acc id cls.cls_decl.cty_uid in
+            map Shape.Map.add_class cls.cls_id acc
+            |> map Shape.Map.add_class_type cls.cls_ty_id
+            |> map Shape.Map.add_type cls.cls_obj_id
+            |> map Shape.Map.add_type cls.cls_typesharp_id
           ) shape_map classes
         in
         Tstr_class
@@ -2727,8 +2733,10 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr =
             Signature_names.check_type names loc decl.clsty_obj_id;
             Signature_names.check_type names loc decl.clsty_typesharp_id;
             Env.register_uid decl.clsty_ty_decl.clty_uid loc;
-            Shape.Map.add_class_type
-              acc decl.clsty_ty_id decl.clsty_ty_decl.clty_uid
+            let map f id acc = f acc id decl.clsty_ty_decl.clty_uid in
+            map Shape.Map.add_class_type decl.clsty_ty_id acc
+            |> map Shape.Map.add_type decl.clsty_obj_id
+            |> map Shape.Map.add_type decl.clsty_typesharp_id
           ) shape_map classes
         in
         Tstr_class_type