diff --git a/jscomp/build_tests/super_errors/expected/c_for_u_in_c_mode.res.expected b/jscomp/build_tests/super_errors/expected/c_for_u_in_c_mode.res.expected new file mode 100644 index 0000000000..a76943f8ff --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/c_for_u_in_c_mode.res.expected @@ -0,0 +1,28 @@ + + We've found a bug for you! + /.../fixtures/c_for_u_in_c_mode.res:3:5-5:1 + + 1 │ module Foo: { + 2 │ let add: (. int, int) => int + 3 │ } = { + 4 │  let add = (a, b) => a + b + 5 │ } + 6 │ + + Signature mismatch: + Modules do not match: + { + let add: (int, int) => int +} + is not included in + { + let add: (. int, int) => int +} + Values do not match: + let add: (int, int) => int (curried) + is not included in + let add: (. int, int) => int (uncurried) + /.../fixtures/c_for_u_in_c_mode.res:2:3-30: + Expected declaration + /.../fixtures/c_for_u_in_c_mode.res:4:7-9: + Actual declaration \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/expected/c_for_u_in_u_mode.res.expected b/jscomp/build_tests/super_errors/expected/c_for_u_in_u_mode.res.expected new file mode 100644 index 0000000000..3b3462a019 --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/c_for_u_in_u_mode.res.expected @@ -0,0 +1,29 @@ + + We've found a bug for you! + /.../fixtures/c_for_u_in_u_mode.res:5:5-8:1 + + 3 │ module Foo: { + 4 │ let add: (int, int) => int + 5 │ } = { + 6 │  @@uncurried.swap + 7 │  let add = (. a, b) => a + b + 8 │ } + 9 │ + + Signature mismatch: + Modules do not match: + { + let add: (int, int) => int +} + is not included in + { + let add: (int, int) => int +} + Values do not match: + let add: (int, int) => int (curried) + is not included in + let add: (int, int) => int (uncurried) + /.../fixtures/c_for_u_in_u_mode.res:4:3-28: + Expected declaration + /.../fixtures/c_for_u_in_u_mode.res:7:7-9: + Actual declaration \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/expected/u_for_c_in_c_mode.res.expected b/jscomp/build_tests/super_errors/expected/u_for_c_in_c_mode.res.expected new file mode 100644 index 0000000000..64ccef591c --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/u_for_c_in_c_mode.res.expected @@ -0,0 +1,28 @@ + + We've found a bug for you! + /.../fixtures/u_for_c_in_c_mode.res:3:5-5:1 + + 1 │ module Foo: { + 2 │ let add: (int, int) => int + 3 │ } = { + 4 │  let add = (. a, b) => a + b + 5 │ } + 6 │ + + Signature mismatch: + Modules do not match: + { + let add: (. int, int) => int +} + is not included in + { + let add: (int, int) => int +} + Values do not match: + let add: (. int, int) => int (uncurried) + is not included in + let add: (int, int) => int (curried) + /.../fixtures/u_for_c_in_c_mode.res:2:3-28: + Expected declaration + /.../fixtures/u_for_c_in_c_mode.res:4:7-9: + Actual declaration \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/expected/u_for_c_in_u_mode.res.expected b/jscomp/build_tests/super_errors/expected/u_for_c_in_u_mode.res.expected new file mode 100644 index 0000000000..823724e0e7 --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/u_for_c_in_u_mode.res.expected @@ -0,0 +1,28 @@ + + We've found a bug for you! + /.../fixtures/u_for_c_in_u_mode.res:6:5-8:1 + + 4 │ @@uncurried.swap + 5 │ let add: (. int, int) => int + 6 │ } = { + 7 │  let add = (a, b) => a + b + 8 │ } + 9 │ + + Signature mismatch: + Modules do not match: + { + let add: (int, int) => int +} + is not included in + { + let add: (int, int) => int +} + Values do not match: + let add: (int, int) => int (uncurried) + is not included in + let add: (int, int) => int (curried) + /.../fixtures/u_for_c_in_u_mode.res:5:3-30: + Expected declaration + /.../fixtures/u_for_c_in_u_mode.res:7:7-9: + Actual declaration \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/fixtures/c_for_u_in_c_mode.res b/jscomp/build_tests/super_errors/fixtures/c_for_u_in_c_mode.res new file mode 100644 index 0000000000..ed0ff1515d --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/c_for_u_in_c_mode.res @@ -0,0 +1,5 @@ +module Foo: { + let add: (. int, int) => int +} = { + let add = (a, b) => a + b +} diff --git a/jscomp/build_tests/super_errors/fixtures/c_for_u_in_u_mode.res b/jscomp/build_tests/super_errors/fixtures/c_for_u_in_u_mode.res new file mode 100644 index 0000000000..844400218c --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/c_for_u_in_u_mode.res @@ -0,0 +1,8 @@ +@@uncurried + +module Foo: { + let add: (int, int) => int +} = { + @@uncurried.swap + let add = (. a, b) => a + b +} diff --git a/jscomp/build_tests/super_errors/fixtures/u_for_c_in_c_mode.res b/jscomp/build_tests/super_errors/fixtures/u_for_c_in_c_mode.res new file mode 100644 index 0000000000..f1da111c85 --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/u_for_c_in_c_mode.res @@ -0,0 +1,5 @@ +module Foo: { + let add: (int, int) => int +} = { + let add = (. a, b) => a + b +} diff --git a/jscomp/build_tests/super_errors/fixtures/u_for_c_in_u_mode.res b/jscomp/build_tests/super_errors/fixtures/u_for_c_in_u_mode.res new file mode 100644 index 0000000000..85e59dbaef --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/u_for_c_in_u_mode.res @@ -0,0 +1,8 @@ +@@uncurried + +module Foo: { + @@uncurried.swap + let add: (. int, int) => int +} = { + let add = (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 =