Merge pull request #1130 from ocaml/initial-escape

Catch errors escaping from `Typemod.initial_env` for 4.08, 4.09 and 4.10
ocaml · Apr 14, 2020 · a9fc339 · a9fc339
2 parents 23fd5c1 + aa55cfc
commit a9fc339
Show file tree

Hide file tree

Showing 9 changed files with 63 additions and 7 deletions.
diff --git a/src/ocaml/typing/408/typemod.ml b/src/ocaml/typing/408/typemod.ml
@@ -158,7 +158,7 @@ let initial_env ~loc ~safe_string ~initially_opened_module
     let lid = {loc; txt = Longident.parse m } in
     try
       snd (type_open_ Override env lid.loc lid)
-    with Typetexp.Error _ as exn ->
+    with (Typetexp.Error _ | Magic_numbers.Cmi.Error _) as exn ->
       Msupport.raise_error exn;
       env
   in

diff --git a/src/ocaml/typing/409/persistent_env.ml b/src/ocaml/typing/409/persistent_env.ml
@@ -274,8 +274,8 @@ let check_pers_struct penv f1 f2 ~loc name =
   | Not_found ->
       let warn = Warnings.No_cmi_file(name, None) in
         Location.prerr_warning loc warn
-  | Cmi_format.Error err ->
-      let msg = Format.asprintf "%a" Cmi_format.report_error err in
+  | Magic_numbers.Cmi.Error err ->
+      let msg = Format.asprintf "%a" Magic_numbers.Cmi.report_error err in
       let warn = Warnings.No_cmi_file(name, Some msg) in
         Location.prerr_warning loc warn
   | Error err ->

diff --git a/src/ocaml/typing/409/typemod.ml b/src/ocaml/typing/409/typemod.ml
@@ -156,7 +156,7 @@ let initial_env ~loc ~safe_string ~initially_opened_module
     let lid = {loc; txt = Longident.parse m } in
     try
       snd (type_open_ Override env lid.loc lid)
-    with Typetexp.Error _ as exn ->
+    with (Typetexp.Error _ | Magic_numbers.Cmi.Error _) as exn ->
       Msupport.raise_error exn;
       env
   in

diff --git a/src/ocaml/typing/410/persistent_env.ml b/src/ocaml/typing/410/persistent_env.ml
@@ -273,8 +273,8 @@ let check_pers_struct penv f1 f2 ~loc name =
   | Not_found ->
       let warn = Warnings.No_cmi_file(name, None) in
         Location.prerr_warning loc warn
-  | Cmi_format.Error err ->
-      let msg = Format.asprintf "%a" Cmi_format.report_error err in
+  | Magic_numbers.Cmi.Error err ->
+      let msg = Format.asprintf "%a" Magic_numbers.Cmi.report_error err in
       let warn = Warnings.No_cmi_file(name, Some msg) in
         Location.prerr_warning loc warn
   | Error err ->

diff --git a/src/ocaml/typing/410/typemod.ml b/src/ocaml/typing/410/typemod.ml
@@ -152,7 +152,7 @@ let initial_env ~loc ~safe_string ~initially_opened_module
     try
       snd (type_open_ Override env lid.loc lid)
     with
-    | (Typetexp.Error _ | Env.Error _) as exn ->
+    | (Typetexp.Error _ | Env.Error _ | Magic_numbers.Cmi.Error _) as exn ->
       Msupport.raise_error exn;
       env
     | exn ->

diff --git a/tests/test-dirs/no-escape/foo.cmi b/tests/test-dirs/no-escape/foo.cmi
diff --git a/tests/test-dirs/no-escape/test.t b/tests/test-dirs/no-escape/test.t
@@ -307,3 +307,49 @@ And of course, it should never leak for other requests:
     ],
     "notifications": []
   }
+
+When typing the Test module, Merlin will try to load the Foo dependency.
+However foo.cmi is not a valid cmi file, we must make sure Merlin handle this
+properly (this should also cover the "wrong magic number" case).
+
+  $ $MERLIN single errors -filename test_use.ml < test_use.ml | \
+  > tr '\r\n' ' ' | jq ".value |= (map(del(.start.line) | del(.end.line)))"
+  {
+    "class": "return",
+    "value": [
+      {
+        "start": {
+          "col": -1
+        },
+        "end": {
+          "col": -1
+        },
+        "type": "typer",
+        "sub": [],
+        "valid": true,
+        "message": "Corrupted compiled interface tests/test-dirs/no-escape/foo.cmi"
+      }
+    ],
+    "notifications": []
+  }
+
+  $ $MERLIN single errors -filename test_open.ml -open Foo < test_open.ml | \
+  > tr '\r\n' ' ' | jq ".value |= (map(del(.start.line) | del(.end.line)))"
+  {
+    "class": "return",
+    "value": [
+      {
+        "start": {
+          "col": -1
+        },
+        "end": {
+          "col": -1
+        },
+        "type": "typer",
+        "sub": [],
+        "valid": true,
+        "message": "Corrupted compiled interface tests/test-dirs/no-escape/foo.cmi"
+      }
+    ],
+    "notifications": []
+  }
diff --git a/tests/test-dirs/no-escape/test_open.ml b/tests/test-dirs/no-escape/test_open.ml
@@ -0,0 +1,9 @@
+(* TODO or FIXME: If file is empty, Merlin just drops the errors
+   (errors are attached to typed top-level definitions,
+    if there are no definitions, errors cannot be attached!)
+
+   So here is a dummy definition.
+*)
+
+
+let () = print_string "Hello world"
diff --git a/tests/test-dirs/no-escape/test_use.ml b/tests/test-dirs/no-escape/test_use.ml
@@ -0,0 +1 @@
+open Foo