Allow implicit coercion on type with free variables (if subtyping does not unify variables).implicit-subtyping

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/implicit-subtyping@10902 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

3 files changed, 13 insertions, 8 deletions

diff --git a/typing/ctype.ml b/typing/ctype.ml
index 5d7c3ab971..ef12f17942 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -2235,10 +2235,10 @@ let rec rigidify_rec vars ty =
         iter_type_expr (rigidify_rec vars) ty
   end
 
-let rigidify ty =
+let rigidify tyl =
   let vars = ref [] in
-  rigidify_rec vars ty;
-  unmark_type ty;
+  List.iter (rigidify_rec vars) tyl;
+  List.iter unmark_type tyl;
   !vars
 
 let all_distinct_vars env vars =
@@ -2252,7 +2252,7 @@ let all_distinct_vars env vars =
 
 let matches env ty ty' =
   let snap = snapshot () in
-  let vars = rigidify ty in
+  let vars = rigidify [ty] in
   cleanup_abbrev ();
   let ok =
     try unify env ty ty'; all_distinct_vars env vars
diff --git a/typing/ctype.mli b/typing/ctype.mli
index af2c7fd0c2..5a1f676e4c 100644
--- a/typing/ctype.mli
+++ b/typing/ctype.mli
@@ -157,8 +157,8 @@ val filter_self_method:
 val moregeneral: Env.t -> bool -> type_expr -> type_expr -> bool
         (* Check if the first type scheme is more general than the second. *)
 
-val rigidify: type_expr -> type_expr list
-        (* "Rigidify" a type and return its type variable *)
+val rigidify: type_expr list -> type_expr list
+        (* "Rigidify" a list of types and return their type variables *)
 val all_distinct_vars: Env.t -> type_expr list -> bool
         (* Check those types are all distinct type variables *)
 val matches : Env.t -> type_expr -> type_expr -> bool
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 377a6d920e..b2dc494072 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -1741,11 +1741,16 @@ and type_argument env sarg ty_expected' =
       in
       let snap = Btype.snapshot () in
       begin try unify_exp env arg ty_expected
-      with Error _ when free_variables ~env arg.exp_type = []
-                     && free_variables ~env ty_expected = [] ->
+      with Error _ as exn ->
         Btype.backtrack snap;
         try
+          let vars = rigidify [arg.exp_type; ty_expected] in
           subtype env arg.exp_type ty_expected ();
+          if not (all_distinct_vars env vars) then
+            begin
+              Btype.backtrack snap;
+              raise exn
+            end;
           if not gen then
             Location.prerr_warning loc
               (Warnings.Not_principal "this implicit coercion");