diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2013-11-18 01:26:40 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2013-11-18 01:26:40 +0000 |
| commit | 2a011d7095718efd9314ac12307aa7835bf67889 (patch) | |
| tree | 9828359d92839dc73f078e0125a8e95ed1c6e4ba | |
| parent | df7e6c1ded6334937227fa1046102a79bc0f6a18 (diff) | |
| download | ocaml-2a011d7095718efd9314ac12307aa7835bf67889.tar.gz | |
Fix PR#6240
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14299 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | Changes | 2 | ||||
| -rw-r--r-- | testsuite/tests/typing-modules-bugs/pr6240_ok.ml | 11 | ||||
| -rw-r--r-- | typing/includemod.ml | 10 |
3 files changed, 19 insertions, 4 deletions
@@ -64,7 +64,7 @@ Bug fixes: - PR#6174: OCaml compiler loops on an example using GADTs (non -rectypes) - PR#6216: inlining of GADT matches generates invalid assembly - PR#6235: Issue with type information flowing through a variant pattern - +- PR#6240: Fail to expand module type abbreviation during substyping OCaml 4.01.0: ------------- diff --git a/testsuite/tests/typing-modules-bugs/pr6240_ok.ml b/testsuite/tests/typing-modules-bugs/pr6240_ok.ml new file mode 100644 index 0000000000..de1754aa05 --- /dev/null +++ b/testsuite/tests/typing-modules-bugs/pr6240_ok.ml @@ -0,0 +1,11 @@ +module M : sig + module type T + module F (X : T) : sig end +end = struct + module type T = sig end + module F (X : T) = struct end +end + +module type T = M.T + +module F : functor (X : T) -> sig end = M.F diff --git a/typing/includemod.ml b/typing/includemod.ml index 302890ed28..11caabe2f6 100644 --- a/typing/includemod.ml +++ b/typing/includemod.ml @@ -94,6 +94,10 @@ let class_declarations env cxt subst id decl1 decl2 = exception Dont_match +let may_expand_module_path env path = + try ignore (Env.find_modtype_expansion path env); true + with Not_found -> false + let expand_module_path env cxt path = try Env.find_modtype_expansion path env @@ -158,10 +162,10 @@ let rec modtypes env cxt subst mty1 mty2 = and try_modtypes env cxt subst mty1 mty2 = match (mty1, mty2) with - (_, Mty_ident p2) -> - try_modtypes2 env cxt mty1 (Subst.modtype subst mty2) - | (Mty_ident p1, _) -> + (Mty_ident p1, _) when may_expand_module_path env p1 -> try_modtypes env cxt subst (expand_module_path env cxt p1) mty2 + | (_, Mty_ident p2) -> + try_modtypes2 env cxt mty1 (Subst.modtype subst mty2) | (Mty_signature sig1, Mty_signature sig2) -> signatures env cxt subst sig1 sig2 | (Mty_functor(param1, arg1, res1), Mty_functor(param2, arg2, res2)) -> |