summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGabriel Scherer <gabriel.scherer@gmail.com>2020-01-30 08:41:20 +0100
committerGabriel Scherer <gabriel.scherer@gmail.com>2020-01-30 08:45:50 +0100
commitad60fa1760438c6d9a81d3e9361bcb52c5576f51 (patch)
treebddf794c95d0d18f47a405a82c77eee7c020aad6
parent84f62eee5d26efb936cde0e799b7aaa39e46c010 (diff)
downloadocaml-ad60fa1760438c6d9a81d3e9361bcb52c5576f51.tar.gz
Merge pull request #9269 from Octachron/fix_annot
#9218: wrong file name error with -annot and inline records (cherry picked from commit e1addb7962ab45b892eb9f1e36253f86609d314b)
-rw-r--r--Changes4
-rw-r--r--testsuite/tests/typing-multifile/pr9218.ml9
-rw-r--r--typing/env.ml7
-rw-r--r--typing/path.mli2
-rw-r--r--typing/printtyp.ml4
5 files changed, 20 insertions, 6 deletions
diff --git a/Changes b/Changes
index 48d7a4751f..c7541a7ae1 100644
--- a/Changes
+++ b/Changes
@@ -491,6 +491,10 @@ OCaml 4.10 release branch
(Kate Deplaix and David Allsopp, review by Sébastien Hinderer
and Gabriel Scherer )
+- #9218, #9269: avoid a rare wrong module name error with "-annot" and
+ inline records.
+ (Florian Angeletti, review by Gabriel Scherer, report by Kate Deplaix)
+
- #9261: Fix a soundness bug in Rec_check, new in 4.10 (from #8908)
(Vincent Laviron, review by Jeremy Yallop and Gabriel Scherer)
diff --git a/testsuite/tests/typing-multifile/pr9218.ml b/testsuite/tests/typing-multifile/pr9218.ml
new file mode 100644
index 0000000000..3c025aff37
--- /dev/null
+++ b/testsuite/tests/typing-multifile/pr9218.ml
@@ -0,0 +1,9 @@
+(* TEST
+ flags="-annot"
+ modules="a.ml"
+ *)
+
+(* Test interference between inline record path
+ [a.A] and the [a.ml] compilation unit *)
+type 'x a = A of { x: int }
+let v = A { x = 0 }
diff --git a/typing/env.ml b/typing/env.ml
index 203d3c8911..31e60414ba 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -1097,11 +1097,6 @@ let normalize_path_prefix oloc env path =
| Papply _ ->
assert false
-let is_uident s =
- match s.[0] with
- | 'A'..'Z' -> true
- | _ -> false
-
let normalize_type_path oloc env path =
(* Inlined version of Path.is_constructor_typath:
constructor type paths (i.e. path pointing to an inline
@@ -1112,7 +1107,7 @@ let normalize_type_path oloc env path =
path
| Pdot(p, s) ->
let p2 =
- if is_uident s && not (is_uident (Path.last p)) then
+ if Path.is_uident s && not (Path.is_uident (Path.last p)) then
(* Cstr M.t.C *)
normalize_path_prefix oloc env p
else
diff --git a/typing/path.mli b/typing/path.mli
index b008fabf3d..bddf9d670a 100644
--- a/typing/path.mli
+++ b/typing/path.mli
@@ -37,6 +37,8 @@ val heads: t -> Ident.t list
val last: t -> string
+val is_uident: string -> bool
+
type typath =
| Regular of t
| Ext of t * string
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index 83184b02b9..0c7821a7c2 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -394,6 +394,10 @@ let rec tree_of_path namespace = function
Oide_ident (ident_name namespace id)
| Pdot(_, s) as path when non_shadowed_pervasive path ->
Oide_ident (Naming_context.pervasives_name namespace s)
+ | Pdot(Pident t, s)
+ when namespace=Type && not (Path.is_uident (Ident.name t)) ->
+ (* [t.A]: inline record of the constructor [A] from type [t] *)
+ Oide_dot (Oide_ident (ident_name Type t), s)
| Pdot(p, s) ->
Oide_dot (tree_of_path Module p, s)
| Papply(p1, p2) ->