diff --git a/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch1.res.expected b/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch1.res.expected new file mode 100644 index 0000000000..48152a9582 --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch1.res.expected @@ -0,0 +1,28 @@ + + We've found a bug for you! + /.../fixtures/variant_spread_tag_value_mismatch1.res:3:5-5:1 + + 1 │ module Foo: { + 2 │ let addcuc: (. int, int) => int + 3 │ } = { + 4 │  let addcuc = (a, b) => a + b + 5 │ } + 6 │ + + Signature mismatch: + Modules do not match: + { + let addcuc: (int, int) => int +} + is not included in + { + let addcuc: (. int, int) => int +} + Values do not match: + let addcuc: (int, int) => int (curried) + is not included in + let addcuc: (. int, int) => int (uncurried) + /.../fixtures/variant_spread_tag_value_mismatch1.res:2:3-33: + Expected declaration + /.../fixtures/variant_spread_tag_value_mismatch1.res:4:7-12: + Actual declaration \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch2.res.expected b/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch2.res.expected new file mode 100644 index 0000000000..5b99b03586 --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch2.res.expected @@ -0,0 +1,29 @@ + + We've found a bug for you! + /.../fixtures/variant_spread_tag_value_mismatch2.res:5:5-8:1 + + 3 │ module Foo: { + 4 │ let addcuu: (int, int) => int + 5 │ } = { + 6 │  @@uncurried.swap + 7 │  let addcuu = (. a, b) => a + b + 8 │ } + 9 │ + + Signature mismatch: + Modules do not match: + { + let addcuu: (int, int) => int +} + is not included in + { + let addcuu: (int, int) => int +} + Values do not match: + let addcuu: (int, int) => int (curried) + is not included in + let addcuu: (int, int) => int (uncurried) + /.../fixtures/variant_spread_tag_value_mismatch2.res:4:3-31: + Expected declaration + /.../fixtures/variant_spread_tag_value_mismatch2.res:7:7-12: + Actual declaration \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch3.res.expected b/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch3.res.expected new file mode 100644 index 0000000000..45e899e7cb --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch3.res.expected @@ -0,0 +1,28 @@ + + We've found a bug for you! + /.../fixtures/variant_spread_tag_value_mismatch3.res:3:5-5:1 + + 1 │ module Foo: { + 2 │ let adducc: (int, int) => int + 3 │ } = { + 4 │  let adducc = (. a, b) => a + b + 5 │ } + 6 │ + + Signature mismatch: + Modules do not match: + { + let adducc: (. int, int) => int +} + is not included in + { + let adducc: (int, int) => int +} + Values do not match: + let adducc: (. int, int) => int (uncurried) + is not included in + let adducc: (int, int) => int (curried) + /.../fixtures/variant_spread_tag_value_mismatch3.res:2:3-31: + Expected declaration + /.../fixtures/variant_spread_tag_value_mismatch3.res:4:7-12: + Actual declaration \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch4.res.expected b/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch4.res.expected new file mode 100644 index 0000000000..9b6c3d69ad --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/variant_spread_tag_value_mismatch4.res.expected @@ -0,0 +1,28 @@ + + We've found a bug for you! + /.../fixtures/variant_spread_tag_value_mismatch4.res:6:5-8:1 + + 4 │ @@uncurried.swap + 5 │ let adducu: (. int, int) => int + 6 │ } = { + 7 │  let adducu = (a, b) => a + b + 8 │ } + 9 │ + + Signature mismatch: + Modules do not match: + { + let adducu: (int, int) => int +} + is not included in + { + let adducu: (int, int) => int +} + Values do not match: + let adducu: (int, int) => int (uncurried) + is not included in + let adducu: (int, int) => int (curried) + /.../fixtures/variant_spread_tag_value_mismatch4.res:5:3-33: + Expected declaration + /.../fixtures/variant_spread_tag_value_mismatch4.res:7:7-12: + Actual declaration \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch1.res b/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch1.res new file mode 100644 index 0000000000..e7f2d44f72 --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch1.res @@ -0,0 +1,5 @@ +module Foo: { + let addcuc: (. int, int) => int +} = { + let addcuc = (a, b) => a + b +} diff --git a/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch2.res b/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch2.res new file mode 100644 index 0000000000..0ca0e33331 --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch2.res @@ -0,0 +1,8 @@ +@@uncurried + +module Foo: { + let addcuu: (int, int) => int +} = { + @@uncurried.swap + let addcuu = (. a, b) => a + b +} diff --git a/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch3.res b/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch3.res new file mode 100644 index 0000000000..b490eca1f0 --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch3.res @@ -0,0 +1,5 @@ +module Foo: { + let adducc: (int, int) => int +} = { + let adducc = (. a, b) => a + b +} diff --git a/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch4.res b/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch4.res new file mode 100644 index 0000000000..067c8ffea6 --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/variant_spread_tag_value_mismatch4.res @@ -0,0 +1,8 @@ +@@uncurried + +module Foo: { + @@uncurried.swap + let adducu: (. int, int) => int +} = { + let adducu = (a, b) => a + b +} diff --git a/jscomp/ml/includemod.ml b/jscomp/ml/includemod.ml index 0fcfa8a508..1f73880917 100644 --- a/jscomp/ml/includemod.ml +++ b/jscomp/ml/includemod.ml @@ -533,14 +533,22 @@ let show_locs ppf (loc1, loc2) = show_loc "Expected declaration" ppf loc2; show_loc "Actual declaration" ppf loc1 -let include_err ppf = function +let include_err ~env ppf = function | Missing_field (id, loc, kind) -> fprintf ppf "The %s `%a' is required but not provided" kind ident id; show_loc "Expected declaration" ppf loc | Value_descriptions(id, d1, d2) -> + let curry_kind_1, curry_kind_2 = + match (Ctype.expand_head env d1.val_type, Ctype.expand_head env d2.val_type ) with + | { desc = Tarrow _ }, + { desc = Tconstr (Pident {name = "function$"},_,_)} -> (" (curried)", " (uncurried)") + | { desc = Tconstr (Pident {name = "function$"},_,_)}, + { desc = Tarrow _ } -> (" (uncurried)", " (curried)") + | _ -> ("", "") + in fprintf ppf - "@[Values do not match:@ %a@;<1 -2>is not included in@ %a@]" - (value_description id) d1 (value_description id) d2; + "@[Values do not match:@ %a%s@;<1 -2>is not included in@ %a%s@]" + (value_description id) d1 curry_kind_1 (value_description id) d2 curry_kind_2; show_locs ppf (d1.val_loc, d2.val_loc); | Type_declarations(id, d1, d2, errs) -> fprintf ppf "@[@[%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]" @@ -633,7 +641,7 @@ let context ppf cxt = let include_err ppf (cxt, env, err) = Printtyp.wrap_printing_env env (fun () -> - fprintf ppf "@[%a%a@]" context (List.rev cxt) include_err err) + fprintf ppf "@[%a%a@]" context (List.rev cxt) (include_err ~env) err) let buffer = ref Bytes.empty let is_big obj =