fix false positive in variant to primitive branch, and add tests

Author: zth

jscomp/build_tests/super_errors/expected/variant_to_variant_coercion.res.expected

@@ -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

jscomp/build_tests/super_errors/expected/variant_to_variant_coercion_as.res.expected

@@ -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

jscomp/build_tests/super_errors/expected/variant_to_variant_coercion_tag.res.expected

@@ -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

jscomp/build_tests/super_errors/expected/variant_to_variant_coercion_unboxed.res.expected

@@ -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

jscomp/build_tests/super_errors/fixtures/variant_to_variant_coercion.res

@@ -0,0 +1,6 @@
+type x = One(bool) | Two
+type y = One(string) | Two
+
+let x: x = One(true)
+
+let y = (x :> y)

jscomp/build_tests/super_errors/fixtures/variant_to_variant_coercion_as.res

@@ -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)

jscomp/build_tests/super_errors/fixtures/variant_to_variant_coercion_tag.res

@@ -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)

jscomp/build_tests/super_errors/fixtures/variant_to_variant_coercion_unboxed.res

@@ -0,0 +1,6 @@
+@unboxed type x = One(bool) | Two
+type y = One(bool) | Two
+
+let x: x = One(true)
+
+let y = (x :> y)

jscomp/ml/ctype.ml

@@ -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

jscomp/ml/variant_coercion.ml

@@ -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)