From ef7c8c1bc6ab1aef91149ccb5647dd56da1b0971 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Sat, 24 Oct 2026 12:33:24 +0000 Subject: [PATCH] Check variants with some @unboxed constructors like untagged ones Why: The checks that keep the cases of an untagged variant apart ran only when the type was `@unboxed`. A variant with `@unboxed` on some constructors could have two number cases, an unknown payload beside another, or an untagged object beside a tagged block, and its matches then picked the wrong case (#9020). The `@as` of an untagged case was meanwhile compared with tags, which it does not set. The payload kinds are checked as soon as one case is untagged, tagged blocks count as one object case, and only tagged cases' tags are compared for duplicates. Diagnostic added (two number cases in a mixed variant): Example: type t = | @unboxed A(int) | @unboxed B(int) | C Before (diagnostic): none; `B(5)` matches `A` After (diagnostic): This untagged variant definition is invalid: At most one case can be a number type (int or float). Diagnostic added (untagged object beside a tagged block): Example: type t = | @unboxed A({x: int}) | B({y: int}) | C Before (diagnostic): none; `A({x: 1})` matches `B` After (diagnostic): This untagged variant definition is invalid: At most one case can be an object type. Diagnostic removed (an untagged case's @as): Example: type t = | @unboxed @as("x") A(int) | @as("x") B({y: int}) | C Before (diagnostic): This untagged variant definition is invalid: Duplicate literal x. After (diagnostic): none Fixes #9020 Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01CMkrYaktctdKc4M41WF36t Signed-off-by: Christoph Knittel --- changes/mixed-variant-checks.fix.md | 1 + compiler/ml/ast_untagged_variants.ml | 34 +++++++++++++----- ...agged_mixed_object_and_tagged.res.expected | 9 +++++ .../untagged_mixed_two_numbers.res.expected | 9 +++++ ...ntagged_mixed_unknown_payload.res.expected | 9 +++++ .../untagged_mixed_object_and_tagged.res | 8 +++++ .../fixtures/untagged_mixed_two_numbers.res | 7 ++++ .../untagged_mixed_unknown_payload.res | 7 ++++ tests/tests/src/untagged_mixed_test.mjs | 35 +++++++++++++++++++ tests/tests/src/untagged_mixed_test.res | 24 +++++++++++++ 10 files changed, 134 insertions(+), 9 deletions(-) create mode 100644 changes/mixed-variant-checks.fix.md create mode 100644 tests/build_tests/super_errors/expected/untagged_mixed_object_and_tagged.res.expected create mode 100644 tests/build_tests/super_errors/expected/untagged_mixed_two_numbers.res.expected create mode 100644 tests/build_tests/super_errors/expected/untagged_mixed_unknown_payload.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/untagged_mixed_object_and_tagged.res create mode 100644 tests/build_tests/super_errors/fixtures/untagged_mixed_two_numbers.res create mode 100644 tests/build_tests/super_errors/fixtures/untagged_mixed_unknown_payload.res create mode 100644 tests/tests/src/untagged_mixed_test.mjs create mode 100644 tests/tests/src/untagged_mixed_test.res diff --git a/changes/mixed-variant-checks.fix.md b/changes/mixed-variant-checks.fix.md new file mode 100644 index 0000000000..bcb7eec2cf --- /dev/null +++ b/changes/mixed-variant-checks.fix.md @@ -0,0 +1 @@ +- Check variants with some `@unboxed` constructors like untagged variants, so that cases a match cannot tell apart are rejected, and an untagged case's `@as` no longer clashes with a tagged case's tag. diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index e89c0660f5..fd3538bdc4 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -297,7 +297,30 @@ let check_invariant ~is_untagged_def ~(consts : (Location.t * tag) list) Ext_list.rev_iter consts (fun (loc, literal) -> check_literal ~is_const:true ~loc literal); - if is_untagged_def then + (* A tagged block is told apart from the others by its tag; an untagged one + is its payload, whatever its [@as] *) + Ext_list.rev_iter blocks (fun (loc, block) -> + match block with + | Tagged {tag} -> check_literal ~is_const:false ~loc tag + | Untagged _ -> ()); + (* The payload kinds are checked as soon as one case is untagged, even when + the type itself is not [@unboxed] *) + let has_untagged_block = + List.exists + (function + | _, Untagged _ -> true + | _, Tagged _ -> false) + blocks + in + if is_untagged_def || has_untagged_block then ( + (* Tagged blocks are objects with a tag field: together one object case *) + if + List.exists + (function + | _, Tagged _ -> true + | _, Untagged _ -> false) + blocks + then incr object_types; Ext_list.rev_iter blocks (fun (loc, block) -> match block with | Untagged {tag; block_type} -> @@ -328,14 +351,7 @@ let check_invariant ~is_untagged_def ~(consts : (Location.t * tag) list) incr boolean_types | StringType -> incr string_types); invariant loc tag.name - | Tagged _ -> ()) - else - Ext_list.rev_iter blocks (fun (loc, block) -> - let tag = - match block with - | Tagged {tag} | Untagged {tag} -> tag - in - check_literal ~is_const:false ~loc tag) + | Tagged _ -> ())) let get_cstr_loc_tag (cstr : Types.constructor_declaration) = (cstr.cd_loc, {name = Ident.name cstr.cd_id; literal = cstr.cd_runtime_tag}) diff --git a/tests/build_tests/super_errors/expected/untagged_mixed_object_and_tagged.res.expected b/tests/build_tests/super_errors/expected/untagged_mixed_object_and_tagged.res.expected new file mode 100644 index 0000000000..b8546679d2 --- /dev/null +++ b/tests/build_tests/super_errors/expected/untagged_mixed_object_and_tagged.res.expected @@ -0,0 +1,9 @@ + + We've found a bug for you! + /.../fixtures/untagged_mixed_object_and_tagged.res:1:10-31 + + 1 │ type t = | @unboxed A({x: int}) | B({y: int}) | C + 2 │ let f = x => + 3 │ switch x { + + This untagged variant definition is invalid: At most one case can be an object type. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/untagged_mixed_two_numbers.res.expected b/tests/build_tests/super_errors/expected/untagged_mixed_two_numbers.res.expected new file mode 100644 index 0000000000..0efbcc2da7 --- /dev/null +++ b/tests/build_tests/super_errors/expected/untagged_mixed_two_numbers.res.expected @@ -0,0 +1,9 @@ + + We've found a bug for you! + /.../fixtures/untagged_mixed_two_numbers.res:1:28-44 + + 1 │ type t = | @unboxed A(int) | @unboxed B(int) | C + 2 │ let f = x => + 3 │ switch x { + + This untagged variant definition is invalid: At most one case can be a number type (int or float). \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/untagged_mixed_unknown_payload.res.expected b/tests/build_tests/super_errors/expected/untagged_mixed_unknown_payload.res.expected new file mode 100644 index 0000000000..c004087eed --- /dev/null +++ b/tests/build_tests/super_errors/expected/untagged_mixed_unknown_payload.res.expected @@ -0,0 +1,9 @@ + + We've found a bug for you! + /.../fixtures/untagged_mixed_unknown_payload.res:1:10-32 + + 1 │ type t = | @unboxed A(list) | B({x: int}) | C + 2 │ let f = x => + 3 │ switch x { + + This untagged variant definition is invalid: Case A has a payload that is not of one of the recognized shapes (object, array, etc). Then it must be the only case with payloads. \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/untagged_mixed_object_and_tagged.res b/tests/build_tests/super_errors/fixtures/untagged_mixed_object_and_tagged.res new file mode 100644 index 0000000000..3373b6b72a --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/untagged_mixed_object_and_tagged.res @@ -0,0 +1,8 @@ +type t = | @unboxed A({x: int}) | B({y: int}) | C +let f = x => + switch x { + | A(_) => "a" + | B(_) => "b" + | C => "c" + } +let r = f(A({x: 1})) diff --git a/tests/build_tests/super_errors/fixtures/untagged_mixed_two_numbers.res b/tests/build_tests/super_errors/fixtures/untagged_mixed_two_numbers.res new file mode 100644 index 0000000000..4faca17526 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/untagged_mixed_two_numbers.res @@ -0,0 +1,7 @@ +type t = | @unboxed A(int) | @unboxed B(int) | C +let f = x => + switch x { + | A(_) => "a" + | B(_) => "b" + | C => "c" + } diff --git a/tests/build_tests/super_errors/fixtures/untagged_mixed_unknown_payload.res b/tests/build_tests/super_errors/fixtures/untagged_mixed_unknown_payload.res new file mode 100644 index 0000000000..19ab89d449 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/untagged_mixed_unknown_payload.res @@ -0,0 +1,7 @@ +type t = | @unboxed A(list) | B({x: int}) | C +let f = x => + switch x { + | A(_) => "a" + | B(_) => "b" + | C => "c" + } diff --git a/tests/tests/src/untagged_mixed_test.mjs b/tests/tests/src/untagged_mixed_test.mjs new file mode 100644 index 0000000000..e6c6dc5ede --- /dev/null +++ b/tests/tests/src/untagged_mixed_test.mjs @@ -0,0 +1,35 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + +import * as Mocha from "mocha"; +import * as Test_utils from "./test_utils.mjs"; + +function kind(value) { + if (value === "C") { + return "c"; + } else if (typeof value === "number") { + return "a"; + } else { + return "b"; + } +} + +function id(x) { + return x; +} + +Mocha.describe("Untagged_mixed_test", () => { + Mocha.test("an untagged case's @as is not a tag", () => { + Test_utils.eq("File \"untagged_mixed_test.res\", line 20, characters 7-14", kind(id(1)), "a"); + Test_utils.eq("File \"untagged_mixed_test.res\", line 21, characters 7-14", kind(id({ + TAG: "x", + y: 1 + })), "b"); + Test_utils.eq("File \"untagged_mixed_test.res\", line 22, characters 7-14", kind(id("C")), "c"); + }); +}); + +export { + kind, + id, +} +/* Not a pure module */ diff --git a/tests/tests/src/untagged_mixed_test.res b/tests/tests/src/untagged_mixed_test.res new file mode 100644 index 0000000000..b92bb41f50 --- /dev/null +++ b/tests/tests/src/untagged_mixed_test.res @@ -0,0 +1,24 @@ +open Mocha +open Test_utils + +// In a variant with some @unboxed cases, the @as of an untagged case does not +// change its representation, so it does not clash with a tagged case's tag +// (#9020) +type t = | @unboxed @as("x") A(int) | @as("x") B({y: int}) | C + +let kind = value => + switch value { + | A(_) => "a" + | B(_) => "b" + | C => "c" + } + +@inline(never) let id = x => x + +describe(__MODULE__, () => { + test("an untagged case's @as is not a tag", () => { + eq(__LOC__, kind(id(A(1))), "a") + eq(__LOC__, kind(id(B({y: 1}))), "b") + eq(__LOC__, kind(id(C)), "c") + }) +})