diff --git a/Changes b/Changes index 8f528a147..0ced687ee 100644 --- a/Changes +++ b/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): --------------------------- diff --git a/testsuite/tests/typing-gadts/pr5948.ml.reference b/testsuite/tests/typing-gadts/pr5948.ml.reference index 7d7742120..597cbfa62 100644 --- a/testsuite/tests/typing-gadts/pr5948.ml.reference +++ b/testsuite/tests/typing-gadts/pr5948.ml.reference @@ -13,7 +13,8 @@ val intB : [< `TagB ] -> int = ^^^^ 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 *) diff --git a/testsuite/tests/typing-misc/pr7103.ml b/testsuite/tests/typing-misc/pr7103.ml new file mode 100644 index 000000000..bdca4b343 --- /dev/null +++ b/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;; diff --git a/testsuite/tests/typing-misc/pr7103.ml.reference b/testsuite/tests/typing-misc/pr7103.ml.reference new file mode 100644 index 000000000..e74570636 --- /dev/null +++ b/testsuite/tests/typing-misc/pr7103.ml.reference @@ -0,0 +1,25 @@ + +# type 'a t +type a +val f : < .. > t -> unit = +# val g : [< `b ] t -> unit = +# val h : [> `b ] t -> unit = +# 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 +# diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 2a487e23f..7bc7c75c0 100644 --- a/typing/printtyp.ml +++ b/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'