diff options
author | Gabriel Scherer <gabriel.scherer@gmail.com> | 2020-01-30 08:41:20 +0100 |
---|---|---|
committer | Gabriel Scherer <gabriel.scherer@gmail.com> | 2020-01-30 08:45:50 +0100 |
commit | ad60fa1760438c6d9a81d3e9361bcb52c5576f51 (patch) | |
tree | bddf794c95d0d18f47a405a82c77eee7c020aad6 | |
parent | 84f62eee5d26efb936cde0e799b7aaa39e46c010 (diff) | |
download | ocaml-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-- | Changes | 4 | ||||
-rw-r--r-- | testsuite/tests/typing-multifile/pr9218.ml | 9 | ||||
-rw-r--r-- | typing/env.ml | 7 | ||||
-rw-r--r-- | typing/path.mli | 2 | ||||
-rw-r--r-- | typing/printtyp.ml | 4 |
5 files changed, 20 insertions, 6 deletions
@@ -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) -> |