Fix issue with comparison of string constants

String constants were compare literally, as part of constant propagation.
This means that for example `"\a" == "a"` was compiled to `false` even though the two represent the same strings.
Unicode and hex escape codes are other examples where literal comparison is not correct.

Implemented a 3-way string comparison: equality returns Some(true), Some(false), or None where the result is not determined.

Author: cristianoc

CHANGELOG.md

@@ -16,6 +16,7 @@
 - Fix implementation of directives https://github.com/rescript-lang/rescript-compiler/pull/6052
 - Fix issue if the `lib` dir is included in the sources of bsconfig.json https://github.com/rescript-lang/rescript-compiler/pull/6055
 - Fix issue with string escape in pattern match https://github.com/rescript-lang/rescript-compiler/pull/6062
+- Fix issue with literal comparison of string constants https://github.com/rescript-lang/rescript-compiler/pull/6065
 
 #### :rocket: New Feature
 - Add support for toplevel `await` https://github.com/rescript-lang/rescript-compiler/pull/6054

jscomp/core/js_exp_make.ml

@@ -556,6 +556,15 @@ let zero_float_lit : t =
 let float_mod ?comment e1 e2 : J.expression =
   { comment; expression_desc = Bin (Mod, e1, e2) }
 
+
+let str_equal (txt0:string) (delim0:External_arg_spec.delim) txt1 delim1 =
+  if delim0 = delim1 then
+    if Ext_string.equal txt0 txt1 then Some true
+    else if Ast_utf8_string.simple_comparison txt0 && Ast_utf8_string.simple_comparison txt1
+    then Some false
+    else None
+  else None
+
 let rec triple_equal ?comment (e0 : t) (e1 : t) : t =
   match (e0.expression_desc, e1.expression_desc) with
   | ( (Null | Undefined),
@@ -566,9 +575,6 @@ let rec triple_equal ?comment (e0 : t) (e1 : t) : t =
       (Null | Undefined) )
     when no_side_effect e0 ->
       false_
-  | Str { txt = x }, Str { txt = y } ->
-      (* CF*)
-      bool (Ext_string.equal x y)
   | Number (Int { i = i0; _ }), Number (Int { i = i1; _ }) -> bool (i0 = i1)
   | Optional_block (a, _), Optional_block (b, _) -> triple_equal ?comment a b
   | Undefined, Optional_block _
@@ -743,9 +749,13 @@ let rec float_equal ?comment (e0 : t) (e1 : t) : t =
 let int_equal = float_equal
 
 let string_equal ?comment (e0 : t) (e1 : t) : t =
+  let default () : t = { expression_desc = Bin (EqEqEq, e0, e1); comment } in
   match (e0.expression_desc, e1.expression_desc) with
-  | Str { txt = a0 }, Str { txt = b0 } -> bool (Ext_string.equal a0 b0)
-  | _, _ -> { expression_desc = Bin (EqEqEq, e0, e1); comment }
+  | Str { txt = a0; delim = d0 }, Str { txt = a1; delim = d1 } when d0 = d1 ->
+    (match str_equal a0 d0 a1 d1 with
+    | Some b -> bool b
+    | None -> default ())
+  | _, _ -> default ()
 
 let is_type_number ?comment (e : t) : t =
   string_equal ?comment (typeof e) (str "number")
@@ -827,11 +837,12 @@ let uint32 ?comment n : J.expression =
 
 let string_comp (cmp : J.binop) ?comment (e0 : t) (e1 : t) =
   match (e0.expression_desc, e1.expression_desc) with
-  | Str { txt = a0 }, Str { txt = b0 } -> (
-      match cmp with
-      | EqEqEq -> bool (a0 = b0)
-      | NotEqEq -> bool (a0 <> b0)
-      | _ -> bin ?comment cmp e0 e1)
+  | Str { txt = a0; delim = d0 }, Str { txt = a1; delim = d1 } -> (
+    match cmp, str_equal a0 d0 a1 d1 with
+      | EqEqEq, Some b -> bool b
+      | NotEqEq, Some b -> bool (b = false)
+      | _ ->
+        bin ?comment cmp e0 e1)
   | _ -> bin ?comment cmp e0 e1
 
 let obj_length ?comment e : t =

jscomp/frontend/ast_utf8_string.ml

@@ -195,3 +195,15 @@ let transform loc s =
     Buffer.contents buf
   with Error (offset, error) ->
     Location.raise_errorf ~loc "Offset: %d, %a" offset pp_error error
+
+let rec check_no_escapes_or_unicode (s : string) (byte_offset : int) (s_len : int) =
+  if byte_offset = s_len then true
+  else
+    let current_char = s.[byte_offset] in
+    match Ext_utf8.classify current_char with
+    | Single 92 (* '\\' *) -> false
+    | Single _ -> check_no_escapes_or_unicode s (byte_offset + 1) s_len
+    | Invalid | Cont _ | Leading _ -> false
+
+let simple_comparison s =
+  check_no_escapes_or_unicode s 0 (String.length s)

jscomp/frontend/ast_utf8_string.mli

@@ -35,3 +35,6 @@ val pp_error : Format.formatter -> error -> unit
 val transform_test : string -> string
 
 val transform : Location.t -> string -> string
+
+(* Check if the string is only == to itself (no unicode or escape tricks) *)
+val simple_comparison : string -> bool

jscomp/frontend/external_arg_spec.ml

@@ -24,6 +24,8 @@
 
 (** type definitions for arguments to a function declared external *)
 
+type delim = J.delim
+
 type cst =
   | Arg_int_lit of int
   | Arg_string_lit of string * J.delim

jscomp/frontend/external_arg_spec.mli

@@ -22,6 +22,8 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+type delim = J.delim
+
 type cst = private
   | Arg_int_lit of int
   | Arg_string_lit of string * J.delim

jscomp/test/build.ninja

@@ -0,0 +1,16 @@
+'use strict';
+
+
+var a1 = true;
+
+var a2 = false;
+
+var a3 = "'" === "\'";
+
+var a4 = "'" !== "\'";
+
+exports.a1 = a1;
+exports.a2 = a2;
+exports.a3 = a3;
+exports.a4 = a4;
+/* a1 Not a pure module */

jscomp/test/string_constant_compare.js

@@ -0,0 +1,4 @@
+let a1 = "'" == "'"
+let a2 = "'" != "'"
+let a3 = "'" == "\'"
+let a4 = "'" != "\'"

jscomp/test/string_constant_compare.res

@@ -39458,6 +39458,8 @@ val transform_test : string -> string
 
 val transform : Location.t -> string -> string
 
+(* Check if the string is only == to itself (no unicode or escape tricks) *)
+val simple_comparison : string -> bool
 end = struct
 #1 "ast_utf8_string.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -39658,6 +39660,17 @@ let transform loc s =
   with Error (offset, error) ->
     Location.raise_errorf ~loc "Offset: %d, %a" offset pp_error error
 
+let rec check_no_escapes_or_unicode (s : string) (byte_offset : int) (s_len : int) =
+  if byte_offset = s_len then true
+  else
+    let current_char = s.[byte_offset] in
+    match Ext_utf8.classify current_char with
+    | Single 92 (* '\\' *) -> false
+    | Single _ -> check_no_escapes_or_unicode s (byte_offset + 1) s_len
+    | Invalid | Cont _ | Leading _ -> false
+
+let simple_comparison s =
+  check_no_escapes_or_unicode s 0 (String.length s)
 end
 module Ast_compatible : sig 
 #1 "ast_compatible.mli"