Skip to content

Commit

Permalink
fix false positive in variant to primitive branch, and add tests
Browse files Browse the repository at this point in the history
  • Loading branch information
zth committed Jun 28, 2023
1 parent cedf6ac commit 82c288e
Show file tree
Hide file tree
Showing 10 changed files with 70 additions and 6 deletions.
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@

We've found a bug for you!
/.../fixtures/variant_to_variant_coercion.res:6:10-15

4 │ let x: x = One(true)
5 │
6 │ let y = (x :> y)
7 │

Type x is not a subtype of y
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@

We've found a bug for you!
/.../fixtures/variant_to_variant_coercion_as.res:6:10-15

4 │ let x: x = One(true)
5 │
6 │ let y = (x :> y)
7 │

Type x is not a subtype of y
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@

We've found a bug for you!
/.../fixtures/variant_to_variant_coercion_tag.res:6:10-15

4 │ let x: x = One(true)
5 │
6 │ let y = (x :> y)
7 │

Type x is not a subtype of y
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@

We've found a bug for you!
/.../fixtures/variant_to_variant_coercion_unboxed.res:6:10-15

4 │ let x: x = One(true)
5 │
6 │ let y = (x :> y)
7 │

Type x is not a subtype of y
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
type x = One(bool) | Two
type y = One(string) | Two

let x: x = One(true)

let y = (x :> y)
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
type x = | @as("one") One(bool) | Two(string)
type y = One(bool) | Two(string)

let x: x = One(true)

let y = (x :> y)
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
@tag("kind") type x = One(bool) | Two(string)
type y = One(bool) | Two(string)

let x: x = One(true)

let y = (x :> y)
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
@unboxed type x = One(bool) | Two
type y = One(bool) | Two

let x: x = One(true)

let y = (x :> y)
6 changes: 3 additions & 3 deletions jscomp/ml/ctype.ml
Original file line number Diff line number Diff line change
Expand Up @@ -3952,10 +3952,10 @@ let rec subtype_rec env trace t1 t2 cstrs =
| (Tconstr(p1, _, _), _) when generic_private_abbrev env p1 ->
subtype_rec env trace (expand_abbrev_opt env t1) t2 cstrs
| (Tconstr(_, [], _), Tconstr(path, [], _)) when Variant_coercion.can_coerce_path path &&
extract_concrete_typedecl env t1 |> Variant_coercion.is_variant_typedecl |> Option.is_some
->
extract_concrete_typedecl env t1 |> Variant_coercion.can_try_coerce_variant_to_primitive |> Option.is_some
->
(* type coercion for variants to primitives *)
(match Variant_coercion.is_variant_typedecl (extract_concrete_typedecl env t1) with
(match Variant_coercion.can_try_coerce_variant_to_primitive (extract_concrete_typedecl env t1) with
| Some constructors ->
if constructors |> Variant_coercion.can_coerce_variant ~path then
cstrs
Expand Down
6 changes: 3 additions & 3 deletions jscomp/ml/variant_coercion.ml
Original file line number Diff line number Diff line change
Expand Up @@ -40,10 +40,10 @@ let can_coerce_variant ~(path : Path.t)
then true
else false

let is_variant_typedecl
((_, _, typedecl) : Path.t * Path.t * Types.type_declaration) =
let can_try_coerce_variant_to_primitive
((_, p, typedecl) : Path.t * Path.t * Types.type_declaration) =
match typedecl with
| {type_kind = Type_variant constructors} -> Some constructors
| {type_kind = Type_variant constructors; type_params=[]} when Path.name p <> "bool"-> Some constructors
| _ -> None

let variant_representation_matches (c1_attrs : Parsetree.attributes)
Expand Down

0 comments on commit 82c288e

Please sign in to comment.