diff options
| author | Florian Angeletti <florian.angeletti@inria.fr> | 2020-08-28 09:43:23 +0200 |
|---|---|---|
| committer | Florian Angeletti <florian.angeletti@inria.fr> | 2020-09-03 13:55:17 +0200 |
| commit | ce04a5c1b16b58ae50529c4c58f4a305e4a23424 (patch) | |
| tree | 8d2b33f334487eaa456a1eb19cd748dd2c924a64 | |
| parent | 66c368ae7746296285aa5d9498b1beefd7afc3a7 (diff) | |
| download | ocaml-ce04a5c1b16b58ae50529c4c58f4a305e4a23424.tar.gz | |
Merge pull request #9862 from Octachron/4.11.1_with_less_daring_assertions
9859: revert 9348, inferred function types and :>
(cherry picked from commit 28b82e2e397d129840e35fb8da0b8af8b9f59633)
| -rw-r--r-- | Changes | 4 | ||||
| -rw-r--r-- | testsuite/tests/typing-misc/labels.ml | 29 | ||||
| -rw-r--r-- | typing/ctype.ml | 3 |
3 files changed, 34 insertions, 2 deletions
@@ -416,6 +416,10 @@ OCaml 4.11.1 weak polymorphic variables. (Leo White, review by Jacques Garrigue) +- #9859, #9862: Remove an erroneous assertion when inferred function types + appear in the right hand side of an explicit :> coercion + (Florian Angeletti, review by Thomas Refis) + OCaml 4.11.0 (19 August 2020) --------------------------- diff --git a/testsuite/tests/typing-misc/labels.ml b/testsuite/tests/typing-misc/labels.ml index 3a00e3846a..3b2d32b8e5 100644 --- a/testsuite/tests/typing-misc/labels.ml +++ b/testsuite/tests/typing-misc/labels.ml @@ -90,3 +90,32 @@ Line 1, characters 45-46: Warning 19 [non-principal-labels]: commuted an argument without principality. val f : (x:int -> unit -> int) -> x:int -> int = <fun> |}];; + +(* 9859: inferred function types may appear in the right hand side of :> *) +class setup = object + method with_ f = (f 0:unit) +end +class virtual fail = object (self) + method trigger = (self :> setup ) +end +[%%expect {| +class setup : object method with_ : (int -> unit) -> unit end +class virtual fail : + object + method trigger : setup + method virtual with_ : (int -> unit) -> unit + end +|}] + +module type T = sig type t end +let type_of (type x) (x: x) = (module struct type t = x end: T with type t = x) +let f g = 1 + g ~x:0 ~y:0;; +module E = (val type_of f) +let g = ( (fun _ -> f) :> 'a -> E.t) +[%%expect {| +module type T = sig type t end +val type_of : 'x -> (module T with type t = 'x) = <fun> +val f : (x:int -> y:int -> int) -> int = <fun> +module E : sig type t = (x:int -> y:int -> int) -> int end +val g : 'a -> E.t = <fun> +|}] diff --git a/typing/ctype.ml b/typing/ctype.ml index eb8011b763..5b1c259799 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -4055,8 +4055,7 @@ let rec build_subtype env visited loops posi level t = (t, Unchanged) else (t, Unchanged) - | Tarrow(l, t1, t2, com) -> - assert (com = Cok); + | Tarrow(l, t1, t2, _) -> if memq_warn t visited then (t, Unchanged) else let visited = t :: visited in let (t1', c1) = build_subtype env visited loops (not posi) level t1 in |