Reject lone surrogates in string patterns

Signed-off-by: Christoph Knittel <ck@cca.io>

Author: cknitt

compiler/frontend/ast_utf8_string_interp.ml

@@ -312,6 +312,10 @@ let transform_pat (p : Parsetree.pattern) s delim : Parsetree.pattern =
   match Delim.parse_unprocessed false delim with
   | Js ->
     let js_str = Ast_utf8_string.transform p.ppat_loc s in
+    (match String_literal.decode_js_escapes js_str with
+    | Some _ -> ()
+    | None ->
+      Location.raise_errorf ~loc:p.ppat_loc "Invalid string escape sequence");
     {
       p with
       ppat_desc =

compiler/ml/string_literal.mli

@@ -1,3 +1,8 @@
+val decode_js_escapes : string -> string option
+(** Decode the escape sequences in a JavaScript string-literal body into its
+    semantic UTF-8 value. Returns [None] for malformed input or unpaired
+    UTF-16 surrogates. *)
+
 val runtime_value : string -> string option -> string
 (** Return the runtime value represented by a typed string constant.
 

tests/ounit_tests/ounit_string_literal_tests.ml

@@ -7,6 +7,18 @@ let assert_runtime_value ?(delim = Some "*j") ~encoded ~expected () =
 let assert_same_runtime_value left right =
   OUnit.assert_equal 0 (String_literal.compare left right)
 
+let assert_invalid_backquoted_pattern encoded =
+  let template_attribute =
+    (Location.mknoloc "res.template", Parsetree.PStr [])
+  in
+  let pattern =
+    Ast_helper.Pat.constant ~attrs:[template_attribute]
+      (Parsetree.Pconst_string (encoded, Some "js"))
+  in
+  match Ast_utf8_string_interp.transform_pat pattern encoded "js" with
+  | _ -> OUnit.assert_failure "expected an invalid string escape"
+  | exception Location.Error _ -> ()
+
 let suites =
   __FILE__
   >::: [
@@ -55,6 +67,9 @@ let suites =
                {|\uD800\u0041|};
                {|\uDC00\uD800|};
              ] );
+         ( "backquoted patterns reject lone surrogate escapes" >:: fun _ ->
+           assert_invalid_backquoted_pattern {|\uD800|};
+           assert_invalid_backquoted_pattern {|\uDC00|} );
          ( "comparison uses runtime values" >:: fun _ ->
            assert_same_runtime_value ("a", Some "*j") ({|\x61|}, Some "*j");
            assert_same_runtime_value ("😀", None) ({|\u{1f600}|}, Some "*j");