add some tests, and disallow direct record field access on dicts

Author: zth

jscomp/build_tests/super_errors/expected/dict_pattern_inference_constrained.res.expected

@@ -0,0 +1,30 @@
+
+  Warning number 9
+  /.../fixtures/dict_pattern_inference_constrained.res:3:22-29
+
+  1 │ let foo = dict =>
+  2 │   switch dict {
+  3 │   | @res.dictPattern {one: 1} =>
+  4 │     let _: dict<string> = dict
+  5 │     Js.log("one")
+
+  the following labels are not bound in this record pattern: anyOtherField
+Either bind these labels explicitly or add ', _' to the pattern.
+
+
+  We've found a bug for you!
+  /.../fixtures/dict_pattern_inference_constrained.res:4:27-30
+
+  2 ┆ switch dict {
+  3 ┆ | @res.dictPattern {one: 1} =>
+  4 ┆   let _: dict<string> = dict
+  5 ┆   Js.log("one")
+  6 ┆ | _ => Js.log("not one")
+
+  This has type: dict<int>
+  But it's expected to have type: dict<string>
+  
+  The incompatible parts:
+    int vs string
+  
+  You can convert int to string with Belt.Int.toString.

jscomp/build_tests/super_errors/expected/dict_record_style_field_access.res.expected

@@ -0,0 +1,9 @@
+
+  We've found a bug for you!
+  /.../fixtures/dict_record_style_field_access.res:5:20-23
+
+  3 │ }
+  4 │ 
+  5 │ let x = stringDict.name
+
+  Direct field access on a dict is not supported. Use Dict.get instead.

jscomp/build_tests/super_errors/fixtures/dict_pattern_inference_constrained.res

@@ -0,0 +1,7 @@
+let foo = dict =>
+  switch dict {
+  | @res.dictPattern {one: 1} =>
+    let _: dict<string> = dict
+    Js.log("one")
+  | _ => Js.log("not one")
+  }

jscomp/build_tests/super_errors/fixtures/dict_record_style_field_access.res

@@ -0,0 +1,5 @@
+let stringDict = dict{
+  "name": "hello",
+}
+
+let x = stringDict.name

jscomp/ml/dicts.ml

@@ -2,4 +2,10 @@ let has_dict_pattern_attribute attrs =
   attrs
   |> List.find_opt (fun (({txt}, _) : Parsetree.attribute) ->
           txt = "res.dictPattern")
-  |> Option.is_some
+  |> Option.is_some
+
+let has_dict_attribute attrs =
+        attrs
+        |> List.find_opt (fun (({txt}, _) : Parsetree.attribute) ->
+                txt = "res.dict")
+        |> Option.is_some

jscomp/ml/predef.ml

@@ -221,17 +221,18 @@ let common_initial_env add_type add_extension empty_env =
   and decl_dict =
     let tvar = newgenvar() in
     {decl_abstr with
+      type_attributes = [(Location.mknoloc "res.dict", Parsetree.PStr [])];
       type_params = [tvar];
       type_arity = 1;
       type_variance = [Variance.full];
-      type_kind = 
-        Type_record ([
-          {ld_id = ident_anyOtherField;
+      type_kind = Type_record ([{
+          ld_id = ident_anyOtherField;
           ld_attributes = [(Location.mknoloc "res.optional", Parsetree.PStr [])];
           ld_loc = Location.none;
           ld_mutable = Immutable; (* TODO(dict-pattern-matching) Should probably be mutable? *) 
           ld_type = newgenty (Tconstr (path_option, [tvar], ref Mnil));
-          }], Record_optional_labels [Ident.name ident_anyOtherField]);
+        }], 
+        Record_optional_labels [Ident.name ident_anyOtherField]);
     }
   and decl_uncurried =
     let tvar1, tvar2 = newgenvar(), newgenvar() in

jscomp/ml/typecore.ml

@@ -75,6 +75,7 @@ type error =
   | Uncurried_arity_mismatch of type_expr * int * int
   | Field_not_optional of string * type_expr
   | Type_params_not_supported of Longident.t
+  | Field_access_on_dict_type
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
 
@@ -3013,8 +3014,12 @@ and type_label_access env srecord lid =
   let ty_exp = record.exp_type in
   let opath =
     try
-      let (p0, p, _, _) = extract_concrete_record env ty_exp in
-      Some(p0, p)
+      match extract_concrete_typedecl env ty_exp with
+      | (p0, _, {type_attributes}) 
+        when Path.same p0 Predef.path_dict && Dicts.has_dict_attribute type_attributes -> 
+          raise(Error(lid.loc, env, Field_access_on_dict_type))
+      | (p0, p, {type_kind=Type_record _}) -> Some(p0, p)
+      | _ -> None
     with Not_found -> None
   in
   let labels = Typetexp.find_all_labels env lid.loc lid.txt in
@@ -4131,6 +4136,8 @@ let report_error env ppf = function
       type_expr typ
   | Type_params_not_supported lid ->
     fprintf ppf "The type %a@ has type parameters, but type parameters is not supported here." longident lid
+  | Field_access_on_dict_type ->
+    fprintf ppf "Direct field access on a dict is not supported. Use Dict.get instead."
 
 
 let super_report_error_no_wrap_printing_env = report_error

jscomp/ml/typecore.mli

@@ -108,6 +108,7 @@ type error =
   | Uncurried_arity_mismatch of type_expr * int * int
   | Field_not_optional of string * type_expr
   | Type_params_not_supported of Longident.t
+  | Field_access_on_dict_type
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
 

jscomp/test/DictInference.res

@@ -2,3 +2,5 @@ let dict = Js.Dict.empty()
 dict->Js.Dict.set("someKey1", 1)
 dict->Js.Dict.set("someKey2", 2)
 let asArray = dict->Js.Dict.values
+
+let _: dict<int> = dict