From c4ba210d16cd8e2a2c48bb33d41daaa8d002c042 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 17 Feb 2025 17:00:31 +0100 Subject: [PATCH 1/2] Fix issue with untagged variants and object when null is one case. Fixes https://github.com/rescript-lang/rescript/issues/7289 The check emitted for case `Object` was simply `type of ... === "object"`, though that is insufficient when the variant has one case corresponding to `null`. Now we check if such a variant case exists, and emit `... != null` in addition. --- CHANGELOG.md | 1 + compiler/core/lam_compile.ml | 27 +++++++++++++++---------- compiler/ml/ast_untagged_variants.ml | 13 +++++++----- tests/tests/src/core/Core_JsonTests.mjs | 4 ++-- tests/tests/src/json_decorders.mjs | 4 ++-- 5 files changed, 29 insertions(+), 20 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0121020281..130c4ee8a0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -32,6 +32,7 @@ - Fix issue in functors with more than one argument (which are curried): emit nested function always. https://github.com/rescript-lang/rescript/pull/7273 - Fix dot completion issue with React primitives. https://github.com/rescript-lang/rescript/pull/7292 - Stdlib namespace for Core modules (fixes name clashes with user modules). https://github.com/rescript-lang/rescript/pull/7285 +- Fix runtime type check for Object in untagged variants when one variant case is `null`. https://github.com/rescript-lang/rescript/pull/7303 #### :house: Internal diff --git a/compiler/core/lam_compile.ml b/compiler/core/lam_compile.ml index c2a53f6e08..ea865bbe6f 100644 --- a/compiler/core/lam_compile.ml +++ b/compiler/core/lam_compile.ml @@ -638,14 +638,14 @@ let compile output_prefix = Some ((String name, lam) :: string_table) | _, _ -> None) table (Some []) - and compile_cases ?(untagged = false) ~cxt ~(switch_exp : E.t) - ?(default = NonComplete) ?(get_tag = fun _ -> None) ?(block_cases = []) - cases : initialization = + and compile_cases ?(untagged = false) ?(has_null_case = false) ~cxt + ~(switch_exp : E.t) ?(default = NonComplete) ?(get_tag = fun _ -> None) + ?(block_cases = []) cases : initialization = match use_compile_literal_cases cases ~get_tag with | Some string_cases -> if untagged then compile_untagged_cases ~cxt ~switch_exp ~block_cases ~default - string_cases + ~has_null_case string_cases else compile_string_cases ~cxt ~switch_exp ~default string_cases | None -> cases @@ -718,7 +718,7 @@ let compile output_prefix = else (* [e] will be used twice *) let dispatch e = - let is_a_literal_case = + let is_a_literal_case () = if untagged then E.is_a_literal_case ~literal_cases:(get_literal_cases sw_names) @@ -740,13 +740,17 @@ let compile output_prefix = && List.length sw_consts = 0 && eq_default sw_num_default sw_blocks_default then + let literal_cases = get_literal_cases sw_names in + let has_null_case = + List.mem Ast_untagged_variants.Null literal_cases + in compile_cases ~untagged ~cxt ~switch_exp:(if untagged then e else E.tag ~name:tag_name e) - ~block_cases ~default:sw_blocks_default ~get_tag:get_block_tag - sw_blocks + ~block_cases ~has_null_case ~default:sw_blocks_default + ~get_tag:get_block_tag sw_blocks else [ - S.if_ is_a_literal_case + S.if_ (is_a_literal_case ()) (compile_cases ~cxt ~switch_exp:e ~block_cases ~default:sw_num_default ~get_tag:get_const_tag sw_consts) ~else_: @@ -789,16 +793,17 @@ let compile output_prefix = ~switch:(fun ?default ?declaration e clauses -> S.string_switch ?default ?declaration e clauses) ~switch_exp ~default - and compile_untagged_cases ~cxt ~switch_exp ~default ~block_cases cases = + and compile_untagged_cases ~cxt ~switch_exp ~default ~block_cases + ~has_null_case cases = let mk_eq (i : Ast_untagged_variants.tag_type option) x j y = let check = match (i, j) with | Some tag_type, _ -> Ast_untagged_variants.DynamicChecks.add_runtime_type_check ~tag_type - ~block_cases (Expr x) (Expr y) + ~has_null_case ~block_cases (Expr x) (Expr y) | _, Some tag_type -> Ast_untagged_variants.DynamicChecks.add_runtime_type_check ~tag_type - ~block_cases (Expr y) (Expr x) + ~has_null_case ~block_cases (Expr y) (Expr x) | _ -> Ast_untagged_variants.DynamicChecks.( == ) (Expr x) (Expr y) in E.emit_check check diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 006f56288e..d5c8940a65 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -535,7 +535,8 @@ module DynamicChecks = struct else (* (undefiled + other) || other *) typeof e != object_ - let add_runtime_type_check ~tag_type ~(block_cases : block_type list) x y = + let add_runtime_type_check ~tag_type ~has_null_case + ~(block_cases : block_type list) x y = let instances = Ext_list.filter_map block_cases (function | InstanceType i -> Some i @@ -547,14 +548,16 @@ module DynamicChecks = struct | FunctionType ) -> typeof y == x | Untagged ObjectType -> + let object_case = + if has_null_case then typeof y == x &&& (y != nil) else typeof y == x + in if instances <> [] then let not_one_of_the_instances = - Ext_list.fold_right instances - (typeof y == x) - (fun i x -> x &&& not (is_instance i y)) + Ext_list.fold_right instances object_case (fun i x -> + x &&& not (is_instance i y)) in not_one_of_the_instances - else typeof y == x + else object_case | Untagged (InstanceType i) -> is_instance i y | Untagged UnknownType -> (* This should not happen because unknown must be the only non-literal case *) diff --git a/tests/tests/src/core/Core_JsonTests.mjs b/tests/tests/src/core/Core_JsonTests.mjs index 1359163aef..c9d4dc1308 100644 --- a/tests/tests/src/core/Core_JsonTests.mjs +++ b/tests/tests/src/core/Core_JsonTests.mjs @@ -5,9 +5,9 @@ import * as Test from "./Test.mjs"; function decodeJsonTest() { let json = {"someProp":{"otherProp": null, "thirdProp": [true, false]}}; let decodedCorrectly; - if (typeof json === "object" && !Array.isArray(json)) { + if (typeof json === "object" && json !== null && !Array.isArray(json)) { let match = json["someProp"]; - if (typeof match === "object" && !Array.isArray(match)) { + if (typeof match === "object" && match !== null && !Array.isArray(match)) { let match$1 = match["thirdProp"]; if (Array.isArray(match$1) && match$1.length === 2) { let match$2 = match$1[0]; diff --git a/tests/tests/src/json_decorders.mjs b/tests/tests/src/json_decorders.mjs index f3d6b108d3..5333478791 100644 --- a/tests/tests/src/json_decorders.mjs +++ b/tests/tests/src/json_decorders.mjs @@ -3,7 +3,7 @@ import * as Stdlib_Array from "rescript/lib/es6/Stdlib_Array.js"; function decodeUser(json) { - if (typeof json !== "object" || Array.isArray(json)) { + if (typeof json !== "object" || json === null || Array.isArray(json)) { return; } let id = json.id; @@ -30,7 +30,7 @@ function decodeUser(json) { } function decodeGroup(json) { - if (typeof json !== "object" || Array.isArray(json)) { + if (typeof json !== "object" || json === null || Array.isArray(json)) { return; } let id = json.id; From 6788385ad90dc0cb92dd849bfaf00168458a755f Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 17 Feb 2025 17:12:11 +0100 Subject: [PATCH 2/2] Add test example. --- tests/tests/src/UntaggedVariants.mjs | 12 ++++++++++++ tests/tests/src/UntaggedVariants.res | 8 ++++++++ 2 files changed, 20 insertions(+) diff --git a/tests/tests/src/UntaggedVariants.mjs b/tests/tests/src/UntaggedVariants.mjs index 4a2a4c5fc8..51da690507 100644 --- a/tests/tests/src/UntaggedVariants.mjs +++ b/tests/tests/src/UntaggedVariants.mjs @@ -589,6 +589,17 @@ let MergeCases = { can_merge: can_merge }; +function printLength(json) { + if (typeof json !== "object" || json === null || Array.isArray(json)) { + return; + } + console.log("Length: ", Object.values(json).length); +} + +let ObjectAndNull = { + printLength: printLength +}; + let $$Array; let i = 42; @@ -641,5 +652,6 @@ export { Aliased, OnlyOne, MergeCases, + ObjectAndNull, } /* l2 Not a pure module */ diff --git a/tests/tests/src/UntaggedVariants.res b/tests/tests/src/UntaggedVariants.res index 23f9539402..72644ce1c2 100644 --- a/tests/tests/src/UntaggedVariants.res +++ b/tests/tests/src/UntaggedVariants.res @@ -461,3 +461,11 @@ module MergeCases = { | Boolean(_) => "merge" } } + +module ObjectAndNull = { + let printLength = (json: JSON.t) => + switch json { + | Object(o) => Console.log2("Length: ", o->Dict.valuesToArray->Array.length) + | _ => () + } +}