Fix issue #1704 by correctly registering erroneous types

Co-authored-by: Thomas Refis <[email protected]>
ocaml · Nov 21, 2023 · c05f3a3 · c05f3a3
1 parent 81a05bd
commit c05f3a3
Show file tree

Hide file tree

Showing 3 changed files with 8 additions and 49 deletions.
diff --git a/src/ocaml/typing/typedecl.ml b/src/ocaml/typing/typedecl.ml
@@ -957,7 +957,9 @@ let transl_type_decl env rec_flag sdecl_list =
     (fun sdecl tdecl ->
       let decl = tdecl.typ_type in
        match Ctype.closed_type_decl decl with
-         Some ty -> raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl)))
+         Some ty ->
+          if not (Msupport.erroneous_type_check ty) then
+            raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl)))
        | None   -> ())
     sdecl_list tdecls;
   (* Check that constraints are enforced *)

diff --git a/src/ocaml/typing/typetexp.ml b/src/ocaml/typing/typetexp.ml
@@ -190,13 +190,15 @@ type policy = Fixed | Extensible | Univars
 let rec transl_type env policy styp =
   Msupport.with_saved_types
     ~warning_attribute:styp.ptyp_attributes ?save_part:None
-    (fun () -> 
+    (fun () ->
        try
          transl_type_aux env policy styp
        with exn ->
+         let ty = new_global_var () in
+         Msupport.erroneous_type_register ty;
          Msupport.raise_error exn;
            { ctyp_desc = Ttyp_any;
-             ctyp_type = new_global_var ();
+             ctyp_type = ty;
              ctyp_env = env;
              ctyp_loc = styp.ptyp_loc;
              ctyp_attributes = [];

diff --git a/tests/test-dirs/errors/issue1704-wrong-message.t b/tests/test-dirs/errors/issue1704-wrong-message.t
@@ -6,27 +6,12 @@
   > type foo3 = bar
   > EOF
 
-FIXME:Merlin should not report unbound variable errors in that case since it is
+Merlin should not report unbound variable errors in that case since it is
 due to it's own type recovery.
   $ $MERLIN single errors -filename test.ml <test.ml 
   {
     "class": "return",
     "value": [
-      {
-        "start": {
-          "line": 1,
-          "col": 0
-        },
-        "end": {
-          "line": 3,
-          "col": 1
-        },
-        "type": "typer",
-        "sub": [],
-        "valid": true,
-        "message": "A type variable is unbound in this type declaration.
-  In field bar: 'a the variable 'a is unbound"
-      },
       {
         "start": {
           "line": 2,
@@ -41,21 +26,6 @@ due to it's own type recovery.
         "valid": true,
         "message": "Unbound module X"
       },
-      {
-        "start": {
-          "line": 4,
-          "col": 0
-        },
-        "end": {
-          "line": 4,
-          "col": 15
-        },
-        "type": "typer",
-        "sub": [],
-        "valid": true,
-        "message": "A type variable is unbound in this type declaration.
-  In type 'a the variable 'a is unbound"
-      },
       {
         "start": {
           "line": 4,
@@ -70,21 +40,6 @@ due to it's own type recovery.
         "valid": true,
         "message": "Unbound module X"
       },
-      {
-        "start": {
-          "line": 5,
-          "col": 0
-        },
-        "end": {
-          "line": 5,
-          "col": 15
-        },
-        "type": "typer",
-        "sub": [],
-        "valid": true,
-        "message": "A type variable is unbound in this type declaration.
-  In type 'a the variable 'a is unbound"
-      },
       {
         "start": {
           "line": 5,