Merge pull request #365 from hhugo/constraint

Prevent printing just a type variable on one side of the clash (pr#7103)

Changes

@@ -487,6 +487,8 @@ Features wishes:
   (Hugo Heuzard)
 - GPR#308: add experimental support for NetBSD/arm (verified on RaspberryPi)
   (Rich Neswold)
+- GPR#365: prevent printing just a single type variable on one side
+  of a type error clash. (Hugo Heuzard)
 
 OCaml 4.02.3 (27 Jul 2015):
 ---------------------------

testsuite/tests/typing-gadts/pr5948.ml.reference

@@ -13,7 +13,8 @@ val intB : [< `TagB ] -> int = <fun>
                          ^^^^
 Error: This expression has type ([< `TagA of 'b ] as 'a) -> 'b
        but an expression was expected of type a -> int
-       Type 'a is not compatible with type a = [< `TagA of int | `TagB ] 
+       Type [< `TagA of 'b ] as 'a is not compatible with type
+         a = [< `TagA of int | `TagB ] 
        The first variant type does not allow tag(s) `TagB
 #     Characters 10-18:
   let _ =  example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *)

testsuite/tests/typing-misc/pr7103.ml

@@ -0,0 +1,14 @@
+type 'a t
+type a
+
+let f : < .. > t -> unit = fun _ -> ();;
+
+let g : [< `b] t -> unit = fun _ -> ();;
+
+let h : [> `b] t -> unit = fun _ -> ();;
+
+let _ = fun (x : a t) -> f x;;
+
+let _ = fun (x : a t) -> g x;;
+
+let _ = fun (x : a t) -> h x;;

testsuite/tests/typing-misc/pr7103.ml.reference

@@ -0,0 +1,25 @@
+
+#       type 'a t
+type a
+val f : < .. > t -> unit = <fun>
+#   val g : [< `b ] t -> unit = <fun>
+#   val h : [> `b ] t -> unit = <fun>
+#   Characters 28-29:
+  let _ = fun (x : a t) -> f x;;
+                             ^
+Error: This expression has type a t but an expression was expected of type
+         (< .. > as 'a) t
+       Type a is not compatible with type < .. > as 'a 
+#   Characters 28-29:
+  let _ = fun (x : a t) -> g x;;
+                             ^
+Error: This expression has type a t but an expression was expected of type
+         ([< `b ] as 'a) t
+       Type a is not compatible with type [< `b ] as 'a 
+#   Characters 28-29:
+  let _ = fun (x : a t) -> h x;;
+                             ^
+Error: This expression has type a t but an expression was expected of type
+         ([> `b ] as 'a) t
+       Type a is not compatible with type [> `b ] as 'a 
+# 

typing/printtyp.ml

@@ -1290,7 +1290,9 @@ let same_path t t' =
       false
 
 let type_expansion t ppf t' =
-  if same_path t t' then type_expr ppf t else
+  if same_path t t'
+  then begin add_delayed (proxy t); type_expr ppf t end
+  else
   let t' = if proxy t == proxy t' then unalias t' else t' in
   fprintf ppf "@[<2>%a@ =@ %a@]" type_expr t type_expr t'