Fix PR#6650: Cty_constr not handled correctly by Subst

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15574 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Changes

@@ -26,6 +26,7 @@ Type system:
 
 Bug fixes:
 - PR#6648: show_module should indicate its elision
+- PR#6650: Cty_constr not handled correctly by Subst
 
 OCaml 4.02.2:
 -------------

testsuite/tests/typing-modules/printing.ml

@@ -0,0 +1,14 @@
+(* PR#6650 *)
+
+module type S = sig
+  class type c = object method m : int end
+  module M : sig
+    class type d = c
+  end
+end;;
+module F (X : S) = X.M;;
+
+(* PR#6648 *)
+
+module M = struct module N = struct let x = 1 end end;;
+#show_module M;;

testsuite/tests/typing-modules/printing.ml.reference

@@ -0,0 +1,10 @@
+
+#               module type S =
+  sig
+    class type c = object method m : int end
+    module M : sig class type d = c end
+  end
+# module F : functor (X : S) -> sig class type d = X.c end
+#       module M : sig module N : sig val x : int end end
+# module M : sig module N : sig ... end end
+# 

typing/env.ml

@@ -1147,12 +1147,15 @@ let rec prefix_idents root pos sub = function
                       (Subst.add_modtype id (Mty_ident p) sub) rem in
       (p::pl, final_sub)
   | Sig_class(id, decl, _) :: rem ->
+      (* pretend this is a type, cf. PR#6650 *)
       let p = Pdot(root, Ident.name id, pos) in
-      let (pl, final_sub) = prefix_idents root (pos + 1) sub rem in
+      let (pl, final_sub) =
+        prefix_idents root (pos + 1) (Subst.add_type id p sub) rem in
       (p::pl, final_sub)
   | Sig_class_type(id, decl, _) :: rem ->
       let p = Pdot(root, Ident.name id, nopos) in
-      let (pl, final_sub) = prefix_idents root pos sub rem in
+      let (pl, final_sub) =
+        prefix_idents root pos (Subst.add_type id p sub) rem in
       (p::pl, final_sub)
 
 let subst_signature sub sg =

typing/subst.ml

@@ -333,8 +333,11 @@ let rec rename_bound_idents s idents = function
       let id' = Ident.rename id in
       rename_bound_idents (add_modtype id (Mty_ident(Pident id')) s)
                           (id' :: idents) sg
-  | (Sig_value(id, _) | Sig_typext(id, _, _) |
-     Sig_class(id, _, _) | Sig_class_type(id, _, _)) :: sg ->
+  | (Sig_class(id, _, _) | Sig_class_type(id, _, _)) :: sg ->
+      (* cheat and pretend they are types cf. PR#6650 *)
+      let id' = Ident.rename id in
+      rename_bound_idents (add_type id (Pident id') s) (id' :: idents) sg
+  | (Sig_value(id, _) | Sig_typext(id, _, _)) :: sg ->
       let id' = Ident.rename id in
       rename_bound_idents s (id' :: idents) sg