fix bug where suggestion to run coercion was shown even when coercion wasn't possible

Author: zth

compiler/ml/error_message_utils.ml

@@ -233,7 +233,7 @@ let extract_string_constant text =
   | _ -> None
 
 let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
-    (bottom_aliases : (Types.type_expr * Types.type_expr) option)
+    (bottom_aliases : (Types.type_expr * Types.type_expr) option) trace
     type_clash_context =
   match (type_clash_context, bottom_aliases) with
   | Some (MathOperator {for_float; operator; is_constant}), _ -> (
@@ -608,10 +608,16 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
         | None -> ())
       | None -> ())
     | _ -> ())
-  | _, Some (t1, t2) ->
+  | _, Some (_supplied_type, target_type) ->
+    (* Coercion should always target the top level types. *)
+    let top_level_types =
+      match trace with
+      | (_, t1_top) :: (_, t2_top) :: _ -> Some (t1_top, t2_top)
+      | _ -> None
+    in
     let can_show_coercion_message =
-      match (t1.desc, t2.desc) with
-      | Tvariant _, Tvariant _ ->
+      match top_level_types with
+      | Some ({Types.desc = Tvariant _}, {Types.desc = Tvariant _}) ->
         (* Subtyping polymorphic variants give some weird messages sometimes,
         so let's turn it off for now. For an example, turn them on again and try:
         ```
@@ -620,13 +626,14 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
         ```
         *)
         false
-      | _ -> (
+      | Some (t1, t2) -> (
         try
           Ctype.subtype env t1 t2 ();
           true
         with _ -> false)
+      | None -> false
     in
-    let target_type_string = Format.asprintf "%a" type_expr t2 in
+    let target_type_string = Format.asprintf "%a" type_expr target_type in
     let target_expr_text = Parser.extract_text_at_loc loc in
     let suggested_rewrite =
       match

compiler/ml/typecore.ml

@@ -800,7 +800,7 @@ let print_expr_type_clash ~context env loc trace ppf =
         | ppf -> error_type_text ppf context)
       (function ppf -> error_expected_type_text ppf context);
     print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
-      bottom_aliases_result context;
+      bottom_aliases_result trace context;
     show_extra_help ppf env trace
 
 let report_arity_mismatch ~arity_a ~arity_b ppf =

tests/build_tests/super_errors/expected/dict_show_no_coercion.res.expected

@@ -0,0 +1,15 @@
+
+  We've found a bug for you!
+  /.../fixtures/dict_show_no_coercion.res:2:23-35
+
+  1 │ // This should not show coercion suggestion since just the inner types a
+    │ re coercable, not the full type + expression (dict<float> -> dict<JSON.t
+    │ >)
+  2 │ let x: dict<JSON.t> = dict{"1": 1.}
+  3 │ 
+
+  This has type: dict<float>
+  But it's expected to have type: dict<JSON.t>
+  
+  The incompatible parts:
+    float vs JSON.t (defined as JSON.t)

tests/build_tests/super_errors/fixtures/dict_show_no_coercion.res

@@ -0,0 +1,2 @@
+// This should not show coercion suggestion since just the inner types are coercable, not the full type + expression (dict<float> -> dict<JSON.t>)
+let x: dict<JSON.t> = dict{"1": 1.}