From 54eef17aeecfdbc6eeecd60b9cc64cd7c0129429 Mon Sep 17 00:00:00 2001
From: Florian Angeletti <florian.angeletti@inria.fr>
Date: Wed, 20 Jul 2022 10:58:18 +0200
Subject: [PATCH 15/24] Do not elide the whole module type error message
(#11416)
(cherry picked from commit 8218be9e2b24907b8558776a34d12032bcc42496)
---
Changes | 5 +-
.../inclusion_errors_elision.ml | 93 +++++++++++++++++++
typing/includemod_errorprinter.ml | 11 ++-
3 files changed, 107 insertions(+), 2 deletions(-)
create mode 100644 testsuite/tests/typing-modules/inclusion_errors_elision.ml
diff --git a/Changes b/Changes
index a9a9ee92f4..6b9855f707 100644
--- a/Changes
+++ b/Changes
@@ -14,7 +14,10 @@ OCaml 4.14 maintenance branch
(David Allsopp and Nicolás Ojeda Bär, review by Nicolás Ojeda Bär and
Sebastien Hinderer)
-- #11358, #11378: Refactor the initialization of bytecode threading.
+- #11314, #11416: fix non-informative error message for module inclusion
+ (Florian Angeletti, report by Thierry Martinez, review by Gabriel Scherer)
+
+- #11358, #11379: Refactor the initialization of bytecode threading,
This avoids a "dangling pointer" warning of GCC 12.1.
(Xavier Leroy, report by Armaël Guéneau, review by Gabriel Scherer)
diff --git a/testsuite/tests/typing-modules/inclusion_errors_elision.ml b/testsuite/tests/typing-modules/inclusion_errors_elision.ml
new file mode 100644
index 0000000000..3dbd0e67ff
--- /dev/null
+++ b/testsuite/tests/typing-modules/inclusion_errors_elision.ml
@@ -0,0 +1,93 @@
+(* TEST
+ flags ="-keep-original-error-size"
+ * expect
+ *)
+
+
+module A = struct
+ type a and b and c and d
+end
+
+module type S = sig
+ module B = A
+end
+
+module C : S = struct
+ module B = struct
+ type a and b and c and d and e and f and g and h
+ end
+end
+[%%expect {|
+module A : sig type a and b and c and d end
+module type S = sig module B = A end
+Lines 9-13, characters 15-3:
+ 9 | ...............struct
+10 | module B = struct
+11 | type a and b and c and d and e and f and g and h
+12 | end
+13 | end
+Error: Signature mismatch:
+ ...
+ In module B:
+ Modules do not match:
+ sig
+ type a = B.a
+ and b = B.b
+ and c = B.c
+ and d = B.d
+ and e = B.e
+ and f = B.f
+ and g = B.g
+ and h = B.h
+ end
+ is not included in
+ (module A)
+|}]
+
+module A = struct
+ type a and b and c and d
+end
+
+module type S = sig
+ module type B = sig
+ module C = A
+ end
+end
+
+module D : S = struct
+ module type B = sig
+ module C: sig
+ type a and b and c and d and e and f and g and h
+ end
+ end
+end
+[%%expect{|
+module A : sig type a and b and c and d end
+module type S = sig module type B = sig module C = A end end
+Lines 11-17, characters 15-3:
+11 | ...............struct
+12 | module type B = sig
+13 | module C: sig
+14 | type a and b and c and d and e and f and g and h
+15 | end
+16 | end
+17 | end
+Error: Signature mismatch:
+ ...
+ ...
+ ...
+ At position module type B = sig module C : <here> end
+ Modules do not match:
+ sig
+ type a = C.a
+ and b = C.b
+ and c = C.c
+ and d = C.d
+ and e = C.e
+ and f = C.f
+ and g = C.g
+ and h = C.h
+ end
+ is not included in
+ (module A)
+|}]
diff --git a/typing/includemod_errorprinter.ml b/typing/includemod_errorprinter.ml
index 24d452fddc..b719e1627d 100644
--- a/typing/includemod_errorprinter.ml
+++ b/typing/includemod_errorprinter.ml
@@ -709,7 +709,16 @@ let rec module_type ~expansion_token ~eqmode ~env ~before ~ctx diff =
functor_params ~expansion_token ~env ~before ~ctx d
| _ ->
let inner = if eqmode then eq_module_types else module_types in
- let next = dwith_context_and_elision ctx inner diff in
+ let next =
+ match diff.symptom with
+ | Mt_core _ ->
+ (* In those cases, the refined error messages for the current error
+ will at most add some minor comments on the current error.
+ It is thus better to avoid eliding the current error message.
+ *)
+ dwith_context ctx (inner diff)
+ | _ -> dwith_context_and_elision ctx inner diff
+ in
let before = next :: before in
module_type_symptom ~eqmode ~expansion_token ~env ~before ~ctx
diff.symptom
--
2.37.0.rc2