fix rest of private type and analysis

Author: tsnobip

analysis/src/ProcessCmt.ml

@@ -512,8 +512,27 @@ let rec forStructureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
       | Tpat_tuple pats | Tpat_array pats | Tpat_construct (_, _, pats) ->
         pats |> List.iter (fun p -> handlePattern [] p)
       | Tpat_or (p, _, _) -> handlePattern [] p
-      | Tpat_record (items, _, _rest) ->
-        items |> List.iter (fun (_, _, p, _) -> handlePattern [] p)
+      | Tpat_record (record_items, _, rest) -> (
+        record_items |> List.iter (fun (_, _, p, _) -> handlePattern [] p);
+        match rest with
+        | None -> ()
+        | Some rest ->
+          let declared =
+            addDeclared ~name:rest.rest_name
+              ~stamp:(Ident.binding_time rest.rest_ident)
+              ~env ~extent:rest.rest_name.loc ~item:rest.rest_type []
+              (Exported.add exported Exported.Value)
+              Stamps.addValue
+          in
+          items :=
+            {
+              Module.kind = Module.Value declared.item;
+              name = declared.name.txt;
+              docstring = declared.docstring;
+              deprecated = declared.deprecated;
+              loc = declared.extentLoc;
+            }
+            :: !items)
       | Tpat_variant (_, Some p, _) -> handlePattern [] p
       | Tpat_variant (_, None, _) | Tpat_any | Tpat_constant _ -> ()
     in

analysis/src/ProcessExtra.ml

@@ -377,22 +377,32 @@ let pat ~(file : File.t) ~env ~extra (iter : Tast_iterator.iterator)
       | Tpackage (path, _, _) -> Some path
       | _ -> None
   in
-  let addForPattern stamp name =
+  let addForDeclaredPattern ~stamp ~name ~extent ~item ~attributes =
     if Stamps.findValue file.stamps stamp = None then (
       let declared =
         ProcessAttributes.newDeclared ~name ~stamp ~modulePath:NotVisible
-          ~extent:pattern.pat_loc ~item:pattern.pat_type false
-          pattern.pat_attributes
+          ~extent ~item false attributes
       in
       Stamps.addValue file.stamps stamp declared;
       addReference ~extra stamp name.loc;
       addLocItem extra name.loc
-        (Typed (name.txt, pattern.pat_type, Definition (stamp, Value))))
+        (Typed (name.txt, item, Definition (stamp, Value))))
+  in
+  let addForPattern stamp name =
+    addForDeclaredPattern ~stamp ~name ~extent:pattern.pat_loc
+      ~item:pattern.pat_type ~attributes:pattern.pat_attributes
   in
   (* Log.log("Entering pattern " ++ Utils.showLocation(pat_loc)); *)
   (match pattern.pat_desc with
-  | Tpat_record (items, _, _rest) ->
-    addForRecord ~env ~extra ~recordType:pattern.pat_type items
+  | Tpat_record (items, _, rest) -> (
+    addForRecord ~env ~extra ~recordType:pattern.pat_type items;
+    match rest with
+    | None -> ()
+    | Some rest ->
+      addForDeclaredPattern
+        ~stamp:(Ident.binding_time rest.rest_ident)
+        ~name:rest.rest_name ~extent:rest.rest_name.loc ~item:rest.rest_type
+        ~attributes:pattern.pat_attributes)
   | Tpat_construct (lident, constructor, _) ->
     addForConstructor ~env ~extra pattern.pat_type lident constructor
   | Tpat_alias (_inner, ident, name) -> (

compiler/ml/typecore.ml

@@ -1620,6 +1620,8 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
           let rest_type_expr =
             newgenty (Tconstr (rest_path, rest_type_args, ref Mnil))
           in
+          if rest_decl.type_private = Private then
+            raise (Error (rest_type_lid.loc, !env, Private_type rest_type_expr));
           List.iter2
             (fun param arg -> unify_pat_types rest_type_lid.loc !env param arg)
             rest_decl.type_params rest_type_args;
@@ -1753,6 +1755,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
           Some
             {
               Typedtree.rest_ident;
+              rest_name;
               rest_type = rest_type_expr;
               rest_path;
               rest_labels;

compiler/ml/typedtree.ml

@@ -37,6 +37,7 @@ type pattern = {
 
 and record_pat_rest = {
   rest_ident: Ident.t;
+  rest_name: string loc;
   rest_type: type_expr;
   rest_path: Path.t;
   rest_labels: Types.label_declaration list;
@@ -459,9 +460,7 @@ let rec bound_idents pat =
   | Tpat_record (_, _, Some rest) ->
     (* Rest ident is added via enter_variable during type checking,
        but we also need it in bound_idents for Lambda compilation *)
-    idents :=
-      (rest.rest_ident, Location.mknoloc (Ident.name rest.rest_ident))
-      :: !idents;
+    idents := (rest.rest_ident, rest.rest_name) :: !idents;
     iter_pattern_desc bound_idents pat.pat_desc
   | d -> iter_pattern_desc bound_idents d
 

compiler/ml/typedtree.mli

@@ -45,6 +45,7 @@ type pattern = {
 
 and record_pat_rest = {
   rest_ident: Ident.t;
+  rest_name: string loc;
   rest_type: type_expr;
   rest_path: Path.t;
   rest_labels: Types.label_declaration list;

tests/analysis_tests/tests/src/RecordRest.res

@@ -0,0 +1,9 @@
+type config = {name: string, version: string}
+type subConfig = {version: string}
+
+let getVersion = (config: config) =>
+  switch config {
+  | {name: _, ...subConfig as rest} =>
+    rest.version
+//  ^def
+  }

tests/analysis_tests/tests/src/expected/RecordRest.res.txt

@@ -0,0 +1,3 @@
+Definition src/RecordRest.res 6:4
+{"uri": "RecordRest.res", "range": {"start": {"line": 5, "character": 30}, "end": {"line": 5, "character": 34}}}
+

tests/build_tests/super_errors/expected/record_rest_private_type.res.expected

@@ -0,0 +1,10 @@
+
+  We've found a bug for you!
+  /.../fixtures/record_rest_private_type.res:9:12-14
+
+   7 │ type source = {a: int, b: string}
+   8 │ 
+   9 │ let {a, ...M.t as rest} = ({a: 1, b: "x"}: source)
+  10 │ 
+
+  Cannot create values of the private type M.t

tests/build_tests/super_errors/fixtures/record_rest_private_type.res

@@ -0,0 +1,9 @@
+module M: {
+  type t = private {b: string}
+} = {
+  type t = {b: string}
+}
+
+type source = {a: int, b: string}
+
+let {a, ...M.t as rest} = ({a: 1, b: "x"}: source)