diff --git a/CHANGELOG.md b/CHANGELOG.md index 606dda82d7..95f81e5264 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,6 +21,7 @@ #### :bug: Bug fix - Fix printing of tagged template literals. https://github.com/rescript-lang/rescript/pull/8018 +- Fix printing of optional record fields in pattern matching errors. https://github.com/rescript-lang/rescript/pull/8019 #### :memo: Documentation diff --git a/compiler/common/pattern_printer.ml b/compiler/common/pattern_printer.ml index f3529da7a5..603f980840 100644 --- a/compiler/common/pattern_printer.ml +++ b/compiler/common/pattern_printer.ml @@ -1,9 +1,56 @@ open Types open Typedtree open Parsetree +open Asttypes let mkpat desc = Ast_helper.Pat.mk desc +let[@warning "-4"] is_generated_optional_constructor + (lid : Longident.t Location.loc) = + match lid.txt with + | Longident.Lident name -> + String.length name >= 2 && name.[0] = '#' && name.[1] = '$' + | _ -> false + +(* Optional fields become “option-of-option” internally: the outer layer is + added by the compiler to track presence, while the inner layer is the user’s + payload. When printing counterexamples we only need to know which of these + situations we saw. *) +type optional_field_state = + | Field_normal (* Regular user patterns: `{b: Some(_)}`, `{b}`, `_`, etc. *) + | Field_missing + (* The outer constructor was the synthetic `#$None…`, i.e. the field was + not provided at all. This is what should print as `{b: ?None}`. *) + | Field_present_none +(* The outer constructor was the synthetic `#$Some…` but its payload was `None`. + This means the optional field exists with value `None`, so we should + print `{b: None}`. *) + +(* Optional record fields are lowered into an extra option layer; we re-infer + whether we’re looking at a missing field vs. a present-but-`None` value so + we can render useful surface syntax in error messages. *) +let[@warning "-4"] rec classify_optional_field_state pat = + match pat.pat_desc with + | Tpat_construct (lid, cstr, []) + when is_generated_optional_constructor lid && cstr.cstr_name = "None" -> + Field_missing + | Tpat_construct (lid, cstr, [inner]) + when is_generated_optional_constructor lid && cstr.cstr_name = "Some" -> ( + match classify_optional_field_state inner with + | Field_missing | Field_present_none -> Field_present_none + | Field_normal -> Field_normal) + | _ -> Field_normal + +let none_pattern = + mkpat (Ppat_construct (mknoloc (Longident.Lident "None"), None)) + +let[@warning "-4"] strip_synthetic_some pat = + match pat.pat_desc with + | Tpat_construct (lid, cstr, [inner]) + when is_generated_optional_constructor lid && cstr.cstr_name = "Some" -> + inner + | _ -> pat + let untype typed = let rec loop pat = match pat.pat_desc with @@ -30,12 +77,26 @@ let untype typed = let arg = Option.map loop p_opt in mkpat (Ppat_variant (label, arg)) | Tpat_record (subpatterns, closed_flag) -> - let fields = - List.map - (fun (_, lbl, p, opt) -> - {lid = mknoloc (Longident.Lident lbl.lbl_name); x = loop p; opt}) - subpatterns + let fields, saw_optional_rewrite = + List.fold_right + (fun (_, lbl, p, opt) (fields, saw_optional_rewrite) -> + let state = + if lbl.lbl_optional then classify_optional_field_state p + else Field_normal + in + let opt, par_pat, rewrote_optional = + match state with + | Field_missing -> (true, none_pattern, true) + | Field_present_none -> (opt, loop (strip_synthetic_some p), true) + | Field_normal -> (opt, loop p, false) + in + let field = + {lid = mknoloc (Longident.Lident lbl.lbl_name); x = par_pat; opt} + in + (field :: fields, saw_optional_rewrite || rewrote_optional)) + subpatterns ([], false) in + let closed_flag = if saw_optional_rewrite then Closed else closed_flag in mkpat (Ppat_record (fields, closed_flag)) | Tpat_array lst -> mkpat (Ppat_array (List.map loop lst)) in diff --git a/tests/build_tests/super_errors/expected/optional_record_field_missing_case.res.expected b/tests/build_tests/super_errors/expected/optional_record_field_missing_case.res.expected new file mode 100644 index 0000000000..6cbdf5beba --- /dev/null +++ b/tests/build_tests/super_errors/expected/optional_record_field_missing_case.res.expected @@ -0,0 +1,14 @@ + + Warning number 8 + /.../fixtures/optional_record_field_missing_case.res:5:9-8:1 + + 3 │ let a: t = Obj.magic() + 4 │ + 5 │ let _ = switch a { + 6 │ | {b: None} => () + 7 │ | {b: Some(_)} => () + 8 │ } + 9 │ + + You forgot to handle a possible case here, for example: + | {b: ?None} \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/optional_record_field_missing_case_inline.res.expected b/tests/build_tests/super_errors/expected/optional_record_field_missing_case_inline.res.expected new file mode 100644 index 0000000000..1acf1ea703 --- /dev/null +++ b/tests/build_tests/super_errors/expected/optional_record_field_missing_case_inline.res.expected @@ -0,0 +1,14 @@ + + Warning number 8 + /.../fixtures/optional_record_field_missing_case_inline.res:5:9-8:1 + + 3 │ let v: t = Obj.magic() + 4 │ + 5 │ let _ = switch v { + 6 │ | A({b: None}) => () + 7 │ | A({b: Some(_)}) => () + 8 │ } + 9 │ + + You forgot to handle a possible case here, for example: + | A({b: ?None}) \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/optional_record_field_missing_case_result.res.expected b/tests/build_tests/super_errors/expected/optional_record_field_missing_case_result.res.expected new file mode 100644 index 0000000000..34eaadd64e --- /dev/null +++ b/tests/build_tests/super_errors/expected/optional_record_field_missing_case_result.res.expected @@ -0,0 +1,14 @@ + + Warning number 8 + /.../fixtures/optional_record_field_missing_case_result.res:4:3-7:3 + + 2 │ + 3 │ let f = v => + 4 │ switch v { + 5 │  | {b: Ok(x)} => x + 6 │  | {b: Error(y)} => y + 7 │  } + 8 │ + + You forgot to handle a possible case here, for example: + | {b: ?None} \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/optional_record_field_missing_cases_nested.res.expected b/tests/build_tests/super_errors/expected/optional_record_field_missing_cases_nested.res.expected new file mode 100644 index 0000000000..d9780adf58 --- /dev/null +++ b/tests/build_tests/super_errors/expected/optional_record_field_missing_cases_nested.res.expected @@ -0,0 +1,13 @@ + + Warning number 8 + /.../fixtures/optional_record_field_missing_cases_nested.res:5:9-7:1 + + 3 │ let a: t = Obj.magic() + 4 │ + 5 │ let _ = switch a { + 6 │ | {b: Some(Some(_))} => () + 7 │ } + 8 │ + + You forgot to handle a possible case here, for example: + | {b: Some(None)} | {b: None} | {b: ?None} \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/optional_record_field_missing_case.res b/tests/build_tests/super_errors/fixtures/optional_record_field_missing_case.res new file mode 100644 index 0000000000..805a2db851 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/optional_record_field_missing_case.res @@ -0,0 +1,8 @@ +type t = {b?: option} + +let a: t = Obj.magic() + +let _ = switch a { +| {b: None} => () +| {b: Some(_)} => () +} diff --git a/tests/build_tests/super_errors/fixtures/optional_record_field_missing_case_inline.res b/tests/build_tests/super_errors/fixtures/optional_record_field_missing_case_inline.res new file mode 100644 index 0000000000..1e4a34eeab --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/optional_record_field_missing_case_inline.res @@ -0,0 +1,8 @@ +type t = A({b?: option}) + +let v: t = Obj.magic() + +let _ = switch v { +| A({b: None}) => () +| A({b: Some(_)}) => () +} diff --git a/tests/build_tests/super_errors/fixtures/optional_record_field_missing_case_result.res b/tests/build_tests/super_errors/fixtures/optional_record_field_missing_case_result.res new file mode 100644 index 0000000000..7a8614d40d --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/optional_record_field_missing_case_result.res @@ -0,0 +1,7 @@ +type t = {b?: result} + +let f = v => + switch v { + | {b: Ok(x)} => x + | {b: Error(y)} => y + } diff --git a/tests/build_tests/super_errors/fixtures/optional_record_field_missing_cases_nested.res b/tests/build_tests/super_errors/fixtures/optional_record_field_missing_cases_nested.res new file mode 100644 index 0000000000..c984aeebb2 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/optional_record_field_missing_cases_nested.res @@ -0,0 +1,7 @@ +type t = {b?: option>} + +let a: t = Obj.magic() + +let _ = switch a { +| {b: Some(Some(_))} => () +}