diff --git a/CHANGELOG.md b/CHANGELOG.md index 26ae4a35ce9..4dcfb0ee52a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,8 @@ #### :boom: Breaking Change +- Reject malformed UTF-8 in documentation comments and invalid string or template literal escapes that were previously accepted, including empty or out-of-range braced Unicode escapes (`\u{}`, `\u{110000}`) and legacy decimal or octal escapes in templates (`\1`, `\01`, `\8`). These inputs now produce syntax diagnostics instead of compiling to invalid or inconsistent JavaScript. https://github.com/rescript-lang/rescript/pull/8606 +- Reject tagged template literals in patterns. Patterns cannot invoke their tag; previously their raw payload was compiled as a plain string comparison. https://github.com/rescript-lang/rescript/pull/8606 - Remove runtime APIs that were deprecated for removal in ReScript 13, including the `Char` module, unsafe `Obj` operations, legacy `Pervasives` helpers, and `Array.unsafe_get`. https://github.com/rescript-lang/rescript/pull/8564 - Remove the deprecated `Js` namespace and its runtime modules. https://github.com/rescript-lang/rescript/pull/8531 - Move Belt into the separately installed `@rescript/belt` package. Projects using Belt must install the package and list it in their `rescript.json` dependencies. https://github.com/rescript-lang/rescript/pull/8554 @@ -25,6 +27,7 @@ #### :rocket: New Feature +- Support UTF-16 surrogate-pair escapes such as `"\uD83D\uDE00"` in ordinary string literals. https://github.com/rescript-lang/rescript/pull/8606 - Support dynamic imports of external bindings annotated with `@scope`; the generated import follows the complete property path. These imports were previously rejected. https://github.com/rescript-lang/rescript/pull/8582 - Add `@res.hoistedFunction` for emitting nested module functions as flat JavaScript exports. https://github.com/rescript-lang/rescript/pull/8402 - Add source map support with linked, inline, and hidden modes. https://github.com/rescript-lang/rescript/pull/8393 @@ -36,6 +39,7 @@ - Fix `Int.Ref.increment` and `Int.Ref.decrement` evaluating their argument twice: `Int.Ref.increment(mkRef())` emitted `mkRef().contents = mkRef().contents + 1 | 0`. The `%incr` and `%decr` builtins lowered to an assignment that repeated the argument expression; they now bind the reference before the read-modify-write. Inlining decisions around an increment are taken on the code it stands for rather than on a single primitive node. https://github.com/rescript-lang/rescript/pull/8608 - Fix a compiler crash on a polymorphic variant whose numeric name exceeds the `int32` range. `#99999999999("a")` and the same name in a pattern failed with `Failure("Int32.of_string")` and no location, because the range check ran in the frontend AST pass and matched only payload-free expressions. It now runs in `Typecore`, next to the integer literal decoding whose overflow error it mirrors, and covers both label positions. A bare `type t = [#99999999999]` still compiles, since nothing decodes a row field name. https://github.com/rescript-lang/rescript/pull/8608 - Object typing errors now describe fields directly: assigning to a field without `@set` reports that the field is not settable and suggests the annotation, and missing-property errors name the field instead of a phantom `"x#="` member. https://github.com/rescript-lang/rescript/pull/8597 +- Fix pattern matching for string literals with equivalent runtime values but different escape spellings, preserving source order and reporting redundant patterns. https://github.com/rescript-lang/rescript/pull/8606 - Fix signature inclusion rejecting equivalent object externals after type-alias expansion. https://github.com/rescript-lang/rescript/pull/8581 - Fix externals whose result type is an alias of `unit` so they use the same unit-return behavior as externals declared to return `unit`. https://github.com/rescript-lang/rescript/pull/8581 - Fix dynamic imports of external bindings that require FFI argument or result conversions, including `@variadic`, `@unwrap`, polymorphic variant encodings, `@as` phantom arguments, optional labeled arguments, and `@return` wrappers. The imported value now applies the same conversions as a direct external call. https://github.com/rescript-lang/rescript/pull/8582 diff --git a/analysis/reanalyze/src/annotation.ml b/analysis/reanalyze/src/annotation.ml index 678818197ec..697c69d4b51 100644 --- a/analysis/reanalyze/src/annotation.ml +++ b/analysis/reanalyze/src/annotation.ml @@ -17,34 +17,38 @@ let tag_is_one_of_the_gentype_annotations s = let rec get_attribute_payload check_text (attributes : Typedtree.attributes) = let rec from_expr (expr : Parsetree.expression) = - match expr with - | {pexp_desc = Pexp_constant (Pconst_string (s, _))} -> - Some (StringPayload s) - | {pexp_desc = Pexp_constant (Pconst_integer (n, _))} -> Some (IntPayload n) - | {pexp_desc = Pexp_constant (Pconst_float (s, _))} -> Some (FloatPayload s) - | { - pexp_desc = Pexp_construct ({txt = Lident (("true" | "false") as s)}, _); - _; - } -> - Some (BoolPayload (s = "true")) - | {pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None)} -> None - | {pexp_desc = Pexp_construct ({txt = Longident.Lident "::"}, Some e)} -> - from_expr e - | {pexp_desc = Pexp_construct ({txt}, _); _} -> - Some (ConstructPayload (txt |> Longident.flatten |> String.concat ".")) - | {pexp_desc = Pexp_tuple exprs | Pexp_array exprs} -> - let payloads = - exprs |> List.rev - |> List.fold_left - (fun payloads expr -> - match expr |> from_expr with - | Some payload -> payload :: payloads - | None -> payloads) - [] - in - Some (TuplePayload payloads) - | {pexp_desc = Pexp_ident {txt}} -> Some (IdentPayload txt) - | _ -> None + match Ast_payload.semantic_string_of_expression expr with + | Some s -> Some (StringPayload s) + | None -> ( + match expr with + | {pexp_desc = Pexp_constant (Pconst_integer (n, _))} -> + Some (IntPayload n) + | {pexp_desc = Pexp_constant (Pconst_float (s, _))} -> + Some (FloatPayload s) + | { + pexp_desc = Pexp_construct ({txt = Lident (("true" | "false") as s)}, _); + _; + } -> + Some (BoolPayload (s = "true")) + | {pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None)} -> + None + | {pexp_desc = Pexp_construct ({txt = Longident.Lident "::"}, Some e)} -> + from_expr e + | {pexp_desc = Pexp_construct ({txt}, _); _} -> + Some (ConstructPayload (txt |> Longident.flatten |> String.concat ".")) + | {pexp_desc = Pexp_tuple exprs | Pexp_array exprs} -> + let payloads = + exprs |> List.rev + |> List.fold_left + (fun payloads expr -> + match expr |> from_expr with + | Some payload -> payload :: payloads + | None -> payloads) + [] + in + Some (TuplePayload payloads) + | {pexp_desc = Pexp_ident {txt}} -> Some (IdentPayload txt) + | _ -> None) in match attributes with | [] -> None diff --git a/analysis/reanalyze/src/arnold.ml b/analysis/reanalyze/src/arnold.ml index 3ba9e1a2e19..d08558bba34 100644 --- a/analysis/reanalyze/src/arnold.ml +++ b/analysis/reanalyze/src/arnold.ml @@ -535,7 +535,8 @@ module Find_functions_called = struct let super = Tast_mapper.default in let expr (self : Tast_mapper.mapper) (e : Typedtree.expression) = (match e.exp_desc with - | Texp_apply {funct = {exp_desc = Texp_ident (callee, _, _)}} -> + | Texp_apply {funct = {exp_desc = Texp_ident (callee, _, _)}} + | Texp_tagged_template {tag = {exp_desc = Texp_ident (callee, _, _)}} -> let function_name = Path.name callee in callees := !callees |> String_set.add function_name | _ -> ()); @@ -867,6 +868,13 @@ module Compile = struct | None -> expr |> expression ~ctx |> eval_args ~args ~ctx) | Texp_apply {funct = expr; args} -> expr |> expression ~ctx |> eval_args ~args ~ctx + | Texp_tagged_template {tag; values} -> + let args = + List.map (fun value -> (Asttypes.Nolabel, Some value)) values + in + tag |> expression ~ctx |> eval_args ~args ~ctx + | Texp_template {values} -> + values |> List.map (expression ~ctx) |> Command.sequence | Texp_let ( Recursive, [{vb_pat = {pat_desc = Tpat_var (id, _); pat_loc}; vb_expr}], diff --git a/analysis/reanalyze/src/side_effects.ml b/analysis/reanalyze/src/side_effects.ml index 03eb76ebc69..14a5334a0d9 100644 --- a/analysis/reanalyze/src/side_effects.ml +++ b/analysis/reanalyze/src/side_effects.ml @@ -64,7 +64,8 @@ let rec expr_no_side_effects (expr : Typedtree.expression) = | Texp_for (_id, _pat, e1, e2, _dir, e3) -> e1 |> expr_no_side_effects && e2 |> expr_no_side_effects && e3 |> expr_no_side_effects - | Texp_for_of _ | Texp_for_await_of _ -> false + | Texp_template {values} -> values |> List.for_all expr_no_side_effects + | Texp_for_of _ | Texp_for_await_of _ | Texp_tagged_template _ -> false | Texp_object_literal fields -> fields |> List.for_all (fun (_name, e) -> e |> expr_no_side_effects) | Texp_object_get _ -> false diff --git a/analysis/src/completion_front_end.ml b/analysis/src/completion_front_end.ml index 70f08d36991..a3ed213e9ff 100644 --- a/analysis/src/completion_front_end.ml +++ b/analysis/src/completion_front_end.ml @@ -209,7 +209,17 @@ let find_arg_completables ~(args : arg list) ~end_pos ~pos_before_cursor let rec expr_to_context_path_inner ~(in_jsx_context : bool) (e : Parsetree.expression) = match e.pexp_desc with - | Pexp_constant (Pconst_string _) -> Some Completable.CPString + | Pexp_constant (Pconst_string _ | Pconst_json _ | Pconst_raw_source _) -> + Some Completable.CPString + | Pexp_template _ -> Some Completable.CPString + | Pexp_tagged_template {tag} -> ( + match expr_to_context_path ~in_jsx_context tag with + | Some context_path -> + (* Tagged templates are typed like a call of the tag with the template + strings and interpolation values. Preserve that application context + now that the parser no longer represents it as [Pexp_apply]. *) + Some (CPApply (context_path, [Nolabel; Nolabel])) + | None -> None) | Pexp_constant (Pconst_integer _) -> Some CPInt | Pexp_constant (Pconst_float _) -> Some CPFloat | Pexp_construct ({txt = Lident ("true" | "false")}, None) -> Some CPBool @@ -934,14 +944,22 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file { pstr_desc = Pstr_eval - ( {pexp_loc; pexp_desc = Pexp_constant (Pconst_string (s, _))}, + ( ({ + pexp_loc; + pexp_desc = + ( Pexp_constant (Pconst_string _) + | Pexp_template {source_segments = [_]; values = []} ); + } as expression), _ ); }; ] - when loc_has_cursor pexp_loc -> - if Debug.verbose () then - print_endline "[decoratorCompletion] Found @module"; - set_result (Completable.CdecoratorPayload (Module s)) + when loc_has_cursor pexp_loc -> ( + match Ast_payload.semantic_string_of_expression expression with + | Some s -> + if Debug.verbose () then + print_endline "[decoratorCompletion] Found @module"; + set_result (Completable.CdecoratorPayload (Module s)) + | None -> ()) | PStr [ { @@ -968,11 +986,14 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file Completion_expressions.is_expr_hole from_expr, from_expr ) with - | true, _, _, {pexp_desc = Pexp_constant (Pconst_string (s, _))} -> - if Debug.verbose () then - print_endline - "[decoratorCompletion] @module `from` payload was string"; - set_result (Completable.CdecoratorPayload (Module s)) + | true, _, _, from_expr -> ( + match Ast_payload.semantic_string_of_expression from_expr with + | Some s -> + if Debug.verbose () then + print_endline + "[decoratorCompletion] @module `from` payload was string"; + set_result (Completable.CdecoratorPayload (Module s)) + | None -> ()) | false, true, true, _ -> if Debug.verbose () then print_endline @@ -1176,7 +1197,7 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file args = [ (* sh`echo "meh"` *) - (_, ({pexp_desc = Pexp_apply _} as inner_expr)); + (_, ({pexp_desc = Pexp_tagged_template _} as inner_expr)); (* recovery inserted node *) (_, {pexp_desc = Pexp_extension ({txt = "rescript.exprhole"}, _)}); ]; @@ -1206,7 +1227,7 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file args = [ (* sh`echo "meh"` *) - (_, ({pexp_desc = Pexp_apply _} as inner_expr)); + (_, ({pexp_desc = Pexp_tagged_template _} as inner_expr)); (* foo *) (_, {pexp_desc = Pexp_ident {txt = Lident field_name}}); ]; diff --git a/analysis/src/completion_jsx.ml b/analysis/src/completion_jsx.ml index 41e0fadf1d9..feb9196afdb 100644 --- a/analysis/src/completion_jsx.ml +++ b/analysis/src/completion_jsx.ml @@ -303,7 +303,7 @@ let is_regexp_jsx_heuristic_expr expr = { pstr_desc = Pstr_eval - ({pexp_desc = Pexp_constant (Pconst_string ("//", _))}, _); + ({pexp_desc = Pexp_constant (Pconst_raw_source "//")}, _); }; ] ) when expr.pexp_loc |> Loc.end_ = (Location.none |> Loc.end_) -> diff --git a/analysis/src/document_symbol.ml b/analysis/src/document_symbol.ml index 8aa54586d96..3ef53933e54 100644 --- a/analysis/src/document_symbol.ml +++ b/analysis/src/document_symbol.ml @@ -19,7 +19,9 @@ let get_symbols ~source ~kind_file = match exp.pexp_desc with | Pexp_fun _ -> Lsp.Types.SymbolKind.Function | Pexp_constraint (e, _) -> expr_kind e - | Pexp_constant (Pconst_string _) -> Lsp.Types.SymbolKind.String + | Pexp_constant (Pconst_string _ | Pconst_json _ | Pconst_raw_source _) -> + Lsp.Types.SymbolKind.String + | Pexp_template _ -> Lsp.Types.SymbolKind.String | Pexp_constant (Pconst_float _ | Pconst_integer _) -> Lsp.Types.SymbolKind.Number | Pexp_constant _ -> Lsp.Types.SymbolKind.Constant diff --git a/analysis/src/dump_ast.ml b/analysis/src/dump_ast.ml index ae75f6dca6c..2eb536e7af0 100644 --- a/analysis/src/dump_ast.ml +++ b/analysis/src/dump_ast.ml @@ -42,14 +42,17 @@ let print_attributes attributes = let print_constant const = match const with | Parsetree.Pconst_integer (s, _) -> "Pconst_integer(" ^ s ^ ")" - | Pconst_char c -> "Pconst_char(" ^ String.make 1 (Char.chr c) ^ ")" - | Pconst_string (s, delim) -> - let delim = - match delim with - | None -> "" - | Some delim -> delim ^ " " - in - "Pconst_string(" ^ delim ^ s ^ delim ^ ")" + | Pconst_char {source; semantic} -> + "Pconst_char(source=" ^ source ^ ", semantic=" ^ string_of_int semantic + ^ ")" + | Pconst_string payload -> + "Pconst_string(source=" + ^ String_literal.string_source payload + ^ ", semantic=" + ^ String_literal.string_semantic payload + ^ ")" + | Pconst_json source -> "Pconst_json(" ^ source ^ ")" + | Pconst_raw_source source -> "Pconst_raw_source(" ^ source ^ ")" | Pconst_float (s, _) -> "Pconst_float(" ^ s ^ ")" let print_core_type typ ~pos = @@ -264,6 +267,21 @@ and print_expr_item expr ~pos ~indentation = ^ ")" | Pexp_extension (({txt} as loc), _) -> "Pexp_extension(%" ^ (loc |> print_loc_denominator_loc ~pos) ^ txt ^ ")" + | Pexp_template {source_segments; values} -> + "Pexp_template(source_segments=[" + ^ String.concat ", " (List.map (fun {Asttypes.txt} -> txt) source_segments) + ^ "], values=[" + ^ String.concat ", " + (List.map (fun value -> print_expr_item value ~pos ~indentation) values) + ^ "])" + | Pexp_tagged_template {tag; raw_sources; values} -> + "Pexp_tagged_template(tag=" + ^ print_expr_item tag ~pos ~indentation + ^ ", sources=" + ^ string_of_int (List.length raw_sources) + ^ ", values=" + ^ string_of_int (List.length values) + ^ ")" | Pexp_assert expr -> "Pexp_assert(" ^ print_expr_item expr ~pos ~indentation ^ ")" | Pexp_field (exp, loc) -> diff --git a/analysis/src/hint.ml b/analysis/src/hint.ml index a8c2968c677..fa39a0ce02b 100644 --- a/analysis/src/hint.ml +++ b/analysis/src/hint.ml @@ -61,7 +61,8 @@ let inlay ~source ~kind_file ~pos ~max_length ~full ~state ~debug = ( Pexp_constant _ | Pexp_tuple _ | Pexp_record _ | Pexp_variant _ | Pexp_apply _ | Pexp_match _ | Pexp_construct _ | Pexp_ifthenelse _ | Pexp_array _ | Pexp_ident _ | Pexp_try _ | Pexp_object_get _ - | Pexp_object_set _ | Pexp_field _ | Pexp_open _ | Pexp_fun _ ); + | Pexp_object_set _ | Pexp_field _ | Pexp_open _ | Pexp_fun _ + | Pexp_template _ | Pexp_tagged_template _ ); }; } -> push vb.pvb_pat.ppat_loc Type diff --git a/analysis/src/process_attributes.ml b/analysis/src/process_attributes.ml index bd5b1567a94..ccbb057426f 100644 --- a/analysis/src/process_attributes.ml +++ b/analysis/src/process_attributes.ml @@ -2,45 +2,38 @@ open Shared_types (* TODO should I hang on to location? *) let rec find_doc_attribute attributes = - let open Parsetree in match attributes with | [] -> None - | ( {Asttypes.txt = "ocaml.doc" | "ocaml.text" | "ns.doc" | "res.doc"}, - PStr - [ - { - pstr_desc = - Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (doc, _))}, _); - }; - ] ) - :: _ -> - Some doc + | ({Asttypes.txt = "ocaml.doc" | "ocaml.text" | "ns.doc" | "res.doc"}, payload) + :: rest -> ( + match Ast_payload.semantic_string_of_payload payload with + | Some doc -> Some doc + | None -> find_doc_attribute rest) | _ :: rest -> find_doc_attribute rest let rec find_deprecated_attribute attributes = let open Parsetree in match attributes with | [] -> None - | ( {Asttypes.txt = "deprecated"}, - PStr [{pstr_desc = Pstr_eval ({pexp_desc = expr}, _)}] ) + | ({Asttypes.txt = "deprecated"}, PStr [{pstr_desc = Pstr_eval (expr, _)}]) :: _ -> ( - match expr with - (* Simple deprecated attr @deprecated("message") *) - | Pexp_constant (Pconst_string (_msg, _)) -> Some _msg - (* deprecated attr with record *) - | Pexp_record (fields, _) -> - let reason = ref "" in - - fields - |> List.iter (fun {lid = {txt}; x} -> - match (txt, x) with - | ( Lident "reason", - {pexp_desc = Pexp_constant (Pconst_string (msg, _))} ) -> - reason := msg - | _ -> ()); - - Some !reason - | _ -> None) + match Ast_payload.semantic_string_of_expression expr with + | Some msg -> Some msg + | None -> ( + match expr.pexp_desc with + (* deprecated attr with record *) + | Pexp_record (fields, _) -> + let reason = ref "" in + fields + |> List.iter (fun {lid = {txt}; x} -> + match txt with + | Lident "reason" -> ( + match Ast_payload.semantic_string_of_expression x with + | Some msg -> reason := msg + | None -> ()) + | _ -> ()); + Some !reason + | _ -> None)) | ({Asttypes.txt = "deprecated"}, _) :: _ -> Some "" | _ :: rest -> find_deprecated_attribute rest diff --git a/analysis/src/process_cmt.ml b/analysis/src/process_cmt.ml index 3cd5acbb5a5..127cb22bab4 100644 --- a/analysis/src/process_cmt.ml +++ b/analysis/src/process_cmt.ml @@ -688,57 +688,21 @@ and for_module ~env mod_desc module_name = scope lookups match precisely. *) and scan_let_modules ~env (e : Typedtree.expression) = - match e.exp_desc with - | Texp_letmodule (id, name, mexpr, body) -> - let stamp = Ident.binding_time id in - let item = for_module ~env mexpr.mod_desc name.txt in - let declared = - Process_attributes.new_declared ~item ~extent:name.loc ~name ~stamp - ~module_path:NotVisible false [] - in - Stamps.add_module env.stamps stamp declared; - scan_let_modules ~env body - | Texp_let (_rf, bindings, body) -> - List.iter - (fun {Typedtree.vb_expr} -> scan_let_modules ~env vb_expr) - bindings; - scan_let_modules ~env body - | Texp_apply {funct; args; _} -> - scan_let_modules ~env funct; - args - |> List.iter (function - | _, Some e -> scan_let_modules ~env e - | _, None -> ()) - | Texp_tuple exprs -> List.iter (scan_let_modules ~env) exprs - | Texp_sequence (e1, e2) -> - scan_let_modules ~env e1; - scan_let_modules ~env e2 - | Texp_match (e, cases, exn_cases, _) -> - scan_let_modules ~env e; - let scan_case {Typedtree.c_lhs = _; c_guard; c_rhs} = - (match c_guard with - | Some g -> scan_let_modules ~env g - | None -> ()); - scan_let_modules ~env c_rhs - in - List.iter scan_case cases; - List.iter scan_case exn_cases - | Texp_function {body; _} -> scan_let_modules ~env body - | Texp_try (e, cases) -> - scan_let_modules ~env e; - cases - |> List.iter (fun {Typedtree.c_lhs = _; c_guard; c_rhs} -> - (match c_guard with - | Some g -> scan_let_modules ~env g - | None -> ()); - scan_let_modules ~env c_rhs) - | Texp_ifthenelse (e1, e2, e3_opt) -> ( - scan_let_modules ~env e1; - scan_let_modules ~env e2; - match e3_opt with - | Some e3 -> scan_let_modules ~env e3 - | None -> ()) - | _ -> () + let expr iterator (expression : Typedtree.expression) = + (match expression.exp_desc with + | Texp_letmodule (id, name, mexpr, _body) -> + let stamp = Ident.binding_time id in + let item = for_module ~env mexpr.mod_desc name.txt in + let declared = + Process_attributes.new_declared ~item ~extent:name.loc ~name ~stamp + ~module_path:NotVisible false [] + in + Stamps.add_module env.stamps stamp declared + | _ -> ()); + Tast_iterator.default_iterator.expr iterator expression + in + let iterator = {Tast_iterator.default_iterator with expr} in + iterator.expr iterator e and for_structure ~name ~env str_items = let exported = Exported.init () in diff --git a/analysis/src/type_utils.ml b/analysis/src/type_utils.ml index 3e35433ad40..5f5cedfaffa 100644 --- a/analysis/src/type_utils.ml +++ b/analysis/src/type_utils.ml @@ -1009,7 +1009,7 @@ module Codegen = struct let mk_fail_with_exp () = Ast_helper.Exp.apply (Ast_helper.Exp.ident {txt = Lident "failwith"; loc = Location.none}) - [(Nolabel, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))] + [(Nolabel, Ast_helper.Exp.constant (Ast_helper.Const.string "TODO"))] let mk_construct_pat ?payload name = Ast_helper.Pat.construct diff --git a/analysis/src/utils.ml b/analysis/src/utils.ml index 35d7f19e670..4850604eb5d 100644 --- a/analysis/src/utils.ml +++ b/analysis/src/utils.ml @@ -118,6 +118,8 @@ let identify_pexp pexp = | Pexp_open _ -> "Pexp_open" | Pexp_await _ -> "Pexp_await" | Pexp_jsx_element _ -> "Pexp_jsx_element" + | Pexp_template _ -> "Pexp_template" + | Pexp_tagged_template _ -> "Pexp_tagged_template" let identify_ppat pat = match pat with diff --git a/analysis/src/xform.ml b/analysis/src/xform.ml index 720ef7254e0..2bb2c1d88ba 100644 --- a/analysis/src/xform.ml +++ b/analysis/src/xform.ml @@ -66,6 +66,11 @@ module If_then_else = struct | None -> None | Some p1 -> Some (mk_pat (Ppat_variant (label, Some p1)))) | Pexp_constant c -> Some (mk_pat (Ppat_constant c)) + | Pexp_template {source_segments = [{txt = source}]; values = []} -> ( + match String_literal.decode_js_template_escapes source with + | Some semantic -> + Some (mk_pat (Ppat_constant (Ast_helper.Const.string semantic))) + | None -> None) | Pexp_tuple e_list -> ( match list_to_pat ~item_to_pat:exp_to_pat e_list with | None -> None @@ -677,7 +682,7 @@ module Add_doc_template = struct let doc_content = ["\n"; "\n"] in let expression = Ast_helper.Exp.constant - (Parsetree.Pconst_string (String.concat "" doc_content, None)) + (Ast_helper.Const.string (String.concat "" doc_content)) in let structure_item_desc = Parsetree.Pstr_eval (expression, []) in let structure_item = Ast_helper.Str.mk structure_item_desc in diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index f245e4629db..95ec7b79e84 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/compiler/bsc/rescript_compiler_main.ml @@ -501,8 +501,8 @@ let file_level_flags_handler (e : Parsetree.expression option) = let args = Array.of_list (Ext_list.map args (fun e -> - match e.pexp_desc with - | Pexp_constant (Pconst_string (name, _)) -> name + match Ast_payload.semantic_string_of_expression e with + | Some name -> name | _ -> Location.raise_errorf ~loc:e.pexp_loc "string literal expected")) in diff --git a/compiler/core/j.ml b/compiler/core/j.ml index 2a8a039fd4c..bae9a7886a2 100644 --- a/compiler/core/j.ml +++ b/compiler/core/j.ml @@ -72,7 +72,6 @@ and exception_ident = ident and for_ident = ident and for_direction = Js_op.direction_flag and property_map = (property_name * expression) list -and delim = External_arg_spec.delim = DNone | DStarJ | DNoQuotes | DBackQuotes and record_rest_field = { record_rest_label: string; @@ -109,7 +108,20 @@ and expression_desc = This can be constructed either in a static way [E.array_index_by_int] or a dynamic way [E.array_index] *) - | Tagged_template of expression * expression list * expression list + | Tagged_template of expression * string list * expression list + (** A JavaScript tagged template ready for emission. For + [sql`id = ${id}`], the first field is the [sql] expression, the + second is the raw-source list ["id = "; ""], and the third contains + the [id] expression. Segment strings preserve exact raw spelling and + may contain invalid escapes. *) + | Interpolated_template of { + segments: Asttypes.template_segment list; + values: expression list; + } + (** An ordinary interpolated template ready for emission. For + [`a ${value}\n`], [segments] retains source and semantic forms of + ["a "] and ["\\n"], while [values = [value]]. Unlike + [Tagged_template], every segment has a valid decoded value. *) | Static_index of expression * string * int32 option (* The third argument bool indicates whether we should print it as @@ -132,13 +144,28 @@ and expression_desc = async: bool; directive: string option; } - | Str of {delim: delim; txt: string} - (* A string is UTF-8 encoded, and may contain - escape sequences. - *) + | Str of string + (** A decoded runtime string value whose original source spelling no + longer needs to be preserved. For example, ["a\\n"] is stored with + an actual newline and is emitted using the compiler's chosen quoting + and escaping. *) + | Template_literal of Asttypes.template_segment + (** A non-interpolated ordinary backquoted literal. For [`a\n`], [source] + is ["a\\n"] and [semantic] contains an actual newline. [source] is + used for JavaScript emission; [semantic] is used for comparisons and + optimizations. Both are required because preserving backquoted + spelling is an output design goal. Tagged-template segments use + [Tagged_template] instead because their escapes need not be valid. *) + | Json_literal of string + (** Validated JavaScript literal source from a supported external + [json`...`] payload. For [json`{"ok": true}`], the string contains + [{"ok": true}] as JavaScript source, not as a decoded ReScript + string. *) | Raw_js_code of Js_raw_info.t - (* literally raw JS code - *) + (** JavaScript source originating from [raw], [ffi], or [re]. For example, + [%raw("x + 1")] carries ["x + 1"] together with whether it was + validated as an expression, regular expression, or program. It is + emitted as code rather than as a JavaScript string value. *) | Array of expression list | Optional_block of expression * bool (* [true] means [identity] *) diff --git a/compiler/core/js_analyzer.ml b/compiler/core/js_analyzer.ml index fa0df8d961c..f5062363c75 100644 --- a/compiler/core/js_analyzer.ml +++ b/compiler/core/js_analyzer.ml @@ -94,17 +94,27 @@ let free_variables_of_expression st = obj.expression obj st; Set_ident.diff init.used_idents init.defined_idents +let is_array_function (e : J.expression) = + match e.expression_desc with + | Static_index + ({expression_desc = Var (Id ({name = "Array"} as ident))}, "isArray", None) + -> + Ext_ident.is_js ident + | _ -> false + let rec no_side_effect_expression_desc (x : J.expression_desc) = match x with | Undefined _ | Null | Bool _ | Var _ -> true | Fun _ -> true | Number _ -> true (* Can be refined later *) + | Json_literal _ -> true | Static_index (obj, (_name : string), (_pos : int32 option)) -> no_side_effect obj | String_index (a, b) | Array_index (a, b) -> no_side_effect a && no_side_effect b | Is_null_or_undefined b -> no_side_effect b - | Str _ -> true + | Str _ | Template_literal _ -> true + | Interpolated_template {values} -> Ext_list.for_all values no_side_effect | Array xs | Caml_block (xs, _, _) -> (* create [immutable] block, does not really mean that this opreation itself is [pure]. @@ -121,15 +131,12 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) = | String_append (a, b) | Seq (a, b) -> no_side_effect a && no_side_effect b | Length e | Caml_block_tag (e, _) | Typeof e -> no_side_effect e | Bin (op, a, b) -> op <> Eq && no_side_effect a && no_side_effect b - | Tagged_template (call_expr, strings, values) -> - no_side_effect call_expr - && Ext_list.for_all strings no_side_effect - && Ext_list.for_all values no_side_effect + | Tagged_template (call_expr, _, values) -> + no_side_effect call_expr && Ext_list.for_all values no_side_effect | Js_not e | Js_bnot e -> no_side_effect e | In (prop, obj) -> no_side_effect prop && no_side_effect obj | Cond (a, b, c) -> no_side_effect a && no_side_effect b && no_side_effect c - | Call ({expression_desc = Str {txt = "Array.isArray"}}, [e], _) -> - no_side_effect e + | Call (fn, [e], _) when is_array_function fn -> no_side_effect e | Call _ | New _ | Raw_js_code _ (* actually true? *) -> false | Await _ -> false | Spread _ -> false @@ -218,9 +225,13 @@ let rec eq_expression ({expression_desc = x0} : J.expression) | Bin (op1, a1, b1) -> op0 = op1 && eq_expression a0 a1 && eq_expression b0 b1 | _ -> false) - | Str {delim = a0; txt = b0} -> ( + | Str a0 -> ( + match y0 with + | Str a1 -> a0 = a1 + | _ -> false) + | Template_literal segment0 -> ( match y0 with - | Str {delim = a1; txt = b1} -> a0 = a1 && b0 = b1 + | Template_literal segment1 -> segment0 = segment1 | _ -> false) | Static_index (e0, p0, off0) -> ( match y0 with @@ -245,8 +256,9 @@ let rec eq_expression ({expression_desc = x0} : J.expression) eq_expression_list ls0 ls1 && flag0 = flag1 && info0 = info1 | _ -> false) | Length _ | Is_null_or_undefined _ | String_append _ | Typeof _ | Js_not _ - | Js_bnot _ | In _ | Cond _ | New _ | Fun _ | Raw_js_code _ | Array _ - | Caml_block_tag _ | Object _ | Tagged_template _ | Await _ | Record_rest _ -> + | Js_bnot _ | In _ | Cond _ | New _ | Fun _ | Json_literal _ | Raw_js_code _ + | Array _ | Caml_block_tag _ | Object _ | Tagged_template _ + | Interpolated_template _ | Await _ | Record_rest _ -> false | Spread _ -> false @@ -319,6 +331,6 @@ let rev_toplevel_flatten block = let rec is_okay_to_duplicate (e : J.expression) = match e.expression_desc with - | Var _ | Bool _ | Str _ | Number _ -> true + | Var _ | Bool _ | Str _ | Template_literal _ | Number _ -> true | Static_index (e, _s, _off) -> is_okay_to_duplicate e | _ -> false diff --git a/compiler/core/js_analyzer.mli b/compiler/core/js_analyzer.mli index 786c29fece1..e2385e4b2e3 100644 --- a/compiler/core/js_analyzer.mli +++ b/compiler/core/js_analyzer.mli @@ -31,6 +31,8 @@ val free_variables_of_statement : J.statement -> Set_ident.t val free_variables_of_expression : J.expression -> Set_ident.t +val is_array_function : J.expression -> bool + (* val no_side_effect_expression_desc : J.expression_desc -> bool *) diff --git a/compiler/core/js_dump.ml b/compiler/core/js_dump.ml index b24c5b8a587..d536189285e 100644 --- a/compiler/core/js_dump.ml +++ b/compiler/core/js_dump.ml @@ -139,16 +139,17 @@ let rec exp_need_paren ?(arrow = false) (e : J.expression) = | Blk_record_ext _ | Blk_record_inlined _ | Blk_constructor _ ) ) | Object _ -> true + | Json_literal _ -> true | Raw_js_code {code_info = Stmt _} | Length _ | Call _ | Caml_block_tag _ | Seq _ | Static_index _ | Cond _ | Bin _ | Is_null_or_undefined _ | String_index _ | Array_index _ - | String_append _ | Var _ | Undefined _ | Null | Str _ | Array _ - | Caml_block _ | Typeof _ | Number _ | Js_not _ | Js_bnot _ | In _ | Bool _ - | New _ -> + | String_append _ | Var _ | Undefined _ | Null | Str _ | Template_literal _ + | Array _ | Caml_block _ | Typeof _ | Number _ | Js_not _ | Js_bnot _ | In _ + | Bool _ | New _ -> false | Await _ -> false | Spread _ -> false - | Tagged_template _ -> false + | Tagged_template _ | Interpolated_template _ -> false | Record_rest _ -> false | Optional_block (e, true) when arrow -> exp_need_paren ~arrow e | Optional_block _ -> false @@ -693,9 +694,9 @@ and expression_desc cxt ~(level : int) f x : cxt = let rec aux cxt xs ys = match (xs, ys) with | [], [] -> () - | [{J.expression_desc = Str {txt; _}}], [] -> P.string f txt - | {J.expression_desc = Str {txt; _}} :: x_rest, y :: y_rest -> - P.string f txt; + | [source], [] -> P.string f source + | source :: x_rest, y :: y_rest -> + P.string f source; P.string f "${"; let cxt = expression cxt ~level f y in P.string f "}"; @@ -705,6 +706,24 @@ and expression_desc cxt ~(level : int) f x : cxt = aux cxt string_args value_args; P.string f "`"; cxt + | Interpolated_template {segments; values} -> + P.string f "`"; + let rec print_segments cxt segments values = + match (segments, values) with + | [segment], [] -> + P.string f (String_literal.template_source segment); + cxt + | segment :: segments, value :: values -> + P.string f (String_literal.template_source segment); + P.string f "${"; + let cxt = expression cxt ~level:0 f value in + P.string f "}"; + print_segments cxt segments values + | _ -> assert false + in + let cxt = print_segments cxt segments values in + P.string f "`"; + cxt | String_index (a, b) -> P.group f 1 (fun _ -> let cxt = expression ~level:15 cxt f a in @@ -712,17 +731,14 @@ and expression_desc cxt ~(level : int) f x : cxt = P.string f L.code_point_at; (* FIXME: use code_point_at *) P.paren_group f 1 (fun _ -> expression ~level:0 cxt f b)) - | Str {delim; txt} -> - (*TODO -- - when utf8-> it will not escape '\\' which is definitely not we want - *) - let () = - match delim with - | DStarJ -> P.string f ("\"" ^ txt ^ "\"") - | DNoQuotes -> P.string f txt - | DNone -> Js_dump_string.pp_string f txt - | DBackQuotes -> P.string f ("`" ^ txt ^ "`") - in + | Str txt -> + Js_dump_string.pp_string f txt; + cxt + | Template_literal segment -> + P.string f ("`" ^ String_literal.template_source segment ^ "`"); + cxt + | Json_literal source -> + P.string f source; cxt | Raw_js_code {code = s; code_info = info} -> ( match info with @@ -1094,7 +1110,7 @@ and print_jsx cxt ?(spread_props : J.expression option) let print_tag cxt = match tag.expression_desc with (* "div" or any other primitive tag *) - | J.Str {txt} -> + | J.Str txt -> P.string f txt; cxt (* fragment *) @@ -1347,7 +1363,7 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt = | Some s -> P.string f s | None -> ()); cxt - | Str _ -> cxt + | Str _ | Template_literal _ | Json_literal _ -> cxt | _ -> let cxt = (if exp_need_paren e then P.paren_group f 1 else P.group f 0) (fun _ -> diff --git a/compiler/core/js_dump_string.ml b/compiler/core/js_dump_string.ml index 4022c2d1d7f..4effa1adbd0 100644 --- a/compiler/core/js_dump_string.ml +++ b/compiler/core/js_dump_string.ml @@ -24,8 +24,6 @@ module P = Ext_pp -open Ext_utf8 - (** Avoid to allocate single char string too many times*) let array_str1 = Array.init 256 (fun i -> String.make 1 (Char.chr i)) @@ -100,38 +98,21 @@ let escape_to_buffer f (* ?(utf=false)*) s = f +> Array.unsafe_get array_conv (c lsr 4); f +> Array.unsafe_get array_conv (c land 0xf); incr i - | '\128' .. '\255' -> ( - (* Check if this is part of a valid UTF-8 sequence *) - let utf8_byte = classify c in - match utf8_byte with - | Single _ -> - (* Single byte >= 128, escape it *) + | '\128' .. '\255' -> + let decoded = String.get_utf_8_uchar s !i in + if Uchar.utf_decode_is_valid decoded then ( + let length = Uchar.utf_decode_length decoded in + for offset = 0 to length - 1 do + let byte = String.unsafe_get s (!i + offset) in + f +> Array.unsafe_get array_str1 (Char.code byte) + done; + i := !i + length) + else let c = Char.code c in f +> "\\x"; f +> Array.unsafe_get array_conv (c lsr 4); f +> Array.unsafe_get array_conv (c land 0xf); incr i - | Leading (n, _) -> - (* Start of UTF-8 sequence, output the whole sequence as-is *) - let rec output_utf8_sequence pos remaining = - if remaining > 0 && pos < l then ( - let byte = String.unsafe_get s pos in - f +> Array.unsafe_get array_str1 (Char.code byte); - output_utf8_sequence (pos + 1) (remaining - 1)) - in - output_utf8_sequence !i (n + 1); - (* Skip the continuation bytes *) - i := !i + n + 1 - | Cont _ -> - (* Continuation byte, should be handled as part of Leading case *) - incr i - | Invalid -> - (* Invalid UTF-8 byte, escape it *) - let c = Char.code c in - f +> "\\x"; - f +> Array.unsafe_get array_conv (c lsr 4); - f +> Array.unsafe_get array_conv (c land 0xf); - incr i) | '\"' -> f +> "\\\""; incr i (* quote*) diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml index 5e8d25b979c..32f46c2e398 100644 --- a/compiler/core/js_exp_make.ml +++ b/compiler/core/js_exp_make.ml @@ -35,7 +35,8 @@ type t = J.expression *) let rec remove_pure_sub_exp (x : t) : t option = match x.expression_desc with - | Var _ | Str _ | Number _ -> None (* Can be refined later *) + | Var _ | Str _ | Template_literal _ | Json_literal _ | Number _ -> + None (* Can be refined later *) | Array_index (a, b) -> if is_pure_sub_exp a && is_pure_sub_exp b then None else Some x | Array xs -> if Ext_list.for_all xs is_pure_sub_exp then None else Some x @@ -75,6 +76,44 @@ let tagged_template ?comment call_expr string_args value_args : t = source_loc = None; } +let interpolated_template ?comment segments values : t = + let literal_segment (value : t) = + if value.comment <> None then None + else + match value.expression_desc with + | Str semantic -> Some (String_literal.template_from_semantic semantic) + | Template_literal segment -> Some segment + | _ -> None + in + let rec merge rev_segments rev_values rev_parts segments values = + match (segments, values) with + | [], [] -> + let segment = String_literal.concat_template (List.rev rev_parts) in + (List.rev (segment :: rev_segments), List.rev rev_values) + | next_segment :: rest, value :: values -> ( + match literal_segment value with + | Some literal -> + merge rev_segments rev_values + (next_segment :: literal :: rev_parts) + rest values + | None -> + let segment = String_literal.concat_template (List.rev rev_parts) in + merge (segment :: rev_segments) (value :: rev_values) [next_segment] + rest values) + | _ -> assert false + in + let segments, values = + match segments with + | segment :: segments -> merge [] [] [segment] segments values + | [] -> assert false + in + let expression_desc = + match (segments, values) with + | [segment], [] -> J.Template_literal segment + | _ -> J.Interpolated_template {segments; values} + in + {expression_desc; comment; source_loc = None} + let runtime_var_dot ?comment (x : string) (e1 : string) : J.expression = { expression_desc = @@ -156,8 +195,14 @@ let pure_runtime_call module_name fn_name args = (runtime_var_dot module_name fn_name) args -let str ?(delim = J.DNone) ?comment txt : t = - {expression_desc = Str {txt; delim}; comment; source_loc = None} +let str ?comment txt : t = + {expression_desc = Str txt; comment; source_loc = None} + +let template_literal ?comment segment : t = + {expression_desc = Template_literal segment; comment; source_loc = None} + +let json_literal ?comment source : t = + {expression_desc = Json_literal source; comment; source_loc = None} let raw_js_code ?comment info s : t = { @@ -227,7 +272,7 @@ module L = Literals let typeof ?comment (e : t) : t = match e.expression_desc with | Number _ | Length _ -> str ?comment L.js_type_number - | Str _ -> str ?comment L.js_type_string + | Str _ | Template_literal _ -> str ?comment L.js_type_string | Array _ -> str ?comment L.js_type_object | Bool _ -> str ?comment L.js_type_boolean | _ -> {expression_desc = Typeof e; comment; source_loc = None} @@ -236,7 +281,7 @@ let instanceof ?comment (e0 : t) (e1 : t) : t = {expression_desc = Bin (InstanceOf, e0, e1); comment; source_loc = None} let is_array (e0 : t) : t = - let f = str "Array.isArray" ~delim:DNoQuotes in + let f = dot (js_global "Array") "isArray" in { expression_desc = Call (f, [e0], Js_call_info.ml_full_call); comment = None; @@ -633,47 +678,49 @@ let array_length ?comment (e : t) : t = int ?comment (Int32.of_int (List.length l)) | _ -> {expression_desc = Length e; comment; source_loc = None} -let string_length ?comment (e : t) : t = +let string_literal_semantic (e : t) = match e.expression_desc with - | Str {txt; delim = DNone} -> int ?comment (Int32.of_int (String.length txt)) - (* No optimization for {j||j}*) - | _ -> {expression_desc = Length e; comment; source_loc = None} + | Str semantic -> Some semantic + | Template_literal segment -> Some (String_literal.template_semantic segment) + | _ -> None + +let string_length ?comment (e : t) : t = + match string_literal_semantic e with + | Some semantic -> + int ?comment (Int32.of_int (String_literal.utf16_length semantic)) + | None -> {expression_desc = Length e; comment; source_loc = None} let rec string_append ?comment (e : t) (el : t) : t = - let concat a b ~delim = {e with expression_desc = Str {txt = a ^ b; delim}} in - match (e.expression_desc, el.expression_desc) with - | Str {txt = ""}, _ -> el - | _, Str {txt = ""} -> e - | ( Str {txt = a; delim}, - String_append ({expression_desc = Str {txt = b; delim = delim_}}, c) ) - when delim = delim_ -> - string_append ?comment (concat a b ~delim) c - | ( String_append (c, {expression_desc = Str {txt = b; delim}}), - Str {txt = a; delim = delim_} ) - when delim = delim_ -> - string_append ?comment c (concat b a ~delim) - | ( String_append (a, {expression_desc = Str {txt = b; delim}}), - String_append ({expression_desc = Str {txt = c; delim = delim_}}, d) ) - when delim = delim_ -> - string_append ?comment (string_append a (concat b c ~delim)) d - | Str {txt = a; delim}, Str {txt = b; delim = delim_} when delim = delim_ -> - {(concat a b ~delim) with comment; source_loc = None} - | _, _ -> + let append () : t = {comment; source_loc = None; expression_desc = String_append (e, el)} + in + let concat (base : t) a b = {base with expression_desc = Str (a ^ b)} in + match (string_literal_semantic e, string_literal_semantic el) with + | Some "", _ -> el + | _, Some "" -> e + | Some a, Some b -> {(concat e a b) with comment; source_loc = None} + | _ -> ( + match (e.expression_desc, el.expression_desc) with + | String_append (a, b_expr), String_append (c_expr, d) -> ( + match + (string_literal_semantic b_expr, string_literal_semantic c_expr) + with + | Some b, Some c -> + string_append ?comment (string_append a (concat b_expr b c)) d + | _ -> append ()) + | _, String_append (b, c) -> ( + match (string_literal_semantic e, string_literal_semantic b) with + | Some a, Some b -> string_append ?comment (concat e a b) c + | _ -> append ()) + | String_append (c, b_expr), _ -> ( + match (string_literal_semantic b_expr, string_literal_semantic el) with + | Some b, Some a -> string_append ?comment c (concat b_expr b a) + | _ -> append ()) + | _ -> append ()) let obj ?comment ?dup properties : t = {expression_desc = Object (dup, properties); comment; source_loc = None} -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 _), @@ -875,7 +922,7 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = | ( Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ), + {expression_desc = Str "boolean"} ), (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Bool _}) as b) ) | ( (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Bool _}) @@ -883,13 +930,13 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ) ) + {expression_desc = Str "boolean"} ) ) when Js_op_util.same_vident ia ib -> Some {expression_desc = b; comment = None; source_loc = None} | ( Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "string"}} ), + {expression_desc = Str "string"} ), (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Str _}) as s) ) | ( (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Str _}) @@ -897,13 +944,13 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "string"}} ) ) + {expression_desc = Str "string"} ) ) when Js_op_util.same_vident ia ib -> Some {expression_desc = s; comment = None; source_loc = None} | ( Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "number"}} ), + {expression_desc = Str "number"} ), (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Number _}) as i) ) | ( (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Number _}) @@ -911,13 +958,13 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "number"}} ) ) + {expression_desc = Str "number"} ) ) when Js_op_util.same_vident ia ib -> Some {expression_desc = i; comment = None; source_loc = None} | ( Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean" | "string" | "number"}} ), + {expression_desc = Str ("boolean" | "string" | "number")} ), Bin ( EqEqEq, {expression_desc = Var ib}, @@ -931,13 +978,12 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean" | "string" | "number"}} ) - ) + {expression_desc = Str ("boolean" | "string" | "number")} ) ) when Js_op_util.same_vident ia ib -> (* Note: cases boolean / Bool _, number / Number _, string / Str _ are handled above *) Some false_ | ( Call - ( {expression_desc = Str {txt = "Array.isArray"}}, + ( ({expression_desc = Static_index _} as fn), [{expression_desc = Var ia}], _ ), Bin @@ -951,21 +997,21 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} ), Call - ( {expression_desc = Str {txt = "Array.isArray"}}, + ( ({expression_desc = Static_index _} as fn), [{expression_desc = Var ia}], _ ) ) - when Js_op_util.same_vident ia ib -> + when Js_analyzer.is_array_function fn && Js_op_util.same_vident ia ib -> Some false_ | ( Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ), + {expression_desc = Str "boolean"} ), Var ib ) | ( Var ib, Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ) ) + {expression_desc = Str "boolean"} ) ) when Js_op_util.same_vident ia ib -> Some { @@ -980,13 +1026,13 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = | ( Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ), + {expression_desc = Str "boolean"} ), Js_not {expression_desc = Var ib} ) | ( Js_not {expression_desc = Var ib}, Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ) ) + {expression_desc = Str "boolean"} ) ) when Js_op_util.same_vident ia ib -> Some { @@ -1001,51 +1047,51 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = | ( Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ), + {expression_desc = Str "boolean"} ), Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Bool b}) ) | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Bool b}), Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ) ) + {expression_desc = Str "boolean"} ) ) when Js_op_util.same_vident ia ib -> Some {expression_desc = Bool (not b); comment = None; source_loc = None} | ( Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "string"}} ), + {expression_desc = Str "string"} ), Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Str _}) ) | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Str _}), Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "string"}} ) ) + {expression_desc = Str "string"} ) ) when Js_op_util.same_vident ia ib -> None | ( Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "number"}} ), + {expression_desc = Str "number"} ), Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Number _}) ) | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Number _}), Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "number"}} ) ) + {expression_desc = Str "number"} ) ) when Js_op_util.same_vident ia ib -> None | ( Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "object"}} ), + {expression_desc = Str "object"} ), Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Null}) ) | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Null}), Bin ( EqEqEq, {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "object"}} ) ) + {expression_desc = Str "object"} ) ) when Js_op_util.same_vident ia ib -> None | ( (Bin @@ -1053,7 +1099,7 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = {expression_desc = Typeof {expression_desc = Var ia}}, { expression_desc = - Str {txt = "boolean" | "string" | "number" | "object"}; + Str ("boolean" | "string" | "number" | "object"); } ) as typeof), Bin ( NotEqEq, @@ -1069,13 +1115,13 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = {expression_desc = Typeof {expression_desc = Var ia}}, { expression_desc = - Str {txt = "boolean" | "string" | "number" | "object"}; + Str ("boolean" | "string" | "number" | "object"); } ) as typeof) ) when Js_op_util.same_vident ia ib -> (* Note: cases boolean / Bool _, number / Number _, string / Str _, object / Null are handled above *) Some {expression_desc = typeof; comment = None; source_loc = None} | ( (Call - ( {expression_desc = Str {txt = "Array.isArray"}}, + ( ({expression_desc = Static_index _} as fn), [{expression_desc = Var ia}], _ ) as is_array), Bin @@ -1089,10 +1135,10 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} ), (Call - ( {expression_desc = Str {txt = "Array.isArray"}}, + ( ({expression_desc = Static_index _} as fn), [{expression_desc = Var ia}], _ ) as is_array) ) - when Js_op_util.same_vident ia ib -> + when Js_analyzer.is_array_function fn && Js_op_util.same_vident ia ib -> Some {expression_desc = is_array; comment = None; source_loc = None} | _ when Js_analyzer.eq_expression e1 e2 -> Some e1 | ( Bin @@ -1344,7 +1390,7 @@ let rec float_equal ?comment (e0 : t) (e1 : t) : t = let int_equal = float_equal let tag_type = function - | Variant_runtime.String s -> str s ~delim:DStarJ + | Variant_runtime.String s -> str s | Int i -> small_int i | Float f -> float f | BigInt i -> @@ -1360,7 +1406,7 @@ let tag_type = function | Untagged FunctionType -> str "function" | Untagged StringType -> str "string" | Untagged (InstanceType i) -> - str (Variant_runtime.Instance.to_string i) ~delim:DNoQuotes + js_global (Variant_runtime.Instance.to_string i) | Untagged ObjectType -> str "object" | Untagged UnknownType -> (* TODO: this should not happen *) @@ -1382,7 +1428,7 @@ let rec emit_check (check : t Ast_untagged_variants.Dynamic_checks.t) = | IsInstanceOf (Array, x) -> is_array (emit_check x) | IsInstanceOf (instance, x) -> let instance_name = Variant_runtime.Instance.to_string instance in - instanceof (emit_check x) (str instance_name ~delim:DNoQuotes) + instanceof (emit_check x) (js_global instance_name) | Not x -> not (emit_check x) | Expr x -> x @@ -1444,11 +1490,12 @@ let to_int32 ?comment (e : J.expression) : J.expression = (* TODO: if we already know the input is int32, [x|0] can be reduced into [x] *) let string_comp (cmp : Lambda.comparison) ?comment (e0 : t) (e1 : t) = - match (e0.expression_desc, e1.expression_desc) with - | Str {txt = a0; delim = d0}, Str {txt = a1; delim = d1} -> ( - match (cmp, str_equal a0 d0 a1 d1) with - | Ceq, Some b -> bool b - | Cneq, Some b -> bool (b = false) + match (string_literal_semantic e0, string_literal_semantic e1) with + | Some a0, Some a1 -> ( + let equal = Ext_string.equal a0 a1 in + match cmp with + | Ceq -> bool equal + | Cneq -> bool (Stdlib.not equal) | _ -> bin ?comment (Lam_compile_util.jsop_of_comp cmp) e0 e1) | _ -> bin ?comment (Lam_compile_util.jsop_of_comp cmp) e0 e1 diff --git a/compiler/core/js_exp_make.mli b/compiler/core/js_exp_make.mli index 459884cd1eb..2f090d348ff 100644 --- a/compiler/core/js_exp_make.mli +++ b/compiler/core/js_exp_make.mli @@ -79,7 +79,11 @@ val runtime_call : (* args *) t -val str : ?delim:J.delim -> ?comment:string -> string -> t +val str : ?comment:string -> string -> t + +val template_literal : ?comment:string -> Asttypes.template_segment -> t + +val json_literal : ?comment:string -> string -> t val record_rest : ?comment:string -> J.record_rest_field list -> t -> t @@ -250,7 +254,10 @@ val not : t -> t val call : ?comment:string -> info:Js_call_info.t -> t -> t list -> t -val tagged_template : ?comment:string -> t -> t list -> t list -> t +val tagged_template : ?comment:string -> t -> string list -> t list -> t + +val interpolated_template : + ?comment:string -> Asttypes.template_segment list -> t list -> t val new_ : ?comment:string -> J.expression -> J.expression list -> t diff --git a/compiler/core/js_of_lam_variant.ml b/compiler/core/js_of_lam_variant.ml index cc5b185ffe9..a027587122e 100644 --- a/compiler/core/js_of_lam_variant.ml +++ b/compiler/core/js_of_lam_variant.ml @@ -32,7 +32,7 @@ let eval (arg : J.expression) (dispatches : (string * string) list) : E.t = if arg == E.undefined then E.undefined else match arg.expression_desc with - | Str {txt} -> + | Str txt -> let s = Ext_list.assoc_by_string dispatches txt None in E.str s | _ -> @@ -64,7 +64,7 @@ let eval (arg : J.expression) (dispatches : (string * string) list) : E.t = let eval_as_event (arg : J.expression) (dispatches : (string * string) list option) = match arg.expression_desc with - | Caml_block ([{expression_desc = Str {txt}}; cb], _, Blk_poly_var) + | Caml_block ([{expression_desc = Str txt}; cb], _, Blk_poly_var) when Js_analyzer.no_side_effect_expression cb -> let v = match dispatches with @@ -103,7 +103,7 @@ let eval_as_int (arg : J.expression) (dispatches : (string * int) list) : E.t = if arg == E.undefined then E.undefined else match arg.expression_desc with - | Str {txt} -> + | Str txt -> E.int (Int32.of_int (Ext_list.assoc_by_string dispatches txt None)) | _ -> E.of_block diff --git a/compiler/core/js_pass_flatten_and_mark_dead.ml b/compiler/core/js_pass_flatten_and_mark_dead.ml index 88d900893d4..421a2c76194 100644 --- a/compiler/core/js_pass_flatten_and_mark_dead.ml +++ b/compiler/core/js_pass_flatten_and_mark_dead.ml @@ -205,7 +205,8 @@ let subst_map (substitution : J.expression Hash_ident.t) = let _, e, bindings = Ext_list.fold_left ls (0, [], []) (fun (i, e, acc) x -> match x.expression_desc with - | Var _ | Number _ | Str _ | J.Bool _ | Undefined _ -> + | Var _ | Number _ | Str _ | Template_literal _ | J.Bool _ + | Undefined _ -> (* TODO: check the optimization *) (i + 1, x :: e, acc) | _ -> @@ -268,8 +269,11 @@ let subst_map (substitution : J.expression Hash_ident.t) = when !Js_config.jsx_preserve -> super.expression self x | Some - ({expression_desc = J.Var _ | Number _ | Str _ | Undefined _} as - x) -> + ({ + expression_desc = + ( J.Var _ | Number _ | Str _ | Template_literal _ + | Undefined _ ); + } as x) -> x | None | Some _ -> super.expression self x) | Some _ | None -> super.expression self x) diff --git a/compiler/core/js_pass_scope.ml b/compiler/core/js_pass_scope.ml index bbe453f2e27..477d709d329 100644 --- a/compiler/core/js_pass_scope.ml +++ b/compiler/core/js_pass_scope.ml @@ -224,7 +224,7 @@ let record_scope_pass = TODO: *) match x.expression_desc with - | Fun _ | Number _ | Str _ -> state + | Fun _ | Number _ | Str _ | Template_literal _ -> state | _ -> (* if Set_ident.(is_empty @@ *) (* inter self#get_mutable_values *) diff --git a/compiler/core/js_record_fold.ml b/compiler/core/js_record_fold.ml index 21b55b9ec93..f46bfa62ece 100644 --- a/compiler/core/js_record_fold.ml +++ b/compiler/core/js_record_fold.ml @@ -130,9 +130,9 @@ let expression_desc : 'a. ('a, expression_desc) fn = st | Tagged_template (_xo, _x1, _x2) -> let st = _self.expression _self st _xo in - let st = list _self.expression _self st _x1 in let st = list _self.expression _self st _x2 in st + | Interpolated_template {values} -> list _self.expression _self st values | String_index (_x0, _x1) -> let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in @@ -155,6 +155,8 @@ let expression_desc : 'a. ('a, expression_desc) fn = let st = _self.block _self st body in st | Str _ -> st + | Template_literal _ -> st + | Json_literal _ -> st | Raw_js_code _ -> st | Array _x0 -> list _self.expression _self st _x0 | Optional_block (_x0, _x1) -> diff --git a/compiler/core/js_record_iter.ml b/compiler/core/js_record_iter.ml index d691ff2707d..9eb68ae8e66 100644 --- a/compiler/core/js_record_iter.ml +++ b/compiler/core/js_record_iter.ml @@ -106,8 +106,8 @@ let expression_desc : expression_desc fn = list _self.expression _self _x1 | Tagged_template (_x0, _x1, _x2) -> _self.expression _self _x0; - list _self.expression _self _x1; list _self.expression _self _x2 + | Interpolated_template {values} -> list _self.expression _self values | String_index (_x0, _x1) -> _self.expression _self _x0; _self.expression _self _x1 @@ -123,6 +123,8 @@ let expression_desc : expression_desc fn = list _self.ident _self params; _self.block _self body | Str _ -> () + | Template_literal _ -> () + | Json_literal _ -> () | Raw_js_code _ -> () | Array _x0 -> list _self.expression _self _x0 | Optional_block (_x0, _x1) -> _self.expression _self _x0 diff --git a/compiler/core/js_record_map.ml b/compiler/core/js_record_map.ml index 6a6631a1778..42e54cfd674 100644 --- a/compiler/core/js_record_map.ml +++ b/compiler/core/js_record_map.ml @@ -132,9 +132,11 @@ let expression_desc : expression_desc fn = Call (_x0, _x1, _x2) | Tagged_template (_x0, _x1, _x2) -> let _x0 = _self.expression _self _x0 in - let _x1 = list _self.expression _self _x1 in let _x2 = list _self.expression _self _x2 in Tagged_template (_x0, _x1, _x2) + | Interpolated_template ({values} as template) -> + let values = list _self.expression _self values in + Interpolated_template {template with values} | String_index (_x0, _x1) -> let _x0 = _self.expression _self _x0 in let _x1 = _self.expression _self _x1 in @@ -158,6 +160,8 @@ let expression_desc : expression_desc fn = let body = _self.block _self body in Fun {fun_ with params; body} | Str _ as v -> v + | Template_literal _ as v -> v + | Json_literal _ as v -> v | Raw_js_code _ as v -> v | Array _x0 -> let _x0 = list _self.expression _self _x0 in diff --git a/compiler/core/js_source_map.ml b/compiler/core/js_source_map.ml index 487fe2dadef..e834d2c5dab 100644 --- a/compiler/core/js_source_map.ml +++ b/compiler/core/js_source_map.ml @@ -154,16 +154,19 @@ let utf16_units_in_utf8_slice s start stop = else match String.unsafe_get s i with | '\n' -> loop (i + 1) 0 - | c -> - let byte = Char.code c in - if byte < 0x80 then loop (i + 1) (count + 1) - else if byte land 0xE0 = 0xC0 && i + 1 < stop then - loop (i + 2) (count + 1) - else if byte land 0xF0 = 0xE0 && i + 2 < stop then - loop (i + 3) (count + 1) - else if byte land 0xF8 = 0xF0 && i + 3 < stop then - loop (i + 4) (count + 2) - else loop (i + 1) (count + 1) + | _ -> + let decoded = String.get_utf_8_uchar s i in + let width = Uchar.utf_decode_length decoded in + if i + width > stop then loop (i + 1) (count + 1) + else + let utf16_units = + if + Uchar.utf_decode_is_valid decoded + && Uchar.to_int (Uchar.utf_decode_uchar decoded) > 0xffff + then 2 + else 1 + in + loop (i + width) (count + utf16_units) in loop (max 0 start) 0 diff --git a/compiler/core/js_stmt_make.ml b/compiler/core/js_stmt_make.ml index 3c65adf4a98..14937b04fd9 100644 --- a/compiler/core/js_stmt_make.ml +++ b/compiler/core/js_stmt_make.ml @@ -144,7 +144,7 @@ let string_switch ?(comment : string option) (e : J.expression) (clauses : (Variant_runtime.tag_type * J.case_clause) list) : t = match e.expression_desc with - | Str {txt} -> ( + | Str txt -> ( let continuation = match Ext_list.find_opt clauses (fun (switch_case, x) -> diff --git a/compiler/core/lam_analysis.ml b/compiler/core/lam_analysis.ml index 8b37b0e17bb..3910dde8fcd 100644 --- a/compiler/core/lam_analysis.ml +++ b/compiler/core/lam_analysis.ml @@ -84,15 +84,16 @@ let rec no_side_effects (lam : Lambda.t) : bool = (* Test if the (integer) argument is outside an interval *) (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *) (* Compile time constants *) - | Pstringadd | Phash | Phash_mixstring | Phash_mixint | Phash_finalmix + | Pstringadd | Ptemplate _ | Phash | Phash_mixstring | Phash_mixint + | Phash_finalmix | Praw_js_code {code_info = Exp (Js_function _ | Js_literal _) | Stmt Js_stmt_comment} -> true (* A tagged template invokes its tag at runtime, so it always has side effects. *) - | Ptagged_template | Pjs_call _ | Pinit_mod | Pupdate_mod | Pjs_object_get _ - | Pjs_object_set _ | Pdebugger | Pjs_fn_method + | Ptagged_template _ | Pjs_call _ | Pinit_mod | Pupdate_mod + | Pjs_object_get _ | Pjs_object_set _ | Pdebugger | Pjs_fn_method (* Await promise *) | Pawait (* TODO *) diff --git a/compiler/core/lam_compile_const.ml b/compiler/core/lam_compile_const.ml index 4cef7f14659..b38a6a6492e 100644 --- a/compiler/core/lam_compile_const.ml +++ b/compiler/core/lam_compile_const.ml @@ -60,8 +60,7 @@ and translate (x : Lambda.structured_constant) : J.expression = | Const_char i -> Js_of_lam_string.const_char i | Const_bigint (sign, i) -> E.bigint sign i | Const_float f -> E.float f (* TODO: preserve float *) - | Const_string {s; delim = None | Some DNoQuotes} -> E.str s - | Const_string {s; delim = Some delim} -> E.str ~delim s + | Const_string s -> E.str s | Const_polyvar name -> E.str name | Const_block (tag_info, xs) -> Js_of_lam_block.make_block NA tag_info (Ext_list.map xs translate) @@ -77,4 +76,5 @@ and translate (x : Lambda.structured_constant) : J.expression = let translate_arg_cst (cst : External_arg_spec.cst) = match cst with | Arg_int_lit i -> E.int (Int32.of_int i) - | Arg_string_lit (s, delim) -> E.str s ~delim + | Arg_string_lit s -> E.str s + | Arg_json_lit s -> E.json_literal s diff --git a/compiler/core/lam_compile_primitive.ml b/compiler/core/lam_compile_primitive.ml index 67fa13cefc3..6b3fe8462db 100644 --- a/compiler/core/lam_compile_primitive.ml +++ b/compiler/core/lam_compile_primitive.ml @@ -80,16 +80,13 @@ let translate output_prefix loc (cxt : Lam_compile_context.t) trim can not be done before syntax checking otherwise location is incorrect *) - | Ptagged_template -> ( - (* [tag; strings_array; values_array] -> tag`...` *) + | Ptagged_template strings -> ( + (* [tag; value0; ...] plus raw source segments -> tag`...` *) match args with - | [ - fn; - {expression_desc = Array strings; _}; - {expression_desc = Array values; _}; - ] -> - E.tagged_template fn strings values - | _ -> assert false) + | fn :: values -> E.tagged_template fn strings values + | [] -> assert false) + | Ptemplate [segment] when args = [] -> E.template_literal segment + | Ptemplate segments -> E.interpolated_template segments args | Pnull_to_opt -> ( match args with | [e] -> ( @@ -175,7 +172,8 @@ let translate output_prefix loc (cxt : Lam_compile_context.t) | Psome -> ( let arg = Ext_list.singleton_exn args in match arg.expression_desc with - | Null | Object _ | Number _ | Caml_block _ | Array _ | Str _ -> + | Null | Object _ | Number _ | Caml_block _ | Array _ | Str _ + | Template_literal _ -> (* This makes sense when type info is not available at the definition site, and inline recovered it @@ -523,7 +521,10 @@ let translate output_prefix loc (cxt : Lam_compile_context.t) | _ -> assert false) | Pstringmin -> ( match args with - | [({expression_desc = Str _} as a); ({expression_desc = Str _} as b)] + | [ + ({expression_desc = Str _ | Template_literal _} as a); + ({expression_desc = Str _ | Template_literal _} as b); + ] when Js_analyzer.is_okay_to_duplicate a && Js_analyzer.is_okay_to_duplicate b -> E.econd (E.js_comp Clt a b) a b @@ -531,7 +532,10 @@ let translate output_prefix loc (cxt : Lam_compile_context.t) | _ -> assert false) | Pstringmax -> ( match args with - | [({expression_desc = Str _} as a); ({expression_desc = Str _} as b)] + | [ + ({expression_desc = Str _ | Template_literal _} as a); + ({expression_desc = Str _ | Template_literal _} as b); + ] when Js_analyzer.is_okay_to_duplicate a && Js_analyzer.is_okay_to_duplicate b -> E.econd (E.js_comp Cgt a b) a b @@ -573,7 +577,7 @@ let translate output_prefix loc (cxt : Lam_compile_context.t) (items |> List.filter_map (fun (exp : J.expression) -> match exp.expression_desc with - | Caml_block ([{expression_desc = Str {txt}}; expr], _, _) -> + | Caml_block ([{expression_desc = Str txt}; expr], _, _) -> Some (Js_op.Lit txt, expr) | _ -> None)) | _ -> assert false) diff --git a/compiler/core/lam_pass_lets_dce.ml b/compiler/core/lam_pass_lets_dce.ml index 0012153f06d..9ba1b75283f 100644 --- a/compiler/core/lam_pass_lets_dce.ml +++ b/compiler/core/lam_pass_lets_dce.ml @@ -60,7 +60,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lambda.t -> Hash_ident.add subst v (simplif l1); simplif l2 - | _, Lconst (Const_string {s; delim = None}) -> + | _, Lconst (Const_string s) -> (* only "" added for later inlining *) Hash_ident.add string_table v s; Lambda.let_ Alias v l1 (simplif l2) @@ -105,7 +105,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lambda.t | _ -> ( let l1 = simplif l1 in match l1 with - | Lconst (Const_string {s; delim = None}) -> + | Lconst (Const_string s) -> Hash_ident.add string_table v s; (* we need move [simplif lbody] later, since adding Hash does have side effect *) Lambda.let_ Alias v l1 (simplif lbody) @@ -120,7 +120,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lambda.t let l1 = simplif l1 in match (kind, l1) with - | Strict, Lconst (Const_string {s; delim = None}) -> + | Strict, Lconst (Const_string s) -> Hash_ident.add string_table v s; Lambda.let_ Alias v l1 (simplif l2) | _ -> Lam_util.refine_let ~kind v l1 (simplif l2)) @@ -150,7 +150,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lambda.t let r' = simplif r in let opt_l = match l' with - | Lconst (Const_string {s = ls; delim = None}) -> Some ls + | Lconst (Const_string ls) -> Some ls | Lvar i -> Hash_ident.find_opt string_table i | _ -> None in @@ -159,14 +159,13 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lambda.t | Some l_s -> ( let opt_r = match r' with - | Lconst (Const_string {s = rs; delim = None}) -> Some rs + | Lconst (Const_string rs) -> Some rs | Lvar i -> Hash_ident.find_opt string_table i | _ -> None in match opt_r with | None -> Lambda.prim ~primitive:Pstringadd ~args:[l'; r'] loc - | Some r_s -> Lambda.const (Const_string {s = l_s ^ r_s; delim = None})) - ) + | Some r_s -> Lambda.const (Const_string (l_s ^ r_s)))) | Lglobal_module _ -> lam | Lprim {primitive; args; loc} -> Lambda.prim ~primitive ~args:(Ext_list.map args simplif) loc diff --git a/compiler/core/lam_util.ml b/compiler/core/lam_util.ml index 56d22841725..9ff39c4c1a7 100644 --- a/compiler/core/lam_util.ml +++ b/compiler/core/lam_util.ml @@ -72,6 +72,10 @@ let refine_let ~kind param (arg : Lambda.t) (l : Lambda.t) : Lambda.t = (* var/const --> emitting multiple `const` reads is identical to the original eager evaluation, so codegen may inline them freely. *) true + | Lprim {primitive = Ptemplate [_]; args = []; _} -> + (* A template without interpolations is a JavaScript literal. Repeating + it preserves both its runtime value and its source spelling. *) + true | Lprim { primitive = Pfield (_, Fld_module _); diff --git a/compiler/core/record_attributes_check.ml b/compiler/core/record_attributes_check.ml index 4f8befeb9d2..7b30738b42a 100644 --- a/compiler/core/record_attributes_check.ml +++ b/compiler/core/record_attributes_check.ml @@ -26,19 +26,13 @@ type label = Types.label_description let find_name = Lambda.find_name -let find_name_with_loc (attr : Parsetree.attribute) : string Asttypes.loc option - = - match attr with - | ( {txt = "as"; loc}, - PStr - [ - { - pstr_desc = - Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (s, _))}, _); - }; - ] ) -> - Some {txt = s; loc} - | _ -> None +let find_name_with_loc (({txt; loc}, payload) : Parsetree.attribute) : + string Asttypes.loc option = + if txt = "as" then + Option.map + (fun txt -> {Asttypes.txt; loc}) + (Ast_payload.semantic_string_of_payload payload) + else None let check_bs_attributes_inclusion (attrs1 : Parsetree.attributes) (attrs2 : Parsetree.attributes) lbl_name = diff --git a/compiler/ext/config.ml b/compiler/ext/config.ml index 4c3b18781ca..25c05907f98 100644 --- a/compiler/ext/config.ml +++ b/compiler/ext/config.ml @@ -1,10 +1,10 @@ -let cmi_magic_number = "Caml1999I029" +let cmi_magic_number = "Caml1999I030" (* Magic numbers for marshaled values of the *current* parsetree, whose layout changes across compiler versions. *) -and ast_impl_magic_number = "ResImpl01303" +and ast_impl_magic_number = "ResImpl01304" -and ast_intf_magic_number = "ResIntf01303" +and ast_intf_magic_number = "ResIntf01304" (* Magic numbers of the frozen Parsetree0 (OCaml 4.06) layout used on the external-PPX wire. They must never be written in front of a @@ -13,6 +13,6 @@ and ast0_impl_magic_number = "Caml1999M022" and ast0_intf_magic_number = "Caml1999N022" -and cmt_magic_number = "Caml1999T031" +and cmt_magic_number = "Caml1999T032" let load_path = ref ([] : string list) diff --git a/compiler/ext/ext_pp.ml b/compiler/ext/ext_pp.ml index b3b28a576c9..f196f4830e0 100644 --- a/compiler/ext/ext_pp.ml +++ b/compiler/ext/ext_pp.ml @@ -47,27 +47,18 @@ let update_position t s = t.line <- t.line + 1; t.column <- 0; loop (i + 1) - | c -> - let byte = Char.code c in - (* Source map columns are counted in UTF-16 code units, while OCaml - strings are UTF-8 bytes. Decode only enough UTF-8 structure to - advance the generated column correctly: 1-3 byte sequences are one - UTF-16 code unit, and 4-byte sequences are surrogate pairs. *) - if byte < 0x80 then ( - t.column <- t.column + 1; - loop (i + 1)) - else if byte land 0xE0 = 0xC0 && i + 1 < len then ( - t.column <- t.column + 1; - loop (i + 2)) - else if byte land 0xF0 = 0xE0 && i + 2 < len then ( - t.column <- t.column + 1; - loop (i + 3)) - else if byte land 0xF8 = 0xF0 && i + 3 < len then ( - t.column <- t.column + 2; - loop (i + 4)) - else ( - t.column <- t.column + 1; - loop (i + 1)) + | _ -> + let decoded = String.get_utf_8_uchar s i in + let width = Uchar.utf_decode_length decoded in + let utf16_units = + if + Uchar.utf_decode_is_valid decoded + && Uchar.to_int (Uchar.utf_decode_uchar decoded) > 0xffff + then 2 + else 1 + in + t.column <- t.column + utf16_units; + loop (i + width) in loop 0 diff --git a/compiler/ext/ext_utf8.ml b/compiler/ext/ext_utf8.ml index 04846c1e527..d6dc4f70f6e 100644 --- a/compiler/ext/ext_utf8.ml +++ b/compiler/ext/ext_utf8.ml @@ -22,120 +22,23 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type byte = Single of int | Cont of int | Leading of int * int | Invalid - -(** [classify chr] returns the {!byte} corresponding to [chr] *) -let classify chr = - let c = int_of_char chr in - (* Classify byte according to leftmost 0 bit *) - if c land 0b1000_0000 = 0 then Single c - else if - (* c 0b0____*) - c land 0b0100_0000 = 0 - then Cont (c land 0b0011_1111) - else if - (* c 0b10___*) - c land 0b0010_0000 = 0 - then Leading (1, c land 0b0001_1111) - else if - (* c 0b110__*) - c land 0b0001_0000 = 0 - then Leading (2, c land 0b0000_1111) - else if - (* c 0b1110_ *) - c land 0b0000_1000 = 0 - then Leading (3, c land 0b0000_0111) - else if - (* c 0b1111_0___*) - c land 0b0000_0100 = 0 - then Leading (4, c land 0b0000_0011) - else if - (* c 0b1111_10__*) - c land 0b0000_0010 = 0 - then Leading (5, c land 0b0000_0001) (* c 0b1111_110__ *) - else Invalid - exception Invalid_utf8 of string -(* when the first char is [Leading], - TODO: need more error checking - when out of bond -*) -let rec follow s n (c : int) offset = - if n = 0 then (c, offset) - else - match classify s.[offset + 1] with - | Cont cc -> follow s (n - 1) ((c lsl 6) lor (cc land 0x3f)) (offset + 1) - | _ -> raise (Invalid_utf8 "Continuation byte expected") - -let rec next s ~remaining offset = - if remaining = 0 then offset - else - match classify s.[offset + 1] with - | Cont _cc -> next s ~remaining:(remaining - 1) (offset + 1) - | _ -> -1 - | exception _ -> -1 -(* it can happen when out of bound *) - let decode_utf8_string s = - let lst = ref [] in - let add elem = lst := elem :: !lst in - let rec decode_utf8_cont s i s_len = - if i = s_len then () + let len = String.length s in + let rec loop acc index = + if index = len then List.rev acc else - match classify s.[i] with - | Single c -> - add c; - decode_utf8_cont s (i + 1) s_len - | Cont _ -> raise (Invalid_utf8 "Unexpected continuation byte") - | Leading (n, c) -> - let c', i' = follow s n c i in - add c'; - decode_utf8_cont s (i' + 1) s_len - | Invalid -> raise (Invalid_utf8 "Invalid byte") + let decoded = String.get_utf_8_uchar s index in + if Uchar.utf_decode_is_valid decoded then + loop + (Uchar.to_int (Uchar.utf_decode_uchar decoded) :: acc) + (index + Uchar.utf_decode_length decoded) + else raise (Invalid_utf8 "Invalid UTF-8 sequence") in - decode_utf8_cont s 0 (String.length s); - List.rev !lst - -(** To decode {j||j} we need verify in the ast so that we have better error - location, then we do the decode later -*) - -(* let verify s loc = - assert false *) + loop [] 0 let encode_codepoint c = - (* reused from syntax/src/res_utf8.ml *) - let h2 = 0b1100_0000 in - let h3 = 0b1110_0000 in - let h4 = 0b1111_0000 in - let cont_mask = 0b0011_1111 in - if c <= 127 then ( - let bytes = (Bytes.create [@doesNotRaise]) 1 in - Bytes.unsafe_set bytes 0 (Char.unsafe_chr c); - Bytes.unsafe_to_string bytes) - else if c <= 2047 then ( - let bytes = (Bytes.create [@doesNotRaise]) 2 in - Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h2 lor (c lsr 6))); - Bytes.unsafe_set bytes 1 - (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask))); - Bytes.unsafe_to_string bytes) - else if c <= 65535 then ( - let bytes = (Bytes.create [@doesNotRaise]) 3 in - Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h3 lor (c lsr 12))); - Bytes.unsafe_set bytes 1 - (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask))); - Bytes.unsafe_set bytes 2 - (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask))); - Bytes.unsafe_to_string bytes) - else - (* if c <= max then *) - let bytes = (Bytes.create [@doesNotRaise]) 4 in - Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h4 lor (c lsr 18))); - Bytes.unsafe_set bytes 1 - (Char.unsafe_chr (0b1000_0000 lor ((c lsr 12) land cont_mask))); - Bytes.unsafe_set bytes 2 - (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask))); - Bytes.unsafe_set bytes 3 - (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask))); - Bytes.unsafe_to_string bytes + let buf = Buffer.create 4 in + Buffer.add_utf_8_uchar buf (Uchar.of_int c); + Buffer.contents buf diff --git a/compiler/ext/ext_utf8.mli b/compiler/ext/ext_utf8.mli index e1beadec594..8f8930bc542 100644 --- a/compiler/ext/ext_utf8.mli +++ b/compiler/ext/ext_utf8.mli @@ -22,17 +22,6 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type byte = Single of int | Cont of int | Leading of int * int | Invalid - -val classify : char -> byte - -val follow : string -> int -> int -> int -> int * int - -val next : string -> remaining:int -> int -> int -(** - return [-1] if failed -*) - exception Invalid_utf8 of string val decode_utf8_string : string -> int list diff --git a/compiler/ext/ext_util.ml b/compiler/ext/ext_util.ml index 0b6ca038895..8dc18ce2eb5 100644 --- a/compiler/ext/ext_util.ml +++ b/compiler/ext/ext_util.ml @@ -48,6 +48,7 @@ let string_of_int_as_char (i : int) : string = let s = (Bytes.create [@doesNotRaise]) 1 in Bytes.unsafe_set s 0 c; Bytes.unsafe_to_string s - | _ -> Ext_utf8.encode_codepoint i + | _ when Uchar.is_valid i -> Ext_utf8.encode_codepoint i + | _ -> Printf.sprintf "\\u{%X}" i in Printf.sprintf "\'%s\'" str diff --git a/compiler/frontend/ast_attributes.ml b/compiler/frontend/ast_attributes.ml index 166b04390a5..078cd29e152 100644 --- a/compiler/frontend/ast_attributes.ml +++ b/compiler/frontend/ast_attributes.ml @@ -139,9 +139,9 @@ let iter_process_bs_string_as (attrs : t) : string option = match txt with | "as" -> if !st = None then ( - match Ast_payload.is_single_string payload with + match Ast_payload.semantic_string_of_payload payload with | None -> Bs_syntaxerr.err loc Expect_string_literal - | Some (v, _dec) -> + | Some v -> Used_attributes.mark_used_attribute attr; st := Some v) else raise (Ast_untagged_variants.Error (loc, Duplicated_bs_as)) @@ -176,7 +176,7 @@ let iter_process_bs_int_as (attrs : t) = | _ -> ()); !st -type as_const_payload = Int of int | Str of string * External_arg_spec.delim +type as_const_payload = Int of int | Str of string | Json of string let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) = let st = ref None in @@ -186,43 +186,40 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) = if !st = None then ( Used_attributes.mark_used_attribute attr; match Ast_payload.is_single_int payload with + | Some v -> st := Some (Int v) | None -> ( - match payload with - | PStr - [ - { - pstr_desc = - Pstr_eval - ( { - pexp_desc = Pexp_constant (Pconst_string (s, delim_)); - pexp_loc; - _; - }, - _ ); - _; - }; - ] - when Ast_utf8_string_interp.parse_processed_delim delim_ <> None - -> ( - let delim = - match Ast_utf8_string_interp.parse_processed_delim delim_ with - | None -> assert false - | Some delim -> delim - in - st := Some (Str (s, delim)); - if delim = DNoQuotes then - (* check that it is a valid object literal *) + match Ast_payload.semantic_string_of_payload payload with + | Some s -> st := Some (Str s) + | None -> ( + match payload with + | PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = Pexp_constant (Pconst_json s); + pexp_loc; + _; + }, + _ ); + _; + }; + ] -> ( + st := Some (Json s); + (* Check that it is a valid object literal. *) match Classify_function.classify - ~check:(pexp_loc, Bs_flow_ast_utils.flow_deli_offset delim_) + ~check: + ( pexp_loc, + Bs_flow_ast_utils.flow_deli_offset (Some "json") ) s with | Js_literal _ -> () | _ -> Location.raise_errorf ~loc:pexp_loc "an object literal expected") - | _ -> Bs_syntaxerr.err loc Expect_int_or_string_or_json_literal) - | Some v -> st := Some (Int v)) + | _ -> Bs_syntaxerr.err loc Expect_int_or_string_or_json_literal))) else raise (Ast_untagged_variants.Error (loc, Duplicated_bs_as)) | _ -> ()); !st diff --git a/compiler/frontend/ast_attributes.mli b/compiler/frontend/ast_attributes.mli index 9915f175310..94bfae67bff 100644 --- a/compiler/frontend/ast_attributes.mli +++ b/compiler/frontend/ast_attributes.mli @@ -46,7 +46,7 @@ val has_unwrap_attr : t -> bool val iter_process_bs_int_as : t -> int option -type as_const_payload = Int of int | Str of string * External_arg_spec.delim +type as_const_payload = Int of int | Str of string | Json of string val iter_process_bs_string_or_int_as : t -> as_const_payload option val process_derive_type : t -> derive_attr * t diff --git a/compiler/frontend/ast_config.ml b/compiler/frontend/ast_config.ml index bb727f68217..70d4547c181 100644 --- a/compiler/frontend/ast_config.ml +++ b/compiler/frontend/ast_config.ml @@ -47,8 +47,9 @@ let process_directives str = |> List.iter (fun (item : Parsetree.structure_item) -> match item.pstr_desc with | Pstr_attribute ({txt = "directive"}, payload) -> ( - match Ast_payload.is_single_string payload with - | Some (d, _) -> Js_config.directives := !Js_config.directives @ [d] + Ast_payload.reject_json_literal_payload payload; + match Ast_payload.semantic_string_of_payload payload with + | Some d -> Js_config.directives := !Js_config.directives @ [d] | None -> Bs_syntaxerr.err item.pstr_loc Expect_string_literal) | _ -> ()) diff --git a/compiler/frontend/ast_exp_extension.ml b/compiler/frontend/ast_exp_extension.ml index c26a63fa557..bc51df89a96 100644 --- a/compiler/frontend/ast_exp_extension.ml +++ b/compiler/frontend/ast_exp_extension.ml @@ -27,9 +27,10 @@ let handle_extension e (_self : Ast_mapper.mapper) (({txt; loc}, payload) : Parsetree.extension) = match txt with | "todo" -> + Ast_payload.reject_json_literal_payload payload; let todo_message = - match Ast_payload.is_single_string payload with - | Some (s, _) -> Some s + match Ast_payload.semantic_string_of_payload payload with + | Some s -> Some s | None -> None in Location.prerr_warning e.Parsetree.pexp_loc (Bs_todo todo_message); @@ -47,13 +48,12 @@ let handle_extension e (_self : Ast_mapper.mapper) [ ( Nolabel, Exp.constant ~loc - (Pconst_string - ( (pretext - ^ - match todo_message with - | None -> " - Todo" - | Some msg -> " - Todo: " ^ msg), - None )) ); + (Ast_helper.Const.string + (pretext + ^ + match todo_message with + | None -> " - Todo" + | Some msg -> " - Todo: " ^ msg)) ); ] | "ffi" -> Ast_exp_handle_external.handle_ffi ~loc ~payload | "raw" -> Ast_exp_handle_external.handle_raw ~kind:Raw_exp loc payload diff --git a/compiler/frontend/ast_external_mk.ml b/compiler/frontend/ast_external_mk.ml index 0c27344d18d..817270fedf1 100644 --- a/compiler/frontend/ast_external_mk.ml +++ b/compiler/frontend/ast_external_mk.ml @@ -48,10 +48,7 @@ let inline_const (c : External_ffi_types.inline_const) : Parsetree.primitive_repr = Prim_inline_const c -let inline_string (s : string) (delim_raw : string option) = - inline_const - (Const_str - {s; delim = Ast_utf8_string_interp.parse_processed_delim delim_raw}) +let inline_string semantic = inline_const (Const_string semantic) let inline_bool b = inline_const (Const_bool b) diff --git a/compiler/frontend/ast_external_mk.mli b/compiler/frontend/ast_external_mk.mli index 86625df063d..7ecd8b5d184 100644 --- a/compiler/frontend/ast_external_mk.mli +++ b/compiler/frontend/ast_external_mk.mli @@ -42,7 +42,7 @@ val local_external_apply : ]} *) -val inline_string : string -> string option -> Parsetree.primitive_repr +val inline_string : string -> Parsetree.primitive_repr val inline_bool : bool -> Parsetree.primitive_repr diff --git a/compiler/frontend/ast_external_process.ml b/compiler/frontend/ast_external_process.ml index a3400da8838..b64aae652a8 100644 --- a/compiler/frontend/ast_external_process.ml +++ b/compiler/frontend/ast_external_process.ml @@ -89,7 +89,8 @@ let refine_arg_type ~(nolabel : bool) (ptyp : Ast_core_type.t) : | Int i -> (* This type is used in obj only to construct obj type*) Arg_cst (External_arg_spec.cst_int i) - | Str (i, delim) -> Arg_cst (External_arg_spec.cst_string i delim)) + | Str s -> Arg_cst (External_arg_spec.cst_string s) + | Json s -> Arg_cst (External_arg_spec.cst_json s)) else (* ([`a|`b] [@string]) *) spec_of_ptyp nolabel ptyp @@ -109,9 +110,10 @@ let refine_obj_arg_type ~(nolabel : bool) (ptyp : Ast_core_type.t) : (* @as(24) *) (* This type is used in obj only to construct obj type *) Arg_cst (External_arg_spec.cst_int i) - | Some (Str (s, delim)) -> + | Some (Str s) -> (* @as("foo") *) - Arg_cst (External_arg_spec.cst_string s delim)) + Arg_cst (External_arg_spec.cst_string s) + | Some (Json s) -> Arg_cst (External_arg_spec.cst_json s)) else (* ([`a|`b] [@string]) *) spec_of_ptyp nolabel ptyp @@ -208,8 +210,9 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string) | PStr [] -> prim_name_or_pval_prim (* It is okay to have [@@val] without payload *) | _ -> ( - match Ast_payload.is_single_string payload with - | Some (val_name, _) -> {name = val_name; source = Payload} + Ast_payload.reject_json_literal_payload payload; + match Ast_payload.semantic_string_of_payload payload with + | Some val_name -> {name = val_name; source = Payload} | None -> Location.raise_errorf ~loc "Invalid payload") in @@ -258,12 +261,15 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string) let from_name = ref None in let with_ = ref None in Ext_list.iter fields (fun {lid = l; x = exp} -> - match (l, exp.pexp_desc) with - | {txt = Lident "from"}, Pexp_constant (Pconst_string (s, _)) - -> - from_name := Some s - | {txt = Lident "with"}, Pexp_record (fields, _) -> - with_ := Some fields + match l with + | {txt = Lident "from"} -> ( + match Ast_payload.semantic_string_of_expression exp with + | Some name -> from_name := Some name + | None -> ()) + | {txt = Lident "with"} -> ( + match exp.pexp_desc with + | Pexp_record (fields, _) -> with_ := Some fields + | _ -> ()) | _ -> ()); match (!from_name, !with_) with | None, _ -> @@ -280,8 +286,8 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string) | Some from_name, Some with_fields -> let import_attributes_from_record = Ext_list.filter_map with_fields (fun {lid = l; x = exp} -> - match exp.pexp_desc with - | Pexp_constant (Pconst_string (s, _)) -> ( + match Ast_payload.semantic_string_of_expression exp with + | Some s -> ( match l.txt with | Longident.Lident "type_" -> Some ("type", s) | Longident.Lident txt -> Some (txt, s) diff --git a/compiler/frontend/ast_utf8_string.ml b/compiler/frontend/ast_utf8_string.ml deleted file mode 100644 index 75b17029346..00000000000 --- a/compiler/frontend/ast_utf8_string.ml +++ /dev/null @@ -1,209 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type error = - | Invalid_code_point - | Unterminated_backslash - | Invalid_hex_escape - | Invalid_unicode_escape - | Invalid_unicode_codepoint_escape - -let pp_error fmt err = - Format.pp_print_string fmt - @@ - match err with - | Invalid_code_point -> "Invalid code point" - | Unterminated_backslash -> "\\ ended unexpectedly" - | Invalid_hex_escape -> "Invalid \\x escape" - | Invalid_unicode_escape -> "Invalid \\u escape" - | Invalid_unicode_codepoint_escape -> - "Invalid \\u{…} codepoint escape sequence" - -type exn += Error of int (* offset *) * error - -let error ~loc error = raise (Error (loc, error)) - -(** Note the [loc] really should be the utf8-offset, it has nothing to do with our - escaping mechanism -*) -(* we can not just print new line in ES5 - seems we don't need - escape "\b" "\f" - we need escape "\n" "\r" since - ocaml multiple-line allows [\n] - visual input while es5 string - does not*) - -let rec check_and_transform (loc : int) (buf : Buffer.t) (s : string) - (byte_offset : int) (s_len : int) = - if byte_offset = s_len then () - else - let current_char = s.[byte_offset] in - match Ext_utf8.classify current_char with - | Single 92 (* '\\' *) -> - escape_code (loc + 1) buf s (byte_offset + 1) s_len - | Single 34 -> - Buffer.add_string buf "\\\""; - check_and_transform (loc + 1) buf s (byte_offset + 1) s_len - | Single 10 -> - Buffer.add_string buf "\\n"; - check_and_transform (loc + 1) buf s (byte_offset + 1) s_len - | Single 13 -> - Buffer.add_string buf "\\r"; - check_and_transform (loc + 1) buf s (byte_offset + 1) s_len - | Single _ -> - Buffer.add_char buf current_char; - check_and_transform (loc + 1) buf s (byte_offset + 1) s_len - | Invalid | Cont _ -> error ~loc Invalid_code_point - | Leading (n, _) -> - let i' = Ext_utf8.next s ~remaining:n byte_offset in - if i' < 0 then error ~loc Invalid_code_point - else ( - for k = byte_offset to i' do - Buffer.add_char buf s.[k] - done; - check_and_transform (loc + 1) buf s (i' + 1) s_len) - -(* we share the same escape sequence with js *) -and escape_code loc buf s offset s_len = - if offset >= s_len then error ~loc Unterminated_backslash - else Buffer.add_char buf '\\'; - let cur_char = s.[offset] in - match cur_char with - | '\\' | 'b' | 't' | 'n' | 'v' | 'f' | 'r' | '0' | '$' -> - Buffer.add_char buf cur_char; - check_and_transform (loc + 1) buf s (offset + 1) s_len - | 'u' -> - if offset + 1 >= s_len then error ~loc Invalid_unicode_escape - else ( - Buffer.add_char buf cur_char; - let next_char = s.[offset + 1] in - match next_char with - | '{' -> - Buffer.add_char buf next_char; - unicode_codepoint_escape (loc + 2) buf s (offset + 2) s_len - | _ -> unicode (loc + 1) buf s (offset + 1) s_len) - | 'x' -> - Buffer.add_char buf cur_char; - two_hex (loc + 1) buf s (offset + 1) s_len - | _ -> - (* Regular characters, like `a` in `\a`, - * are valid escape sequences *) - Buffer.add_char buf cur_char; - check_and_transform (loc + 1) buf s (offset + 1) s_len - -and two_hex loc buf s offset s_len = - if offset + 1 >= s_len then error ~loc Invalid_hex_escape; - (*Location.raise_errorf ~loc "\\x need at least two chars";*) - let a, b = (s.[offset], s.[offset + 1]) in - if Ext_char.valid_hex a && Ext_char.valid_hex b then ( - Buffer.add_char buf a; - Buffer.add_char buf b; - check_and_transform (loc + 2) buf s (offset + 2) s_len) - else error ~loc Invalid_hex_escape -(*Location.raise_errorf ~loc "%c%c is not a valid hex code" a b*) - -and unicode loc buf s offset s_len = - if offset + 3 >= s_len then error ~loc Invalid_unicode_escape - (*Location.raise_errorf ~loc "\\u need at least four chars"*); - let a0, a1, a2, a3 = - (s.[offset], s.[offset + 1], s.[offset + 2], s.[offset + 3]) - in - if - Ext_char.valid_hex a0 && Ext_char.valid_hex a1 && Ext_char.valid_hex a2 - && Ext_char.valid_hex a3 - then ( - Buffer.add_char buf a0; - Buffer.add_char buf a1; - Buffer.add_char buf a2; - Buffer.add_char buf a3; - check_and_transform (loc + 4) buf s (offset + 4) s_len) - else error ~loc Invalid_unicode_escape - -(*Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point" - a0 a1 a2 a3 *) -(* http://www.2ality.com/2015/01/es6-strings.html - console.log('\uD83D\uDE80'); (* ES6*) - console.log('\u{1F680}'); -*) - -(* ES6 unicode codepoint escape sequences: \u{…} - https://262.ecma-international.org/6.0/#sec-literals-string-literals *) -and unicode_codepoint_escape loc buf s offset s_len = - if offset >= s_len then error ~loc Invalid_unicode_codepoint_escape - else - let cur_char = s.[offset] in - match cur_char with - | '}' -> - Buffer.add_char buf cur_char; - let x = ref 0 in - for ix = loc to offset - 1 do - let c = s.[ix] in - let value = - match c with - | '0' .. '9' -> Char.code c - 48 - | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10 - | 'A' .. 'F' -> Char.code c + 32 - Char.code 'a' + 10 - | _ -> 16 - (* larger than any legal value, unicode_codepoint_escape only makes progress if we have valid hex symbols *) - in - (* too long escape sequence will result in an overflow, perform an upperbound check *) - if !x > 0x10FFFF then error ~loc Invalid_unicode_codepoint_escape - else x := (!x * 16) + value - done; - if Uchar.is_valid !x then - check_and_transform (offset + 1) buf s (offset + 1) s_len - else error ~loc Invalid_unicode_codepoint_escape - | _ -> - if Ext_char.valid_hex cur_char then ( - Buffer.add_char buf cur_char; - unicode_codepoint_escape loc buf s (offset + 1) s_len) - else error ~loc Invalid_unicode_codepoint_escape - -let transform_test s = - let s_len = String.length s in - let buf = Buffer.create (s_len * 2) in - check_and_transform 0 buf s 0 s_len; - Buffer.contents buf - -let transform loc s = - let s_len = String.length s in - let buf = Buffer.create (s_len * 2) in - try - check_and_transform 0 buf s 0 s_len; - 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) diff --git a/compiler/frontend/ast_utf8_string.mli b/compiler/frontend/ast_utf8_string.mli deleted file mode 100644 index 588125f4250..00000000000 --- a/compiler/frontend/ast_utf8_string.mli +++ /dev/null @@ -1,40 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type error - -type exn += Error of int (* offset *) * error - -val pp_error : Format.formatter -> error -> unit - -(* module Interp : sig *) -(* val check_and_transform : int -> string -> int -> cxt -> unit *) -(* val transform_test : string -> segments *) -(* end *) -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 diff --git a/compiler/frontend/ast_utf8_string_interp.ml b/compiler/frontend/ast_utf8_string_interp.ml deleted file mode 100644 index 54671716407..00000000000 --- a/compiler/frontend/ast_utf8_string_interp.ml +++ /dev/null @@ -1,329 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type error = - | Invalid_code_point - | Unterminated_backslash - | Invalid_escape_code of char - | Invalid_hex_escape - | Invalid_unicode_escape - | Unterminated_variable - | Unmatched_paren - | Invalid_syntax_of_var of string - -type kind = String | Var of int * int -(* [Var (loffset, roffset)] - For parens it used to be (2,-1) - for non-parens it used to be (1,0) -*) - -type pos = { - lnum: int; - offset: int; - byte_bol: int; - (* Note it actually needs to be in sync with OCaml's lexing semantics *) -} -(** Note the position is about code point *) - -type segment = {start: pos; finish: pos; kind: kind; content: string} -type segments = segment list - -type cxt = { - mutable segment_start: pos; - buf: Buffer.t; - s_len: int; - mutable segments: segments; - mutable pos_bol: int; - (* record the abs position of current beginning line *) - mutable byte_bol: int; - mutable pos_lnum: int; (* record the line number *) -} - -type exn += Error of pos * pos * error - -let valid_lead_identifier_char x = - match x with - | 'a' .. 'z' | '_' -> true - | _ -> false - -(** Invariant: [valid_lead_identifier] has to be [valid_identifier] *) -let valid_identifier_char x = - match x with - | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '\'' -> true - | _ -> false - -let valid_identifier s = - let s_len = String.length s in - if s_len = 0 then false - else - valid_lead_identifier_char s.[0] - && Ext_string.for_all_from s 1 valid_identifier_char - -(* let is_space x = - match x with - | ' ' | '\n' | '\t' -> true - | _ -> false *) - -(** Note [Var] kind can not be mpty *) -let empty_segment {content} = Ext_string.is_empty content - -let update_newline ~byte_bol loc cxt = - cxt.pos_lnum <- cxt.pos_lnum + 1; - cxt.pos_bol <- loc; - cxt.byte_bol <- byte_bol - -let pos_error cxt ~loc error = - raise - (Error - ( cxt.segment_start, - { - lnum = cxt.pos_lnum; - offset = loc - cxt.pos_bol; - byte_bol = cxt.byte_bol; - }, - error )) - -let add_var_segment cxt loc loffset roffset = - let content = Buffer.contents cxt.buf in - Buffer.clear cxt.buf; - let next_loc = - {lnum = cxt.pos_lnum; offset = loc - cxt.pos_bol; byte_bol = cxt.byte_bol} - in - if valid_identifier content then ( - cxt.segments <- - { - start = cxt.segment_start; - finish = next_loc; - kind = Var (loffset, roffset); - content; - } - :: cxt.segments; - cxt.segment_start <- next_loc) - else pos_error cxt ~loc (Invalid_syntax_of_var content) - -let add_str_segment cxt loc = - let content = Buffer.contents cxt.buf in - Buffer.clear cxt.buf; - let next_loc = - {lnum = cxt.pos_lnum; offset = loc - cxt.pos_bol; byte_bol = cxt.byte_bol} - in - cxt.segments <- - {start = cxt.segment_start; finish = next_loc; kind = String; content} - :: cxt.segments; - cxt.segment_start <- next_loc - -let rec check_and_transform (loc : int) s byte_offset - ({s_len; buf} as cxt : cxt) = - if byte_offset = s_len then add_str_segment cxt loc - else - let current_char = s.[byte_offset] in - match Ext_utf8.classify current_char with - | Single 92 (* '\\' *) -> escape_code (loc + 1) s (byte_offset + 1) cxt - | Single 34 -> - Buffer.add_string buf "\\\""; - check_and_transform (loc + 1) s (byte_offset + 1) cxt - | Single 10 -> - Buffer.add_string buf "\\n"; - let loc = loc + 1 in - let byte_offset = byte_offset + 1 in - update_newline ~byte_bol:byte_offset loc cxt; - (* Note variable could not have new-line *) - check_and_transform loc s byte_offset cxt - | Single 13 -> - Buffer.add_string buf "\\r"; - check_and_transform (loc + 1) s (byte_offset + 1) cxt - | Single 36 -> - (* $ *) - add_str_segment cxt loc; - let offset = byte_offset + 1 in - if offset >= s_len then pos_error ~loc cxt Unterminated_variable - else - let cur_char = s.[offset] in - if cur_char = '(' then expect_var_paren (loc + 2) s (offset + 1) cxt - else expect_simple_var (loc + 1) s offset cxt - | Single _ -> - Buffer.add_char buf current_char; - check_and_transform (loc + 1) s (byte_offset + 1) cxt - | Invalid | Cont _ -> pos_error ~loc cxt Invalid_code_point - | Leading (n, _) -> - let i' = Ext_utf8.next s ~remaining:n byte_offset in - if i' < 0 then pos_error cxt ~loc Invalid_code_point - else ( - for k = byte_offset to i' do - Buffer.add_char buf s.[k] - done; - check_and_transform (loc + 1) s (i' + 1) cxt) - -(* Lets keep identifier simple, so that we could generating a function easier in the future - for example - let f = [%fn{| $x + $y = $x_add_y |}] -*) -and expect_simple_var loc s offset ({buf; s_len} as cxt) = - let v = ref offset in - (* prerr_endline @@ Ext_pervasives.dump (s, has_paren, (is_space s.[!v]), !v); *) - if not (offset < s_len && valid_lead_identifier_char s.[offset]) then - pos_error cxt ~loc (Invalid_syntax_of_var Ext_string.empty) - else ( - while !v < s_len && valid_identifier_char s.[!v] do - (* TODO*) - let cur_char = s.[!v] in - Buffer.add_char buf cur_char; - incr v - done; - let added_length = !v - offset in - let loc = added_length + loc in - add_var_segment cxt loc 1 0; - check_and_transform loc s (added_length + offset) cxt) - -and expect_var_paren loc s offset ({buf; s_len} as cxt) = - let v = ref offset in - (* prerr_endline @@ Ext_pervasives.dump (s, has_paren, (is_space s.[!v]), !v); *) - while !v < s_len && s.[!v] <> ')' do - let cur_char = s.[!v] in - Buffer.add_char buf cur_char; - incr v - done; - let added_length = !v - offset in - let loc = added_length + 1 + loc in - if !v < s_len && s.[!v] = ')' then ( - add_var_segment cxt loc 2 (-1); - check_and_transform loc s (added_length + 1 + offset) cxt) - else pos_error cxt ~loc Unmatched_paren - -(* we share the same escape sequence with js *) -and escape_code loc s offset ({buf; s_len} as cxt) = - if offset >= s_len then pos_error cxt ~loc Unterminated_backslash - else Buffer.add_char buf '\\'; - let cur_char = s.[offset] in - match cur_char with - | '\\' | 'b' | 't' | 'n' | 'v' | 'f' | 'r' | '0' | '$' -> - Buffer.add_char buf cur_char; - check_and_transform (loc + 1) s (offset + 1) cxt - | 'u' -> - Buffer.add_char buf cur_char; - unicode (loc + 1) s (offset + 1) cxt - | 'x' -> - Buffer.add_char buf cur_char; - two_hex (loc + 1) s (offset + 1) cxt - | _ -> pos_error cxt ~loc (Invalid_escape_code cur_char) - -and two_hex loc s offset ({buf; s_len} as cxt) = - if offset + 1 >= s_len then pos_error cxt ~loc Invalid_hex_escape; - let a, b = (s.[offset], s.[offset + 1]) in - if Ext_char.valid_hex a && Ext_char.valid_hex b then ( - Buffer.add_char buf a; - Buffer.add_char buf b; - check_and_transform (loc + 2) s (offset + 2) cxt) - else pos_error cxt ~loc Invalid_hex_escape - -and unicode loc s offset ({buf; s_len} as cxt) = - if offset + 3 >= s_len then pos_error cxt ~loc Invalid_unicode_escape; - let a0, a1, a2, a3 = - (s.[offset], s.[offset + 1], s.[offset + 2], s.[offset + 3]) - in - if - Ext_char.valid_hex a0 && Ext_char.valid_hex a1 && Ext_char.valid_hex a2 - && Ext_char.valid_hex a3 - then ( - Buffer.add_char buf a0; - Buffer.add_char buf a1; - Buffer.add_char buf a2; - Buffer.add_char buf a3; - check_and_transform (loc + 4) s (offset + 4) cxt) - else pos_error cxt ~loc Invalid_unicode_escape - -let transform_test s = - let s_len = String.length s in - let buf = Buffer.create (s_len * 2) in - let cxt = - { - segment_start = {lnum = 0; offset = 0; byte_bol = 0}; - buf; - s_len; - segments = []; - pos_lnum = 0; - byte_bol = 0; - pos_bol = 0; - } - in - check_and_transform 0 s 0 cxt; - List.rev cxt.segments - -module Delim = struct - type interpolation = - | BackQuotes (* string interpolation *) - | Js (* simple double quoted string *) - | Unrecognized (* no interpolation: delimiter not recognized *) - let parse_unprocessed is_template = function - | "js" -> if is_template then BackQuotes else Js - | _ -> Unrecognized - - let escaped_j_delimiter = "*j" (* not user level syntax allowed *) - let some_escaped_back_quote_delimiter = Some "bq" - let some_escaped_j_delimiter = Some escaped_j_delimiter -end - -let transform_exp (e : Parsetree.expression) s delim : Parsetree.expression = - let is_template = - Ext_list.exists e.pexp_attributes (fun ({txt}, _) -> - match txt with - | "res.template" | "res.taggedTemplate" -> true - | _ -> false) - in - match Delim.parse_unprocessed is_template delim with - | Js -> - let js_str = Ast_utf8_string.transform e.pexp_loc s in - { - e with - pexp_desc = - Pexp_constant (Pconst_string (js_str, Delim.some_escaped_j_delimiter)); - } - | BackQuotes -> - { - e with - pexp_desc = - Pexp_constant - (Pconst_string (s, Delim.some_escaped_back_quote_delimiter)); - } - | Unrecognized -> e - -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 - { - p with - ppat_desc = - Ppat_constant (Pconst_string (js_str, Delim.some_escaped_j_delimiter)); - } - | BackQuotes -> - { - p with - ppat_desc = - Ppat_constant - (Pconst_string (s, Delim.some_escaped_back_quote_delimiter)); - } - | Unrecognized -> p - -let parse_processed_delim = External_arg_spec.parse_processed_delim diff --git a/compiler/frontend/ast_utf8_string_interp.mli b/compiler/frontend/ast_utf8_string_interp.mli deleted file mode 100644 index a09698ddb5d..00000000000 --- a/compiler/frontend/ast_utf8_string_interp.mli +++ /dev/null @@ -1,61 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type kind = String | Var of int * int (* int records its border length *) - -type error = private - | Invalid_code_point - | Unterminated_backslash - | Invalid_escape_code of char - | Invalid_hex_escape - | Invalid_unicode_escape - | Unterminated_variable - | Unmatched_paren - | Invalid_syntax_of_var of string - -type pos = {lnum: int; offset: int; byte_bol: int} -(** Note the position is about code point *) - -type segment = {start: pos; finish: pos; kind: kind; content: string} -type segments = segment list - -type cxt = { - mutable segment_start: pos; - buf: Buffer.t; - s_len: int; - mutable segments: segments; - mutable pos_bol: int; - (* record the abs position of current beginning line *) - mutable byte_bol: int; - mutable pos_lnum: int; (* record the line number *) -} - -type exn += Error of pos * pos * error - -val empty_segment : segment -> bool -val transform_test : string -> segment list -val transform_exp : - Parsetree.expression -> string -> string -> Parsetree.expression -val transform_pat : Parsetree.pattern -> string -> string -> Parsetree.pattern -val parse_processed_delim : string option -> External_arg_spec.delim option diff --git a/compiler/frontend/bs_builtin_ppx.ml b/compiler/frontend/bs_builtin_ppx.ml index ac2a2fcd4cb..25fc5eb04f2 100644 --- a/compiler/frontend/bs_builtin_ppx.ml +++ b/compiler/frontend/bs_builtin_ppx.ml @@ -94,8 +94,9 @@ let pat_mapper (self : mapper) (p : Parsetree.pattern) = match p.ppat_desc with | Ppat_constant (Pconst_integer (s, Some 'l')) -> {p with ppat_desc = Ppat_constant (Pconst_integer (s, None))} - | Ppat_constant (Pconst_string (s, Some delim)) -> - Ast_utf8_string_interp.transform_pat p s delim + | Ppat_constant (Pconst_json _) -> + Location.raise_errorf ~loc:p.ppat_loc + "Tagged template literals are not supported in patterns" | _ -> default_pat_mapper self p (* Unpack requires core_type package for type inference: @@ -113,8 +114,6 @@ let expr_mapper ~async_context ~in_function_def (self : mapper) (* Its output should not be rewritten anymore *) | Pexp_extension extension -> Ast_exp_extension.handle_extension e self extension - | Pexp_constant (Pconst_string (s, Some delim)) -> - Ast_utf8_string_interp.transform_exp e s delim | Pexp_constant (Pconst_integer (s, Some 'l')) -> {e with pexp_desc = Pexp_constant (Pconst_integer (s, None))} (* End rewriting *) @@ -442,9 +441,18 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) : Ast_external.handle_external_in_sig self value_desc sigi else match Ast_attributes.has_inline_payload pval_attributes with - | Some ((_, PStr [{pstr_desc = Pstr_eval ({pexp_desc}, _)}]) as attr) -> ( + | Some + (( _, + PStr [{pstr_desc = Pstr_eval (({pexp_desc; _} as expression), _)}] + ) as attr) -> ( match pexp_desc with - | Pexp_constant (Pconst_string (s, dec)) -> + | Pexp_constant (Pconst_string _) + | Pexp_template {source_segments = [_]; values = []} -> + let semantic = + match Ast_payload.semantic_string_of_expression expression with + | Some semantic -> semantic + | None -> assert false + in succeed attr pval_attributes; { sigi with @@ -452,7 +460,7 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) : Psig_value { value_desc with - pval_prim = Some (Ast_external_mk.inline_string s dec); + pval_prim = Some (Ast_external_mk.inline_string semantic); pval_attributes = []; }; } @@ -554,8 +562,18 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) : let has_inline_property = Ast_attributes.has_inline_payload pvb_attributes in + Option.iter + (fun (_, payload) -> Ast_payload.reject_json_literal_payload payload) + has_inline_property; match (has_inline_property, pvb_expr.pexp_desc) with - | Some attr, Pexp_constant (Pconst_string (s, dec)) -> + | ( Some attr, + ( Pexp_constant (Pconst_string _) + | Pexp_template {source_segments = [_]; values = []} ) ) -> + let semantic = + match Ast_payload.semantic_string_of_expression pvb_expr with + | Some semantic -> semantic + | None -> assert false + in succeed attr pvb_attributes; { str with @@ -566,7 +584,7 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) : pval_type = Ast_literal.type_string (); pval_loc = pvb_loc; pval_attributes = []; - pval_prim = Some (Ast_external_mk.inline_string s dec); + pval_prim = Some (Ast_external_mk.inline_string semantic); }; } | Some attr, Pexp_constant (Pconst_integer (s, None)) -> diff --git a/compiler/frontend/ppx_entry.ml b/compiler/frontend/ppx_entry.ml index e86949064f7..701203f1b18 100644 --- a/compiler/frontend/ppx_entry.ml +++ b/compiler/frontend/ppx_entry.ml @@ -24,6 +24,28 @@ let unsafe_mapper = Bs_builtin_ppx.mapper +(* [json] payloads are syntax-level expressions until built-in FFI processing + consumes valid [@as(json`...`)] occurrences. Reject anything left only + after that processing, so generic attributes and ordinary expressions + cannot reinterpret them as strings. *) +let unconsumed_json_iterator = + let default = Ast_iterator.default_iterator in + { + default with + expr = + (fun self expression -> + match expression.pexp_desc with + | Pexp_constant (Pconst_json _) -> + Ast_payload.reject_json_literal ~loc:expression.pexp_loc + | _ -> default.expr self expression); + pat = + (fun self pattern -> + match pattern.ppat_desc with + | Ppat_constant (Pconst_json _) -> + Ast_payload.reject_json_literal ~loc:pattern.ppat_loc + | _ -> default.pat self pattern); + } + let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature = Bs_ast_invariant.iter_warnings_on_sigi ast; Ast_config.process_sig ast; @@ -39,6 +61,7 @@ let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature = if !Js_config.no_builtin_ppx then ast else let result = unsafe_mapper.signature unsafe_mapper ast in + unconsumed_json_iterator.signature unconsumed_json_iterator result; (* Keep this check, since the check is not inexpensive*) Bs_ast_invariant.emit_external_warnings_on_signature result; result @@ -58,6 +81,7 @@ let rewrite_implementation (ast : Parsetree.structure) : Parsetree.structure = if !Js_config.no_builtin_ppx then ast else let result = unsafe_mapper.structure unsafe_mapper ast in + unconsumed_json_iterator.structure unconsumed_json_iterator result; (* Keep this check since it is not inexpensive*) Bs_ast_invariant.emit_external_warnings_on_structure result; result diff --git a/compiler/gentype/annotation.ml b/compiler/gentype/annotation.ml index ca357984fea..998f9d35338 100644 --- a/compiler/gentype/annotation.ml +++ b/compiler/gentype/annotation.ml @@ -42,29 +42,32 @@ let tag_is_intern_local s = s = "internal.local" let rec get_attribute_payload check_text (attributes : Typedtree.attributes) = let rec from_expr (expr : Parsetree.expression) = - match expr with - | {pexp_desc = Pexp_constant (Pconst_string (s, _))} -> - Some (StringPayload s) - | {pexp_desc = Pexp_constant (Pconst_integer (n, _))} -> Some (IntPayload n) - | {pexp_desc = Pexp_constant (Pconst_float (s, _))} -> Some (FloatPayload s) - | { - pexp_desc = Pexp_construct ({txt = Lident (("true" | "false") as s)}, _); - _; - } -> - Some (BoolPayload (s = "true")) - | {pexp_desc = Pexp_tuple exprs} -> - let payloads = - exprs |> List.rev - |> List.fold_left - (fun payloads expr -> - match expr |> from_expr with - | Some payload -> payload :: payloads - | None -> payloads) - [] - in - Some (TuplePayload payloads) - | {pexp_desc = Pexp_ident {txt}} -> Some (IdentPayload txt) - | _ -> None + match Ast_payload.semantic_string_of_expression expr with + | Some s -> Some (StringPayload s) + | None -> ( + match expr with + | {pexp_desc = Pexp_constant (Pconst_integer (n, _))} -> + Some (IntPayload n) + | {pexp_desc = Pexp_constant (Pconst_float (s, _))} -> + Some (FloatPayload s) + | { + pexp_desc = Pexp_construct ({txt = Lident (("true" | "false") as s)}, _); + _; + } -> + Some (BoolPayload (s = "true")) + | {pexp_desc = Pexp_tuple exprs} -> + let payloads = + exprs |> List.rev + |> List.fold_left + (fun payloads expr -> + match expr |> from_expr with + | Some payload -> payload :: payloads + | None -> payloads) + [] + in + Some (TuplePayload payloads) + | {pexp_desc = Pexp_ident {txt}} -> Some (IdentPayload txt) + | _ -> None) in match attributes with | [] -> None diff --git a/compiler/gentype/emit_text.ml b/compiler/gentype/emit_text.ml index 3cc68260c5c..4cc877a0e88 100644 --- a/compiler/gentype/emit_text.ml +++ b/compiler/gentype/emit_text.ml @@ -8,6 +8,8 @@ let generics_string ~type_vars = | true -> "" | false -> "<" ^ String.concat "," type_vars ^ ">" +let escape_string_contents = String_literal.encode_js_string + let quotes x = "\"" ^ x ^ "\"" let field_access ~label value = value ^ "." ^ label diff --git a/compiler/gentype/import_path.ml b/compiler/gentype/import_path.ml index d9bd7b670c5..a2f469af2cf 100644 --- a/compiler/gentype/import_path.ml +++ b/compiler/gentype/import_path.ml @@ -29,4 +29,41 @@ let to_cmt ~(config : Config.t) ~output_file_relative (dir, s) = | Some name -> "-" ^ name) ^ ".cmt" -let emit (dir, s) = (dir, s) |> dump +(* Import paths are emitted inside single-quoted JavaScript/TypeScript string + literals and also repeated in line comments. The AST stores their semantic + value, so restore source escapes at this final output boundary. Escaping the + Unicode line separators keeps them from terminating those comments. *) +let escape_for_single_quotes s = + let buf = Buffer.create (String.length s) in + let len = String.length s in + let rec loop i = + if i < len then + (* The UTF-8 encodings of U+2028 and U+2029 differ only in their final + byte. Preserve all other UTF-8 text verbatim. *) + if + i + 2 < len + && s.[i] = '\226' + && s.[i + 1] = '\128' + && (s.[i + 2] = '\168' || s.[i + 2] = '\169') + then ( + Buffer.add_string buf + (if s.[i + 2] = '\168' then "\\u2028" else "\\u2029"); + loop (i + 3)) + else ( + (match s.[i] with + | '\'' -> Buffer.add_string buf "\\'" + | '\\' -> Buffer.add_string buf "\\\\" + | '\b' -> Buffer.add_string buf "\\b" + | '\012' -> Buffer.add_string buf "\\f" + | '\n' -> Buffer.add_string buf "\\n" + | '\r' -> Buffer.add_string buf "\\r" + | '\t' -> Buffer.add_string buf "\\t" + | c when Char.code c < 0x20 || Char.code c = 0x7f -> + Buffer.add_string buf (Printf.sprintf "\\x%02x" (Char.code c)) + | c -> Buffer.add_char buf c); + loop (i + 1)) + in + loop 0; + Buffer.contents buf + +let emit path = path |> dump |> escape_for_single_quotes diff --git a/compiler/gentype/import_path.mli b/compiler/gentype/import_path.mli index 5bdaa18f04f..f9bd263441b 100644 --- a/compiler/gentype/import_path.mli +++ b/compiler/gentype/import_path.mli @@ -5,6 +5,9 @@ type t val bs_curry_path : config:Config.t -> t val chop_extension_safe : t -> t [@@live] val dump : t -> string + +(* Escape a semantic import path for a single-quoted JavaScript/TypeScript + string literal. The returned string does not include the quotes. *) val emit : t -> string val from_module : dir:string -> import_extension:string -> Module_name.t -> t val from_string_unsafe : string -> t diff --git a/compiler/gentype/translate_core_type.ml b/compiler/gentype/translate_core_type.ml index 92a5c1dbedc..514c069b3fb 100644 --- a/compiler/gentype/translate_core_type.ml +++ b/compiler/gentype/translate_core_type.ml @@ -183,7 +183,8 @@ and translateCoreType_ ~config ~type_vars_gen let label_js = if as_string then match attributes |> Annotation.get_as_string with - | Some label_renamed -> StringLabel label_renamed + | Some label_renamed -> + StringLabel (Emit_text.escape_string_contents label_renamed) | None -> if is_number label then IntLabel label else StringLabel label else if as_int then ( diff --git a/compiler/gentype/translate_type_declarations.ml b/compiler/gentype/translate_type_declarations.ml index f14fd9ac42c..d5d89ffdec9 100644 --- a/compiler/gentype/translate_type_declarations.ml +++ b/compiler/gentype/translate_type_declarations.ml @@ -35,12 +35,14 @@ let create_polyvariant_case (label, attributes) = | Some (_, BoolPayload b) -> BoolLabel b | Some (_, FloatPayload s) -> FloatLabel s | Some (_, IntPayload i) -> IntLabel i - | Some (_, StringPayload as_label) -> StringLabel as_label + | Some (_, StringPayload as_label) -> + StringLabel (Emit_text.escape_string_contents as_label) | _ -> if is_number label then IntLabel label else StringLabel label); } let create_variant_case label = function - | Some (Variant_runtime.String label) -> {label_js = StringLabel label} + | Some (Variant_runtime.String label) -> + {label_js = StringLabel (Emit_text.escape_string_contents label)} | Some (Variant_runtime.Int label) -> {label_js = IntLabel (string_of_int label)} | Some (Variant_runtime.Float label) -> {label_js = FloatLabel label} @@ -62,7 +64,7 @@ let create_variant_case label = function let rename_record_field ~attributes ~name = attributes |> Annotation.check_unsupported_gentype_as_renaming; match attributes |> Annotation.get_as_string with - | Some s -> s |> String.escaped + | Some s -> Emit_text.escape_string_contents s | None -> name |> Ext_ident.unwrap_uppercase_exotic let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index 64e8b05f2d5..658095545ab 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -43,8 +43,11 @@ module Const = struct let int64 ?(suffix = 'L') i = integer ~suffix (Int64.to_string i) let nativeint ?(suffix = 'n') i = integer ~suffix (Nativeint.to_string i) let float ?suffix f = Pconst_float (f, suffix) - let char c = Pconst_char (Char.code c) - let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) + let char c = + let semantic = Char.code c in + Pconst_char {source = String_literal.encode_char_source semantic; semantic} + let string semantic = + Pconst_string (String_literal.string_from_semantic semantic) end module Typ = struct @@ -196,6 +199,10 @@ module Exp = struct let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let template ?loc ?attrs source_segments values = + mk ?loc ?attrs (Pexp_template {source_segments; values}) + let tagged_template ?loc ?attrs tag raw_sources values = + mk ?loc ?attrs (Pexp_tagged_template {tag; raw_sources; values}) let await ?loc ?attrs a = mk ?loc ?attrs (Pexp_await a) let jsx_fragment ?loc ?attrs a b c = mk ?loc ?attrs diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli index a52aa951cfd..2899c914163 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -36,7 +36,7 @@ val with_default_loc : loc -> (unit -> 'a) -> 'a module Const : sig val char : char -> constant - val string : ?quotation_delimiter:string -> string -> constant + val string : string -> constant val integer : ?suffix:char -> string -> constant val int : ?suffix:char -> int -> constant val int32 : ?suffix:char -> int32 -> constant @@ -212,6 +212,9 @@ module Exp : sig val object_literal : ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression + + val template : + ?loc:loc -> ?attrs:attrs -> str list -> expression list -> expression val letmodule : ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression val letexception : @@ -225,6 +228,13 @@ module Exp : sig val open_ : ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression val extension : ?loc:loc -> ?attrs:attrs -> extension -> expression + val tagged_template : + ?loc:loc -> + ?attrs:attrs -> + expression -> + str list -> + expression list -> + expression val jsx_fragment : ?loc:loc -> ?attrs:attrs -> diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index 462e1af60cd..c94169eb0c6 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -383,6 +383,10 @@ module E = struct iter_loc sub lid; sub.expr sub e | Pexp_extension x -> sub.extension sub x + | Pexp_template {values} -> List.iter (sub.expr sub) values + | Pexp_tagged_template {tag; values} -> + sub.expr sub tag; + List.iter (sub.expr sub) values | Pexp_await e -> sub.expr sub e | Pexp_jsx_element (Jsx_fragment {jsx_fragment_children = children}) -> iter_jsx_children sub children diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index f536bda0771..99e54d2f4cf 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -344,6 +344,14 @@ module E = struct | Pexp_for_await_of (p, e1, e2) -> Exp.mk ~loc ~attrs (Pexp_for_await_of (sub.pat sub p, sub.expr sub e1, sub.expr sub e2)) + | Pexp_template {source_segments; values} -> + Exp.template ~loc ~attrs + (List.map (map_loc sub) source_segments) + (List.map (sub.expr sub) values) + | Pexp_tagged_template {tag; raw_sources; values} -> + Exp.tagged_template ~loc ~attrs (sub.expr sub tag) + (List.map (map_loc sub) raw_sources) + (List.map (sub.expr sub) values) | Pexp_coerce (e, (), t2) -> coerce ~loc ~attrs (sub.expr sub e) (sub.typ sub t2) | Pexp_constraint (e, t) -> @@ -558,8 +566,8 @@ let rec extension_of_error {loc; msg; if_highlight; sub} = ( {loc; txt = "ocaml.error"}, PStr ([ - Str.eval (Exp.constant (Pconst_string (msg, None))); - Str.eval (Exp.constant (Pconst_string (if_highlight, None))); + Str.eval (Exp.constant (Const.string msg)); + Str.eval (Exp.constant (Const.string if_highlight)); ] @ List.map (fun ext -> Str.extension (extension_of_error ext)) sub) ) @@ -581,7 +589,10 @@ module Ppx_context = struct let lid name = {txt = Lident name; loc = Location.none} - let make_string x = Exp.constant (Pconst_string (x, None)) + let make_string x = + Exp.constant + ~attrs:[(Location.mknoloc "_res.ppx_context_string", Parsetree.PStr [])] + (Const.string x) let make_bool x = if x then Exp.construct (lid "true") None @@ -644,7 +655,8 @@ module Ppx_context = struct let restore fields = let field name payload = let rec get_string = function - | {pexp_desc = Pexp_constant (Pconst_string (str, None))} -> str + | {pexp_desc = Pexp_constant (Pconst_string payload)} -> + String_literal.string_semantic payload | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context { %s }] string \ diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index 60e5215922b..4d9af4ce7c7 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -82,12 +82,81 @@ let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) let map_opt f = function | None -> None | Some x -> Some (f x) -let map_constant = function +let has_template_attr attrs = + Ext_list.exists attrs (fun ({txt}, _) -> txt = "res.template") + +let remove_template_attr attrs = + List.filter (fun ({Location.txt}, _) -> txt <> "res.template") attrs + +let semantic_string semantic = + Pt.Pconst_string (String_literal.string_from_semantic semantic) + +let source_string ~loc source = + match String_literal.string_from_source source with + | Some payload -> Pt.Pconst_string payload + | None -> Location.raise_errorf ~loc "Invalid string escape sequence" + +let template_source_from0 = function + | source, Some ("js" | "*j") -> source + | semantic, _ -> + String_literal.template_source + (String_literal.template_from_semantic semantic) + +let map_constant ~loc = function | Pconst_integer (s, suffix) -> Pt.Pconst_integer (s, suffix) - | Pconst_char c -> Pconst_char c - | Pconst_string (s, q) -> Pconst_string (s, q) + | Pconst_char semantic -> + (* Ast0 stores only the code point, so source spelling cannot survive the + PPX bridge. Reconstruct a valid canonical spelling on the way back. *) + Pconst_char {source = String_literal.encode_char_source semantic; semantic} + | Pconst_string (s, Some ("js" | "*j")) -> source_string ~loc s + | Pconst_string (s, None) -> semantic_string s + | Pconst_string (s, Some "json") -> Pconst_json s + (* Other v0 quotation delimiters are syntax, not part of the string value. + Tagged ReScript templates are represented as applications before PPX. *) + | Pconst_string (semantic, Some _) -> semantic_string semantic | Pconst_float (s, suffix) -> Pconst_float (s, suffix) +let map_pattern_constant ~loc = function + | Pconst_string (_, Some tag) when tag <> "js" && tag <> "*j" -> + Location.raise_errorf ~loc + "Tagged template literals are not supported in patterns" + | constant -> map_constant ~loc constant + +let is_raw_source_extension = function + | "raw" | "ffi" | "re" -> true + | _ -> false + +let map_raw_source_payload sub = function + | PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = Pexp_constant (Pconst_string (s, _)); + pexp_loc; + pexp_attributes; + }, + eval_attributes ); + pstr_loc; + }; + ] -> + let expression = + Ast_helper.Exp.constant + ~loc:(sub.location sub pexp_loc) + ~attrs:(sub.attributes sub pexp_attributes) + (Pt.Pconst_raw_source s) + in + Some + (Pt.PStr + [ + Ast_helper.Str.eval + ~loc:(sub.location sub pstr_loc) + ~attrs:(sub.attributes sub eval_attributes) + expression; + ]) + | _ -> None + let for_of_attr_name = "_res.for_of" let for_await_of_attr_name = "_res.for_await_of" @@ -511,7 +580,15 @@ module E = struct let inner = sub.expr sub {e with pexp_attributes = inner_attrs0} in await ~loc ~attrs:(sub.attributes sub await_attrs0) inner | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) - | Pexp_constant x -> constant ~loc ~attrs (map_constant x) + | Pexp_constant (Pconst_string (text, delimiter)) + when has_template_attr attrs && delimiter <> Some "json" -> + let attrs = remove_template_attr attrs in + let source = template_source_from0 (text, delimiter) in + template ~loc ~attrs [{txt = source; loc}] [] + | Pexp_constant x -> + let template = has_template_attr attrs in + let attrs = if template then remove_template_attr attrs else attrs in + constant ~loc ~attrs (map_constant ~loc x) | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> @@ -607,6 +684,104 @@ module E = struct in jsx_container_element ~loc ~attrs jsx_tag_name props Lexing.dummy_pos children (Some closing_tag)) + | Pexp_apply + ( tag, + [ + (Nolabel, {pexp_desc = Pexp_array segments}); + (Nolabel, {pexp_desc = Pexp_array values}); + ] ) + when List.exists + (fun ({Location.txt}, _) -> txt = "res.taggedTemplate") + attrs -> + let raw_sources = + List.map + (fun (segment : Parsetree0.expression) -> + match segment.pexp_desc with + | Pexp_constant (Pconst_string (txt, Some ("js" | "*j"))) -> + {Location.txt; loc = sub.location sub segment.pexp_loc} + | Pexp_constant (Pconst_string (semantic, _)) -> + { + Location.txt = template_source_from0 (semantic, None); + loc = sub.location sub segment.pexp_loc; + } + | _ -> assert false) + segments + in + let attrs = + List.filter + (fun ({Location.txt}, _) -> txt <> "res.taggedTemplate") + attrs + in + tagged_template ~loc ~attrs (sub.expr sub tag) raw_sources + (List.map (sub.expr sub) values) + | Pexp_apply _ as application when has_template_attr attrs -> + let rec flatten acc (expression : Parsetree0.expression) = + match expression.pexp_desc with + | Pexp_apply + ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"}}, + [(Nolabel, lhs); (Nolabel, rhs)] ) + when has_template_attr expression.pexp_attributes -> + flatten (rhs :: acc) lhs + | _ -> expression :: acc + in + let parts = flatten [] {e with pexp_desc = application} in + let reject_json_interpolation () = + Location.raise_errorf ~loc + "`json` literals do not support interpolation" + in + let rec collect sources values = function + | [{pexp_desc = Pexp_constant (Pconst_string (_, Some "json"))}] -> + reject_json_interpolation () + | [ + { + pexp_desc = Pexp_constant (Pconst_string (text, delimiter)); + pexp_loc; + }; + ] -> + let txt = template_source_from0 (text, delimiter) in + Some + ( List.rev + ({Location.txt; loc = sub.location sub pexp_loc} :: sources), + List.rev values ) + | {pexp_desc = Pexp_constant (Pconst_string (_, Some "json"))} + :: _value :: _rest -> + reject_json_interpolation () + | { + pexp_desc = Pexp_constant (Pconst_string (text, delimiter)); + pexp_loc; + } + :: value :: rest -> + let txt = template_source_from0 (text, delimiter) in + collect + ({Location.txt; loc = sub.location sub pexp_loc} :: sources) + (value :: values) rest + | _ -> None + in + begin match collect [] [] parts with + | Some (sources, values) -> + let attrs = remove_template_attr attrs in + template ~loc ~attrs sources (List.map (sub.expr sub) values) + | None -> + let attrs = remove_template_attr attrs in + begin match application with + | Pexp_apply (e, l) -> + let e = + match (e.pexp_desc, l) with + | ( Pexp_ident ({txt = Longident.Lident "^"} as lid), + [(Nolabel, _); (Nolabel, _)] ) -> + { + e with + pexp_desc = Pexp_ident {lid with txt = Longident.Lident "++"}; + } + | _ -> e + in + apply ~loc ~attrs (sub.expr sub e) + (List.map + (fun (lbl, e) -> (Asttypes.to_arg_label lbl, sub.expr sub e)) + l) + | _ -> assert false + end + end | Pexp_apply (e, l) -> let e = match (e.pexp_desc, l) with @@ -879,9 +1054,14 @@ module P = struct | Ppat_any -> any ~loc ~attrs () | Ppat_var s -> var ~loc ~attrs (map_loc sub s) | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) - | Ppat_constant c -> constant ~loc ~attrs (map_constant c) + | Ppat_constant c -> + let template = has_template_attr attrs in + let attrs = if template then remove_template_attr attrs else attrs in + constant ~loc ~attrs (map_pattern_constant ~loc c) | Ppat_interval (c1, c2) -> - interval ~loc ~attrs (map_constant c1) (map_constant c2) + interval ~loc ~attrs + (map_pattern_constant ~loc c1) + (map_pattern_constant ~loc c2) | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) @@ -1061,7 +1241,16 @@ let default_mapper = pc_rhs = this.expr this pc_rhs; }); location = (fun _this l -> l); - extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + extension = + (fun this (s, payload) -> + let payload = + if is_raw_source_extension s.txt then + match map_raw_source_payload this payload with + | Some payload -> payload + | None -> this.payload this payload + else this.payload this payload + in + (map_loc this s, payload)); attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); attributes = (fun this l -> List.map (this.attribute this) l); payload = diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 0e975bcfb74..030aa7fe597 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -78,12 +78,30 @@ let map_opt f = function | Some x -> Some (f x) let map_constant = function | Pconst_integer (s, suffix) -> Pt.Pconst_integer (s, suffix) - | Pconst_char c -> Pconst_char c - | Pconst_string (s, q) -> Pconst_string (s, q) + | Pconst_char {semantic} -> Pconst_char semantic + | Pconst_string payload -> + Pconst_string (String_literal.string_source payload, Some "js") + | Pconst_raw_source s -> Pconst_string (s, Some "js") + | Pconst_json s -> Pconst_string (s, Some "json") | Pconst_float (s, suffix) -> Pconst_float (s, suffix) +let template_attr = (Location.mknoloc "res.template", Pt.PStr []) + +let add_template_attr attrs = + if Ext_list.exists attrs (fun ({txt}, _) -> txt = "res.template") then attrs + else template_attr :: attrs + let for_of_attr_name = "_res.for_of" let for_await_of_attr_name = "_res.for_await_of" +let ppx_context_string_attr_name = "_res.ppx_context_string" + +let has_ppx_context_string_attr attrs = + Ext_list.exists attrs (fun ({txt}, _) -> txt = ppx_context_string_attr_name) + +let remove_ppx_context_string_attr attrs = + List.filter + (fun ({Location.txt}, _) -> txt <> ppx_context_string_attr_name) + attrs let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} @@ -398,9 +416,16 @@ module E = struct let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = let open Exp in let loc = sub.location sub loc in - let attrs = sub.attributes sub attrs in + let is_ppx_context_string = has_ppx_context_string_attr attrs in + let attrs = sub.attributes sub (remove_ppx_context_string_attr attrs) in match desc with | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant (Pconst_string payload) when is_ppx_context_string -> + (* The PPX protocol predates source-preserving strings. Existing PPXs + require compiler-generated context fields to be ordinary semantic + ast0 strings rather than quotation-delimited source strings. *) + constant ~loc ~attrs + (Pt.Pconst_string (String_literal.string_semantic payload, None)) | Pexp_constant x -> constant ~loc ~attrs (map_constant x) | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) @@ -588,6 +613,52 @@ module E = struct ~attrs:(for_await_of_attr :: attrs) (sub.pat sub pat) start_expr end_expr Asttypes.Upto (sub.expr sub body_expr) + | Pexp_template {source_segments; values} -> + let segments = + List.map + (fun (source : string Location.loc) -> + Ast_helper0.Exp.constant + ~loc:(sub.location sub source.loc) + ~attrs:[template_attr] + (Pt.Pconst_string (source.txt, Some "js"))) + source_segments + in + let rec interleave acc segments values = + match (segments, values) with + | [segment], [] -> List.rev (segment :: acc) + | segment :: segments, value :: values -> + interleave (sub.expr sub value :: segment :: acc) segments values + | _ -> assert false + in + let parts = interleave [] segments values in + let concat lhs rhs = + apply ~loc ~attrs:[template_attr] + (Ast_helper0.Exp.ident ~loc (Location.mknoloc (Longident.Lident "^"))) + [(Asttypes.Noloc.Nolabel, lhs); (Asttypes.Noloc.Nolabel, rhs)] + in + let expression = + match parts with + | first :: rest -> List.fold_left concat first rest + | [] -> assert false + in + {expression with pexp_attributes = add_template_attr attrs} + | Pexp_tagged_template {tag; raw_sources; values} -> + let segments = + List.map + (fun (source : string Location.loc) -> + Ast_helper0.Exp.constant + ~loc:(sub.location sub source.loc) + ~attrs:[template_attr] + (Pt.Pconst_string (source.txt, Some "js"))) + raw_sources + in + let tagged_attr = (Location.mknoloc "res.taggedTemplate", Pt.PStr []) in + apply ~loc ~attrs:(tagged_attr :: attrs) (sub.expr sub tag) + [ + (Asttypes.Noloc.Nolabel, Ast_helper0.Exp.array ~loc segments); + ( Asttypes.Noloc.Nolabel, + Ast_helper0.Exp.array ~loc (List.map (sub.expr sub) values) ); + ] | Pexp_coerce (e, (), t2) -> coerce ~loc ~attrs (sub.expr sub e) (sub.typ sub t2) | Pexp_constraint (e, t) -> diff --git a/compiler/ml/ast_payload.ml b/compiler/ml/ast_payload.ml index c2b69891a95..72f81567fbb 100644 --- a/compiler/ml/ast_payload.ml +++ b/compiler/ml/ast_payload.ml @@ -24,19 +24,43 @@ type t = Parsetree.payload -let is_single_string (x : t) = - match x with - (* TODO also need detect empty phrase case *) +let json_literal_outside_external_message = + "A `json` literal can only be used in an external attribute such as `@as`" + +let reject_json_literal ~loc = + Location.raise_errorf ~loc "%s" json_literal_outside_external_message + +let reject_json_literal_payload (payload : t) = + match payload with | PStr [ { pstr_desc = Pstr_eval - ({pexp_desc = Pexp_constant (Pconst_string (name, dec)); _}, _); - _; + ({pexp_desc = Pexp_constant (Pconst_json _); pexp_loc; _}, _); }; ] -> - Some (name, dec) + reject_json_literal ~loc:pexp_loc + | _ -> () + +let semantic_string_of_expression (expression : Parsetree.expression) = + match expression with + | {pexp_desc = Pexp_constant (Pconst_string payload); _} -> + Some (String_literal.string_semantic payload) + | { + pexp_desc = Pexp_template {source_segments = [source]; values = []}; + pexp_loc; + } -> ( + match String_literal.decode_js_template_escapes source.txt with + | Some semantic -> Some semantic + | None -> + Location.raise_errorf ~loc:pexp_loc "Invalid string escape sequence") + | _ -> None + +let semantic_string_of_payload (x : t) = + match x with + | PStr [{pstr_desc = Pstr_eval (expression, _); _}] -> + semantic_string_of_expression expression | _ -> None let is_single_int (x : t) : int option = @@ -112,46 +136,66 @@ let is_single_ident (x : t) = let raw_as_string_exp_exn ~(kind : Js_raw_info.raw_kind) ?is_function (x : t) : Parsetree.expression option = - match x with - (* TODO also need detect empty phrase case *) - | PStr - [ - { - pstr_desc = - Pstr_eval - ( ({ - pexp_desc = Pexp_constant (Pconst_string (str, deli)); - pexp_loc = loc; - } as e), - _ ); - _; - }; - ] -> - Bs_flow_ast_utils.check_flow_errors ~loc - ~offset:(Bs_flow_ast_utils.flow_deli_offset deli) + let string_expression = + match x with + (* TODO also need detect empty phrase case *) + | PStr + [ + { + pstr_desc = + Pstr_eval + ( ({ + pexp_desc = + Pexp_template {source_segments = [source]; values = []}; + } as expression), + _ ); + }; + ] -> + Some + (source.txt, Bs_flow_ast_utils.flow_deli_offset (Some "js"), expression) + | PStr + [ + { + pstr_desc = + Pstr_eval + (({pexp_desc = Pexp_constant constant; _} as expression), _); + _; + }; + ] -> ( + match constant with + | Pconst_raw_source source -> + Some (source, Bs_flow_ast_utils.flow_deli_offset (Some "js"), expression) + | Pconst_string payload -> + Some (String_literal.string_semantic payload, 0, expression) + | _ -> None) + | _ -> None + in + match string_expression with + | Some (str, offset, ({pexp_loc = loc} as expression)) -> + Bs_flow_ast_utils.check_flow_errors ~loc ~offset (match kind with | Raw_re | Raw_exp -> - let ((_loc, e) as prog), errors = + let ((_loc, expression) as program), errors = let open Parser_flow in let env = Parser_env.init_env None str in do_parse env Parse.expression false in (if kind = Raw_re then - match e with + match expression with | RegExpLiteral _ -> () | _ -> Location.raise_errorf ~loc "Syntax error: a valid JS regex literal expected"); (match is_function with | Some is_function -> ( - match Classify_function.classify_exp prog with + match Classify_function.classify_exp program with | Js_function {arity; _} -> is_function := Some arity | _ -> ()) | None -> ()); errors | Raw_program -> snd (Parser_flow.parse_program false None str)); - Some {e with pexp_desc = Pexp_constant (Pconst_string (str, None))} - | _ -> None + Some {expression with pexp_desc = Pexp_constant (Pconst_raw_source str)} + | None -> None type lid = string Asttypes.loc @@ -210,6 +254,11 @@ let ident_or_record_as_config loc (x : t) : let assert_strings loc (x : t) : string list = let exception Not_str in + let semantic_string expression = + match semantic_string_of_expression expression with + | Some semantic -> semantic + | None -> raise Not_str + in match x with | PStr [ @@ -219,22 +268,11 @@ let assert_strings loc (x : t) : string list = _; }; ] -> ( - try - Ext_list.map strs (fun e -> - match (e : Parsetree.expression) with - | {pexp_desc = Pexp_constant (Pconst_string (name, _)); _} -> name - | _ -> raise Not_str) + try Ext_list.map strs semantic_string + with Not_str -> Location.raise_errorf ~loc "expect string tuple list") + | PStr [{pstr_desc = Pstr_eval (expression, _); _}] -> ( + try [semantic_string expression] with Not_str -> Location.raise_errorf ~loc "expect string tuple list") - | PStr - [ - { - pstr_desc = - Pstr_eval - ({pexp_desc = Pexp_constant (Pconst_string (name, _)); _}, _); - _; - }; - ] -> - [name] | PStr [] -> [] | PSig _ | PStr _ | PTyp _ | PPat _ -> Location.raise_errorf ~loc "expect string tuple list" diff --git a/compiler/ml/ast_payload.mli b/compiler/ml/ast_payload.mli index d3103a30f6c..ebaf2636d22 100644 --- a/compiler/ml/ast_payload.mli +++ b/compiler/ml/ast_payload.mli @@ -31,7 +31,17 @@ type lid = string Asttypes.loc type action = lid * Parsetree.expression option -val is_single_string : t -> (string * string option) option +val json_literal_outside_external_message : string +val reject_json_literal : loc:Location.t -> 'a +val reject_json_literal_payload : t -> unit + +val semantic_string_of_expression : Parsetree.expression -> string option +(** Return the decoded value when the expression is an ordinary string or a + non-interpolated backquoted string. *) + +val semantic_string_of_payload : t -> string option +(** Return the decoded value of an ordinary or non-interpolated backquoted string. + Other prefixed literals, such as [json], are not semantic strings. *) val is_single_int : t -> int option diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index dd642a21be0..b0899646774 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -116,9 +116,9 @@ let process_tag_type (attrs : Parsetree.attributes) = match txt with | "as" -> if !st = None then ( - (match Ast_payload.is_single_string payload with + (match Ast_payload.semantic_string_of_payload payload with | None -> () - | Some (s, _dec) -> st := Some (String s)); + | Some s -> st := Some (String s)); (match Ast_payload.is_single_int payload with | None -> () | Some i -> st := Some (Int i)); @@ -197,9 +197,10 @@ let process_tag_name (attrs : Parsetree.attributes) = match txt with | "tag" -> if !st = None then ( - (match Ast_payload.is_single_string payload with + Ast_payload.reject_json_literal_payload payload; + (match Ast_payload.semantic_string_of_payload payload with | None -> () - | Some (s, _dec) -> st := Some s); + | Some s -> st := Some s); if !st = None then raise (Error (loc, InvalidVariantTagAnnotation))) else raise (Error (loc, Duplicated_bs_as)) | _ -> ()); diff --git a/compiler/ml/asttypes.ml b/compiler/ml/asttypes.ml index 85a2c3ad5a7..54d661dec39 100644 --- a/compiler/ml/asttypes.ml +++ b/compiler/ml/asttypes.ml @@ -18,10 +18,23 @@ type constant = | Const_int of int | Const_char of int - | Const_string of string * string option + (** The decoded Unicode code point of a character literal. For example, + ['\u{1F600}'] is represented as [Const_char 0x1F600]. Source spelling + has been discarded after type checking. *) + | Const_string of string + (** The decoded runtime value of an ordinary string literal. For example, + ["a\\n"] is represented by a string containing an actual newline. + Source spelling has been discarded after type checking. *) | Const_float of string | Const_bigint of bool * string +type template_segment = String_literal.template_segment +(** A segment of an ordinary backquoted template after validation. [source] + preserves its spelling for JavaScript output; [semantic] is its decoded + runtime string value. For example, the final segment of [`a ${value}\n`] + preserves ["\\n"] as its source and contains an actual newline as its + semantic value. Construct segments through [String_literal]. *) + type rec_flag = Nonrecursive | Recursive type direction_flag = Upto | Downto diff --git a/compiler/ml/builtin_attributes.ml b/compiler/ml/builtin_attributes.ml index 453048b3476..9aa5c5756b6 100644 --- a/compiler/ml/builtin_attributes.ml +++ b/compiler/ml/builtin_attributes.ml @@ -16,14 +16,9 @@ open Asttypes open Parsetree -let string_of_cst = function - | Pconst_string (s, _) -> Some s - | _ -> None - -let string_of_payload = function - | PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_constant c}, _)}] -> - string_of_cst c - | _ -> None +let string_of_payload payload = + Ast_payload.reject_json_literal_payload payload; + Ast_payload.semantic_string_of_payload payload let string_of_opt_payload p = match string_of_payload p with @@ -45,26 +40,17 @@ let rec error_of_extension ext = in match p with | PStr [] -> raise Location.Already_displayed_error - | PStr - ({ - pstr_desc = - Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (msg, _))}, _); - } - :: { - pstr_desc = - Pstr_eval - ( {pexp_desc = Pexp_constant (Pconst_string (if_highlight, _))}, - _ ); - } - :: inner) -> - Location.error ~loc ~if_highlight ~sub:(sub_from inner) msg - | PStr - ({ - pstr_desc = - Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (msg, _))}, _); - } - :: inner) -> - Location.error ~loc ~sub:(sub_from inner) msg + | PStr ({pstr_desc = Pstr_eval (message, _)} :: inner) -> ( + match Ast_payload.semantic_string_of_expression message with + | Some msg -> ( + match inner with + | {pstr_desc = Pstr_eval (highlight, _)} :: rest -> ( + match Ast_payload.semantic_string_of_expression highlight with + | Some if_highlight -> + Location.error ~loc ~if_highlight ~sub:(sub_from rest) msg + | None -> Location.error ~loc ~sub:(sub_from inner) msg) + | _ -> Location.error ~loc ~sub:(sub_from inner) msg) + | None -> Location.errorf ~loc "Invalid syntax for extension '%s'." txt) | _ -> Location.errorf ~loc "Invalid syntax for extension '%s'." txt) | {txt; loc}, _ -> Location.errorf ~loc "Uninterpreted extension '%s'." txt @@ -89,11 +75,8 @@ let rec deprecated_of_attrs_with_migrate = function fields |> List.find_map (fun field -> match field with - | { - lid = {txt = Lident "reason"}; - x = {pexp_desc = Pexp_constant (Pconst_string (reason, _))}; - } -> - Some reason + | {lid = {txt = Lident "reason"}; x} -> + Ast_payload.semantic_string_of_expression x | _ -> None) in let migration_template = @@ -199,17 +182,11 @@ let warning_attribute ?(ppwarning = true) = process loc txt false payload | {txt = ("ocaml.warnerror" | "warnerror") as txt; loc}, payload -> process loc txt true payload - | ( {txt = "ocaml.ppwarning" | "ppwarning"}, - PStr - [ - { - pstr_desc = - Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (s, _))}, _); - pstr_loc; - }; - ] ) - when ppwarning -> - Location.prerr_warning pstr_loc (Warnings.Preprocessor s) + | {txt = "ocaml.ppwarning" | "ppwarning"}, (PStr [{pstr_loc; _}] as payload) + when ppwarning -> ( + match string_of_payload payload with + | Some s -> Location.prerr_warning pstr_loc (Warnings.Preprocessor s) + | None -> ()) | _ -> () let warning_scope ?ppwarning attrs f = diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index f9d1db67dac..50537890c53 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -224,6 +224,10 @@ let rec add_expr bv exp = | Pexp_apply {funct = e; args = el} -> add_expr bv e; List.iter (fun (_, e) -> add_expr bv e) el + | Pexp_template {values} -> List.iter (add_expr bv) values + | Pexp_tagged_template {tag; values} -> + add_expr bv tag; + List.iter (add_expr bv) values | Pexp_match (e, pel) -> add_expr bv e; add_cases bv pel diff --git a/compiler/ml/error_message_utils.ml b/compiler/ml/error_message_utils.ml index 00bdbe4b062..4ee3f1aeaf8 100644 --- a/compiler/ml/error_message_utils.ml +++ b/compiler/ml/error_message_utils.ml @@ -226,11 +226,11 @@ let extract_string_constant text = | ( [ { Parsetree.pstr_desc = - Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (s, _))}, _); + Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string payload)}, _); }; ], _ ) -> - Some s + Some (String_literal.string_semantic payload) | _ -> None let print_object_vs_record_hint ppf ~loc = @@ -671,8 +671,13 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf let reprinted = Parser.reprint_expr_at_loc loc ~mapper:(fun exp -> match exp.Parsetree.pexp_desc with - | Pexp_constant (Pconst_string (s, _)) -> - Some {exp with Parsetree.pexp_desc = Pexp_variant (s, None)} + | Pexp_constant (Pconst_string payload) -> + Some + { + exp with + Parsetree.pexp_desc = + Pexp_variant (String_literal.string_semantic payload, None); + } | _ -> None) in match (reprinted, List.mem string_value variant_constructors) with @@ -723,7 +728,7 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf let reprinted = Parser.reprint_expr_at_loc loc ~mapper:(fun exp -> match exp.Parsetree.pexp_desc with - | Pexp_constant (Pconst_string (_, _)) -> + | Pexp_constant (Pconst_string _) -> Some { exp with diff --git a/compiler/ml/external_arg_spec.ml b/compiler/ml/external_arg_spec.ml index d7238532397..b8f2bb6302e 100644 --- a/compiler/ml/external_arg_spec.ml +++ b/compiler/ml/external_arg_spec.ml @@ -24,16 +24,10 @@ (** type definitions for arguments to a function declared external *) -type delim = DNone | DStarJ | DNoQuotes | DBackQuotes - -let parse_processed_delim = function - | None -> Some DNone - | Some "json" -> Some DNoQuotes - | Some "*j" -> Some DStarJ - | Some "bq" -> Some DBackQuotes - | _ -> None - -type cst = Arg_int_lit of int | Arg_string_lit of string * delim +type cst = + | Arg_int_lit of int + | Arg_string_lit of string + | Arg_json_lit of string type label_noname = Arg_label | Arg_empty | Arg_optional @@ -77,7 +71,8 @@ type params = param list let cst_int i = Arg_int_lit i -let cst_string s delim = Arg_string_lit (s, delim) +let cst_string s = Arg_string_lit s +let cst_json s = Arg_json_lit s let empty_label = Obj_empty diff --git a/compiler/ml/external_arg_spec.mli b/compiler/ml/external_arg_spec.mli index ac99e6dea2a..058be3c7f55 100644 --- a/compiler/ml/external_arg_spec.mli +++ b/compiler/ml/external_arg_spec.mli @@ -22,11 +22,10 @@ * 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 = DNone | DStarJ | DNoQuotes | DBackQuotes - -val parse_processed_delim : string option -> delim option - -type cst = private Arg_int_lit of int | Arg_string_lit of string * delim +type cst = private + | Arg_int_lit of int + | Arg_string_lit of string + | Arg_json_lit of string type attr = | Poly_var_string of {descr: (string * string) list} @@ -57,7 +56,8 @@ type params = param list val cst_int : int -> cst -val cst_string : string -> delim -> cst +val cst_string : string -> cst +val cst_json : string -> cst val empty_label : label diff --git a/compiler/ml/external_ffi_types.ml b/compiler/ml/external_ffi_types.ml index b3c058f44da..995dd16be46 100644 --- a/compiler/ml/external_ffi_types.ml +++ b/compiler/ml/external_ffi_types.ml @@ -76,7 +76,10 @@ type return_wrapper = (* An external declared as an inline constant is only ever a literal; the frontend parses delimiters and bigint signs before constructing this. *) type inline_const = - | Const_str of {s: string; delim: External_arg_spec.delim option} + | Const_string of string + (** A decoded runtime string value. For example, an inline external + declared with ["a\\n"] stores a string containing an actual newline; + source spelling is not needed after FFI processing. *) | Const_bool of bool | Const_int of int32 | Const_bigint of {negative: bool; digits: string} diff --git a/compiler/ml/external_ffi_types.mli b/compiler/ml/external_ffi_types.mli index 045fe8be5aa..fa5204f9de1 100644 --- a/compiler/ml/external_ffi_types.mli +++ b/compiler/ml/external_ffi_types.mli @@ -76,7 +76,10 @@ type return_wrapper = (* An external declared as an inline constant is only ever a literal; the frontend parses delimiters and bigint signs before constructing this. *) type inline_const = - | Const_str of {s: string; delim: External_arg_spec.delim option} + | Const_string of string + (** A decoded runtime string value. For example, an inline external + declared with ["a\\n"] stores a string containing an actual newline; + source spelling is not needed after FFI processing. *) | Const_bool of bool | Const_int of int32 | Const_bigint of {negative: bool; digits: string} diff --git a/compiler/ml/lambda.ml b/compiler/ml/lambda.ml index 9e045e99330..a0e225af047 100644 --- a/compiler/ml/lambda.ml +++ b/compiler/ml/lambda.ml @@ -63,18 +63,8 @@ let mutable_flag_of_tag_info (tag : tag_info) = type label = Types.label_description -let find_name (attr : Parsetree.attribute) = - match attr with - | ( {txt = "as"}, - PStr - [ - { - pstr_desc = - Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (s, _))}, _); - }; - ] ) -> - Some s - | _ -> None +let find_name (({txt}, payload) : Parsetree.attribute) = + if txt = "as" then Ast_payload.semantic_string_of_payload payload else None let blk_record (fields : (label * _ * _) array) mut = let all_labels_info = @@ -311,17 +301,31 @@ type primitive = | Pval_from_option | Pval_from_option_not_nest | Pis_poly_var_block + (* Validated JavaScript source from [raw], [ffi], or [re], together with its + expression/program kind. For example, [%raw("x + 1")] carries ["x + 1"] + as code, not as a decoded runtime string. *) | Praw_js_code of Js_raw_info.t | Pjs_fn_method - (* Tagged template literal: [tag; strings_array; values_array] *) - | Ptagged_template + (* A JavaScript tagged template operation. For [sql`id = ${id}`], the payload + is ["id = "; ""] and the primitive arguments are [sql; id]. Segment text + remains raw and may contain invalid escapes. *) + | Ptagged_template of string list + (* An ordinary backquoted-template operation. For [`a ${value}\n`], the + payload contains the source and semantic forms of ["a "] and ["\\n"], + and the primitive arguments contain [value]. The source forms are retained + for JavaScript output; semantic forms are used by optimizations. *) + | Ptemplate of Asttypes.template_segment list and comparison = Ceq | Cneq | Clt | Cgt | Cle | Cge type structured_constant = | Const_int of int32 | Const_char of int - | Const_string of {s: string; delim: External_arg_spec.delim option} + (* The decoded Unicode code point; literal source spelling is no longer + present at this layer. *) + | Const_string of string + (* A decoded runtime string value; literal source spelling is no longer + present at this layer. *) | Const_float of string | Const_bigint of bool * string | Const_block of tag_info * structured_constant list @@ -436,14 +440,13 @@ and lambda_switch = t switch *) let const_int (i : int) = Const_int (Int32.of_int i) -let const_string s delim = - Const_string {s; delim = External_arg_spec.parse_processed_delim delim} +let const_string s = Const_string (String_literal.normalize_semantic s) let const_of_typed (c : Asttypes.constant) : structured_constant = match c with | Asttypes.Const_int i -> Const_int (Int32.of_int i) | Asttypes.Const_char i -> Const_char i - | Asttypes.Const_string (s, d) -> const_string s d + | Asttypes.Const_string s -> Const_string s | Asttypes.Const_float f -> Const_float f | Asttypes.Const_bigint (sign, i) -> Const_bigint (sign, i) @@ -472,7 +475,7 @@ let const_polyvar name = let const_polyvar_name name = match const_polyvar name with - | Const_polyvar s -> Const_string {s; delim = None} + | Const_polyvar s -> Const_string s | c -> c let const_module_alias = Const_module_alias @@ -560,8 +563,8 @@ let eq_primitive_approx (lhs : primitive) (rhs : primitive) = | Phash_mixstring | Phash_mixint | Phash_finalmix | Precord_rest _ -> rhs = lhs (* Reachable only via the optimizer's term-equality comparison, which the - test suite doesn't exercise for tagged templates. *) - | Ptagged_template -> ( ((rhs = lhs) [@coverage off])) + test suite doesn't exercise for template primitives. *) + | Ptagged_template _ | Ptemplate _ -> ( ((rhs = lhs) [@coverage off])) | Pcreate_extension a -> ( match rhs with | Pcreate_extension b -> a = (b : string) @@ -669,9 +672,9 @@ let rec const_eq_approx (x : structured_constant) (y : structured_constant) = match y with | Const_char iy -> ix = iy | _ -> false) - | Const_string {s = sx; delim = ux} -> ( + | Const_string sx -> ( match y with - | Const_string {s = sy; delim = uy} -> sx = sy && ux = uy + | Const_string sy -> sx = sy | _ -> false) | Const_float ix -> ( match y with @@ -949,8 +952,7 @@ let switch lam (lam_switch : lambda_switch) : t = let stringswitch (lam : t) cases default : t = match lam with - | Lconst (Const_string {s; delim = None | Some DNoQuotes}) -> - Ext_list.assoc_by_string cases s default + | Lconst (Const_string s) -> Ext_list.assoc_by_string cases s default | _ -> Lstringswitch (lam, cases, default) let rec seq (a : t) b : t = @@ -966,7 +968,7 @@ module Lift = struct let bool b = if b then lambda_true else lambda_false - let string s : t = Lconst (Const_string {s; delim = None}) + let string s : t = Lconst (Const_string s) let char b : t = Lconst (Const_char b) end @@ -982,8 +984,8 @@ let prim ~primitive:(prim : primitive) ~args loc : t = | Pintoffloat, Const_float a -> Lift.int (Int32.of_float (float_of_string a)) (* | Pnegfloat -> Lift.float (-. a) *) - | Pstringlength, Const_string {s; delim = None} -> - Lift.int (Int32.of_int (String.length s)) + | Pstringlength, Const_string s -> + Lift.int (Int32.of_int (String_literal.utf16_length s)) (* | Pnegbint Pnativeint, ( (Const_nativeint i)) *) (* -> *) (* Lift.nativeint (Nativeint.neg i) *) @@ -1037,15 +1039,11 @@ let prim ~primitive:(prim : primitive) ~args loc : t = | Psequor, Const_js_true, (Const_js_true | Const_js_false) -> lambda_true | Psequor, Const_js_false, Const_js_true -> lambda_true | Psequor, Const_js_false, Const_js_false -> lambda_false - | ( Pstringadd, - Const_string {s = a; delim = None}, - Const_string {s = b; delim = None} ) -> - Lift.string (a ^ b) - | ( (Pstringrefs | Pstringrefu), - Const_string {s = a; delim = None}, - Const_int b ) -> ( - try Lift.char (Char.code (String.get a (Int32.to_int b))) - with _ -> default ()) + | Pstringadd, Const_string a, Const_string b -> Lift.string (a ^ b) + | (Pstringrefs | Pstringrefu), Const_string a, Const_int b -> ( + match String_literal.code_point_at_utf16_index a (Int32.to_int b) with + | Some codepoint -> Lift.char codepoint + | None -> default ()) | _ -> default ()) | _ -> ( match prim with @@ -1478,8 +1476,7 @@ let rec transl_normal_path = function | Path.Pident id -> (* A predefined exception is its own name at runtime, so the reference is that string rather than a module. *) - if Ident.is_predef_exn id then - Lconst (Const_string {s = id.name; delim = None}) + if Ident.is_predef_exn id then Lconst (Const_string id.name) else if Ident.global id then Lglobal_module id else Lvar id | Pdot (p, s, pos) -> diff --git a/compiler/ml/lambda.mli b/compiler/ml/lambda.mli index 895faedfae1..c619b54426f 100644 --- a/compiler/ml/lambda.mli +++ b/compiler/ml/lambda.mli @@ -271,16 +271,31 @@ type primitive = | Pval_from_option | Pval_from_option_not_nest | Pis_poly_var_block + (* Validated JavaScript source from [raw], [ffi], or [re], together with its + expression/program kind. For example, [%raw("x + 1")] carries ["x + 1"] + as code, not as a decoded runtime string. *) | Praw_js_code of Js_raw_info.t | Pjs_fn_method - | Ptagged_template + (* A JavaScript tagged template operation. For [sql`id = ${id}`], the payload + is ["id = "; ""] and the primitive arguments are [sql; id]. Segment text + remains raw and may contain invalid escapes. *) + | Ptagged_template of string list + (* An ordinary backquoted-template operation. For [`a ${value}\n`], the + payload contains the source and semantic forms of ["a "] and ["\\n"], + and the primitive arguments contain [value]. The source forms are retained + for JavaScript output; semantic forms are used by optimizations. *) + | Ptemplate of template_segment list and comparison = Ceq | Cneq | Clt | Cgt | Cle | Cge type structured_constant = | Const_int of int32 | Const_char of int - | Const_string of {s: string; delim: External_arg_spec.delim option} + (* The decoded Unicode code point; literal source spelling is no longer + present at this layer. *) + | Const_string of string + (* A decoded runtime string value; literal source spelling is no longer + present at this layer. *) | Const_float of string | Const_bigint of bool * string | Const_block of tag_info * structured_constant list @@ -421,7 +436,11 @@ and lambda_switch = t switch val make_key : t -> t option val const_int : int -> structured_constant -val const_string : string -> string option -> structured_constant + +val const_string : string -> structured_constant +(** Construct a compiler-generated semantic string constant, normalizing any + malformed filesystem or legacy bytes to their historical JavaScript value. *) + val const_of_typed : constant -> structured_constant val const_unit : structured_constant val const_constructor : Variant_runtime.tag -> structured_constant diff --git a/compiler/ml/matching.ml b/compiler/ml/matching.ml index 324db00a6a8..09ef13b941e 100644 --- a/compiler/ml/matching.ml +++ b/compiler/ml/matching.ml @@ -1911,7 +1911,7 @@ let combine_constant loc arg cst partial ctx def List.map (fun (c, act) -> match c with - | Asttypes.Const_string (s, _) -> (s, act) + | Asttypes.Const_string s -> (s, act) | _ -> assert false) const_lambda_list in @@ -2625,8 +2625,7 @@ let partial_function loc () = const (Const_block ( Blk_tuple, - [const_string fname None; const_int line; const_int char] - )); + [const_string fname; const_int line; const_int char] )); ] loc; ] diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml index 297b68129af..ef6ccd8c217 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -269,7 +269,7 @@ let const_compare x y = compare (float_of_string f1) (float_of_string f2) | Const_bigint (s1, b1), Const_bigint (s2, b2) -> Bigint_utils.compare (s1, b1) (s2, b2) - | Const_string (s1, _), Const_string (s2, _) -> String.compare s1 s2 + | Const_string s1, Const_string s2 -> String.compare s1 s2 | _, _ -> compare x y let records_args l1 l2 = @@ -370,7 +370,7 @@ let pretty_const c = match c with | Const_int i -> Printf.sprintf "%d" i | Const_char i -> Printf.sprintf "%s" (Pprintast.string_of_int_as_char i) - | Const_string (s, _) -> Printf.sprintf "%S" s + | Const_string s -> Printf.sprintf "%S" s | Const_float f -> Printf.sprintf "%s" f | Const_bigint (sign, i) -> Printf.sprintf "%s" (Bigint_utils.to_string sign i) @@ -1080,10 +1080,10 @@ let build_other ext env : Typedtree.pattern = | (({pat_desc = Tpat_constant (Const_string _)} as p), _) :: _ -> build_other_constant (function - | Tpat_constant (Const_string (s, _)) -> String.length s + | Tpat_constant (Const_string s) -> String_literal.utf16_length s | _ -> assert false) (function - | i -> Tpat_constant (Const_string (String.make i '*', None))) + | i -> Tpat_constant (Const_string (String.make i '*'))) 0 succ p env | (({pat_desc = Tpat_constant (Const_float _)} as p), _) :: _ -> build_other_constant diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 0d677c4a8cc..3044e9a08ba 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -24,12 +24,40 @@ type constant = Suffixes [g-z][G-Z] are accepted by the parser. Suffixes except 'l', 'L' are rejected by the typechecker *) - | Pconst_char of int - (* 'c' *) - | Pconst_string of string * string option - (* "constant" - {delim|other constant|delim} - *) + | Pconst_char of {source: string; semantic: int} + (* An ordinary character literal. + + [source] is the text between the single quotes, as produced by the scanner, + and is retained for printing. [semantic] is the decoded Unicode code point + used by typing and matching. For example, ['\u{1F600}'] produces + [{source = "\\u{1F600}"; semantic = 0x1F600}]. + + Compiler-created literals use [String_literal.encode_char_source] to derive + a canonical [source] from [semantic]. *) + | Pconst_string of String_literal.string_literal + (* An ordinary double-quoted string literal. + + [source] is the text between the quotes, as produced by the scanner, and is + retained for printing. [semantic] is the decoded runtime string used by + typing, matching, and optimizations. For example, ["a\\n"] produces + a payload whose source is ["a\\n"] and whose semantic value contains an + actual newline. + + The scanner preserves user-written escape spelling except that it rewrites + legacy three-digit decimal escapes to hexadecimal escapes. Compiler-created + Payloads are constructed through [String_literal], which validates this + relationship. *) + | Pconst_json of string + (* The JavaScript source inside a non-interpolated [json`...`] literal. For + example, [@as(json`{"ok": true}`)] stores ["{\"ok\": true}"]. Built-in + FFI processing consumes this form in supported external attributes; + otherwise the frontend rejects it. The string is JavaScript source, not a + decoded ReScript string value. *) + | Pconst_raw_source of string + (* JavaScript source carried by a compiler extension such as [raw], [ffi], or + [re]. For example, [%raw("x + 1")] stores ["x + 1"]. The extension + interprets the string as JavaScript source rather than as a ReScript + runtime string value. *) | Pconst_float of string * char option (* 3.4 2e5 1.4e-4 @@ -331,7 +359,26 @@ and expression_desc = | Pexp_for_of of pattern * expression * expression (* for pattern of array_expr do body_expr *) | Pexp_for_await_of of pattern * expression * expression -(* for await pattern of iterable_expr do body_expr *) + (* for await pattern of iterable_expr do body_expr *) + | Pexp_template of {source_segments: string loc list; values: expression list} + (* An ordinary backquoted expression. [source_segments] contains the validated + text between and around the interpolations, including escape spelling; + [values] contains the interpolated expressions. For example, [`plain`] + produces [{source_segments = [{txt = "plain"; loc}]; values = []}], while + [`hello ${name}!`] produces + [{source_segments = [{txt = "hello "; loc}; {txt = "!"; loc}]; values = + [name]}]. Each segment retains its source location, and there is always one + more source segment than value. *) + | Pexp_tagged_template of { + tag: expression; + raw_sources: string loc list; + values: expression list; + } +(* A JavaScript tagged template. For example, [sql`id = ${id}`] produces the + expression [sql] as [tag], located strings ["id = "; ""] as [raw_sources], + and [values = [id]]. There is always one more raw source than value. Each raw + source keeps its exact escape spelling and source location, and may contain + an invalid escape, as JavaScript permits for tagged templates. *) (* an element of a record pattern or expression *) and 'a record_element = {lid: Longident.t loc; x: 'a; opt: bool (* optional *)} diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index 6c6dcf76573..d421bc2b6f0 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -251,10 +251,14 @@ let print_quoted_string_with_byte_width f s = print_string_with_byte_width f quoted let constant f = function - | Pconst_char i -> pp f "%s" (string_of_int_as_char i) - | Pconst_string (i, None) -> print_quoted_string_with_byte_width f i - | Pconst_string (i, Some delim) -> - pp f "{%s|%a|%s}" delim print_string_with_byte_width i delim + | Pconst_char {source} -> pp f "'%s'" source + | Pconst_string payload -> + pp f "{js|%a|js}" print_string_with_byte_width + (String_literal.string_source payload) + | Pconst_json source -> + pp f "{json|%a|json}" print_string_with_byte_width source + | Pconst_raw_source source -> + pp f "{js|%a|js}" print_string_with_byte_width source | Pconst_integer (i, None) -> paren (i.[0] = '-') (fun f -> pp f "%s") f i | Pconst_integer (i, Some m) -> paren (i.[0] = '-') (fun f (i, m) -> pp f "%s%c" i m) f (i, m) @@ -757,6 +761,25 @@ and expression ctxt f x = | Pexp_variant (l, Some eo) -> pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo | Pexp_extension e -> extension ctxt f e | Pexp_await e -> pp f "@[await@ %a@]" (simple_expr ctxt) e + | Pexp_template {source_segments; values} -> + let rec parts f (source_segments, values) = + match (source_segments, values) with + | [{txt = source}], [] -> pp f "%s" source + | {txt = source} :: source_segments, value :: values -> + pp f "%s${%a}%a" source (expression ctxt) value parts + (source_segments, values) + | _ -> assert false + in + pp f "`%a`" parts (source_segments, values) + | Pexp_tagged_template {tag; raw_sources; values} -> + let rec parts f (sources, values) = + match (sources, values) with + | [{txt = source}], [] -> pp f "%s" source + | {txt = source} :: sources, value :: values -> + pp f "%s${%a}%a" source (expression ctxt) value parts (sources, values) + | _ -> assert false + in + pp f "%a`%a`" (simple_expr ctxt) tag parts (raw_sources, values) | _ -> expression1 ctxt f x and expression1 ctxt f x = diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index cd4d7bd148e..b15cecd6f37 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -60,10 +60,14 @@ let fmt_char_option f = function let fmt_constant f x = match x with | Pconst_integer (i, m) -> fprintf f "PConst_int (%s,%a)" i fmt_char_option m - | Pconst_char c -> fprintf f "PConst_char %02x" c - | Pconst_string (s, None) -> fprintf f "PConst_string(%S,None)" s - | Pconst_string (s, Some delim) -> - fprintf f "PConst_string (%S,Some %S)" s delim + | Pconst_char {source; semantic} -> + fprintf f "PConst_char(source=%S, semantic=%02x)" source semantic + | Pconst_string payload -> + fprintf f "PConst_string (source=%S, semantic=%S)" + (String_literal.string_source payload) + (String_literal.string_semantic payload) + | Pconst_json source -> fprintf f "PConst_json %S" source + | Pconst_raw_source source -> fprintf f "PConst_raw_source %S" source | Pconst_float (s, m) -> fprintf f "PConst_float (%s,%a)" s fmt_char_option m let fmt_mutable_flag f x = @@ -378,6 +382,19 @@ and expression i ppf x = | Pexp_extension (s, arg) -> line i ppf "Pexp_extension \"%s\"\n" s.txt; payload i ppf arg + | Pexp_template {source_segments; values} -> + line i ppf "Pexp_template\n"; + List.iter + (fun {Asttypes.txt} -> line (i + 1) ppf "source_segment %S\n" txt) + source_segments; + List.iter (expression (i + 1) ppf) values + | Pexp_tagged_template {tag; raw_sources; values} -> + line i ppf "Pexp_tagged_template\n"; + expression (i + 1) ppf tag; + List.iter + (fun {Asttypes.txt} -> line (i + 1) ppf "raw_source %S\n" txt) + raw_sources; + List.iter (expression (i + 1) ppf) values | Pexp_await e -> line i ppf "Pexp_await\n"; expression i ppf e diff --git a/compiler/ml/printlambda.ml b/compiler/ml/printlambda.ml index dae4aa73e59..24ff88dfb20 100644 --- a/compiler/ml/printlambda.ml +++ b/compiler/ml/printlambda.ml @@ -20,7 +20,7 @@ open Lambda let rec struct_const ppf = function | Const_int n -> fprintf ppf "%ld" n | Const_char i -> fprintf ppf "%s" (Pprintast.string_of_int_as_char i) - | Const_string {s} -> fprintf ppf "%S" s + | Const_string s -> fprintf ppf "%S" s | Const_float f -> fprintf ppf "%s" f | Const_bigint (sign, n) -> fprintf ppf "%sn" (Bigint_utils.to_string sign n) | Const_constructor {name} -> fprintf ppf "%s" name @@ -228,7 +228,8 @@ let primitive ppf = function | Praw_js_code _ -> fprintf ppf "raw_js_code" | Pjs_fn_method -> fprintf ppf "#fn_method" (* Debug-only dump, exercised solely under -drawlambda/-dlambda. *) - | Ptagged_template -> fprintf ppf "#tagged_template" [@coverage off] + | Ptagged_template _ -> fprintf ppf "#tagged_template" [@coverage off] + | Ptemplate _ -> fprintf ppf "#template" [@coverage off] let function_attribute ppf {inline; is_a_functor; return_unit} = if is_a_functor then fprintf ppf "is_a_functor@ "; diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml index 7c00393f84a..9debd2d01ae 100644 --- a/compiler/ml/printtyped.ml +++ b/compiler/ml/printtyped.ml @@ -51,9 +51,7 @@ let fmt_constant f x = match x with | Const_int i -> fprintf f "Const_int %d" i | Const_char c -> fprintf f "Const_char %02x" c - | Const_string (s, None) -> fprintf f "Const_string(%S,None)" s - | Const_string (s, Some delim) -> - fprintf f "Const_string (%S,Some %S)" s delim + | Const_string s -> fprintf f "Const_string(%S)" s | Const_float s -> fprintf f "Const_float %s" s | Const_bigint (sign, i) -> fprintf f "Const_bigint %s" (Bigint_utils.to_string sign i) @@ -362,6 +360,24 @@ and expression i ppf x = line i ppf "Texp_for_await_of \"%a\"\n" fmt_ident s; expression i ppf e1; expression i ppf e2 + | Texp_template {segments; values} -> + line i ppf "Texp_template segments=%a\n" + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf ", ") + (fun ppf segment -> + Format.fprintf ppf "{source=%S; semantic=%S}" + (String_literal.template_source segment) + (String_literal.template_semantic segment))) + segments; + List.iter (expression i ppf) values + | Texp_tagged_template {tag; raw_sources; values} -> + line i ppf "Texp_tagged_template raw_sources=%a\n" + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf ", ") + (fun ppf source -> Format.fprintf ppf "%S" source)) + raw_sources; + expression i ppf tag; + List.iter (expression i ppf) values | Texp_object_get (e, s) -> line i ppf "Texp_object_get \"%s\"\n" s.txt; expression i ppf e diff --git a/compiler/ml/rec_check.ml b/compiler/ml/rec_check.ml index f25169dcaa0..2fdd4eb1846 100644 --- a/compiler/ml/rec_check.ml +++ b/compiler/ml/rec_check.ml @@ -208,7 +208,8 @@ let rec classify_expression : Typedtree.expression -> sd = | Texp_apply {funct = {exp_desc = Texp_ident (_, _, vd)}} when is_ref vd -> Static | Texp_apply _ | Texp_match _ | Texp_ifthenelse _ | Texp_object_get _ - | Texp_object_set _ | Texp_field _ | Texp_assert _ | Texp_try _ -> + | Texp_object_set _ | Texp_field _ | Texp_assert _ | Texp_try _ + | Texp_tagged_template _ | Texp_template _ -> Dynamic let rec expression : Env.env -> Typedtree.expression -> Use.t = @@ -260,6 +261,10 @@ let rec expression : Env.env -> Typedtree.expression -> Use.t = | Texp_apply {funct = e; args} -> let arg env (_, eo) = option expression env eo in Use.(join (inspect (expression env e)) (inspect (list arg env args))) + | Texp_tagged_template {tag; values} -> + Use.( + join (inspect (expression env tag)) (inspect (list expression env values))) + | Texp_template {values} -> Use.guard (list expression env values) | Texp_tuple exprs -> Use.guard (list expression env exprs) | Texp_array exprs -> Use.guard (list expression env exprs) | Texp_construct (_, desc, exprs) -> diff --git a/compiler/ml/record_coercion.ml b/compiler/ml/record_coercion.ml index 1c1422523df..7a9b248f586 100644 --- a/compiler/ml/record_coercion.ml +++ b/compiler/ml/record_coercion.ml @@ -30,12 +30,13 @@ let check_record_fields (fields1 : Types.label_declaration list) right_optional = ld2.ld_optional; }); let get_as (({txt}, payload) : Parsetree.attribute) = - if txt = "as" then Ast_payload.is_single_string payload else None + if txt = "as" then Ast_payload.semantic_string_of_payload payload + else None in let get_as_name (ld : Types.label_declaration) = match Ext_list.filter_map ld.ld_attributes get_as with | [] -> None - | (s, _) :: _ -> Some s + | s :: _ -> Some s in let get_label_runtime_name (ld : Types.label_declaration) = match get_as_name ld with diff --git a/compiler/ml/string_literal.ml b/compiler/ml/string_literal.ml new file mode 100644 index 00000000000..4f7183b96e2 --- /dev/null +++ b/compiler/ml/string_literal.ml @@ -0,0 +1,337 @@ +(* [source] is the original literal body and [semantic] is exactly what + JavaScript evaluates that body to. [Invalid_source] is confined by the + interface to ordinary-string parser recovery. *) +type payload = + | Valid of {source: string; semantic: string} + | Invalid_source of string +type string_literal = payload +type template_segment = payload + +let payload_source = function + | Valid {source} | Invalid_source source -> source +let payload_semantic = function + | Valid {semantic} -> semantic + | Invalid_source _ -> "" + +let string_source (literal : string_literal) = payload_source literal +let string_semantic (literal : string_literal) = payload_semantic literal +let template_source (segment : template_segment) = payload_source segment +let template_semantic (segment : template_segment) = payload_semantic segment + +let hex_value = function + | '0' .. '9' as c -> Char.code c - Char.code '0' + | 'a' .. 'f' as c -> Char.code c - Char.code 'a' + 10 + | 'A' .. 'F' as c -> Char.code c - Char.code 'A' + 10 + | _ -> -1 + +let is_high_surrogate codepoint = codepoint >= 0xd800 && codepoint <= 0xdbff +let is_low_surrogate codepoint = codepoint >= 0xdc00 && codepoint <= 0xdfff + +let combine_surrogate_pair high low = + 0x10000 + ((high - 0xd800) lsl 10) + (low - 0xdc00) + +let is_valid_utf8 = String.is_valid_utf_8 + +let replace_invalid_utf8 s = + let len = String.length s in + let buf = Buffer.create len in + let rec loop index = + if index < len then + let decoded = String.get_utf_8_uchar s index in + let decoded_len = Uchar.utf_decode_length decoded in + if Uchar.utf_decode_is_valid decoded then ( + Buffer.add_substring buf s index decoded_len; + loop (index + decoded_len)) + else ( + Buffer.add_utf_8_uchar buf Uchar.rep; + loop (index + decoded_len)) + in + loop 0; + Buffer.contents buf + +let normalize_semantic semantic = + (* Valid compiler-generated strings need no copy. For malformed input, map + each byte independently to preserve the value previously emitted as a + JavaScript [\xHH] escape. *) + if is_valid_utf8 semantic then semantic + else + let length = String.length semantic in + let buffer = Buffer.create length in + let rec loop index = + if index < length then + let decoded = String.get_utf_8_uchar semantic index in + if Uchar.utf_decode_is_valid decoded then ( + let decoded_length = Uchar.utf_decode_length decoded in + Buffer.add_substring buffer semantic index decoded_length; + loop (index + decoded_length)) + else ( + Buffer.add_string buffer + (Ext_utf8.encode_codepoint + (Char.code (String.unsafe_get semantic index))); + loop (index + 1)) + in + loop 0; + Buffer.contents buffer + +let decode_js_escapes_with ~normalize_template_line_endings s = + let len = String.length s in + let buf = Buffer.create len in + let add_codepoint codepoint = + if Uchar.is_valid codepoint then ( + Buffer.add_utf_8_uchar buf (Uchar.of_int codepoint); + true) + else false + in + let decode_fixed_hex start count = + let rec loop index remaining value = + if remaining = 0 then Some value + else if index >= len then None + else + let digit = hex_value s.[index] in + if digit < 0 then None + else loop (index + 1) (remaining - 1) ((value * 16) + digit) + in + loop start count 0 + in + let decode_braced_hex start = + let rec loop index value has_digit = + if index >= len then None + else + match s.[index] with + | '}' when has_digit -> Some (value, index + 1) + | c -> + let digit = hex_value c in + if digit < 0 || value > (0x10ffff - digit) / 16 then None + else loop (index + 1) ((value * 16) + digit) true + in + loop start 0 false + in + let copy_utf8 index = + let decoded = String.get_utf_8_uchar s index in + if Uchar.utf_decode_is_valid decoded then ( + let length = Uchar.utf_decode_length decoded in + Buffer.add_substring buf s index length; + Some (index + length)) + else None + in + let rec loop index = + if index = len then Some (Buffer.contents buf) + else + match s.[index] with + | '\\' when index + 1 >= len -> None + | '\\' + when index + 3 < len + && s.[index + 1] = '\226' + && s.[index + 2] = '\128' + && (s.[index + 3] = '\168' || s.[index + 3] = '\169') -> + (* U+2028 LINE SEPARATOR and U+2029 PARAGRAPH SEPARATOR are JavaScript + line terminators, so a preceding backslash makes them line + continuations just like LF and CR. *) + loop (index + 4) + | '\\' -> ( + match s.[index + 1] with + | 'b' -> + Buffer.add_char buf '\b'; + loop (index + 2) + | 'f' -> + Buffer.add_char buf '\012'; + loop (index + 2) + | 'n' -> + Buffer.add_char buf '\n'; + loop (index + 2) + | 'r' -> + Buffer.add_char buf '\r'; + loop (index + 2) + | 't' -> + Buffer.add_char buf '\t'; + loop (index + 2) + | 'v' -> + Buffer.add_char buf '\011'; + loop (index + 2) + | '0' + when normalize_template_line_endings + && index + 2 < len + && s.[index + 2] >= '0' + && s.[index + 2] <= '9' -> + None + | '0' -> + Buffer.add_char buf '\000'; + loop (index + 2) + | '1' .. '9' when normalize_template_line_endings -> None + | '\n' -> loop (index + 2) + | '\r' -> + if index + 2 < len && s.[index + 2] = '\n' then loop (index + 3) + else loop (index + 2) + | 'x' -> ( + match decode_fixed_hex (index + 2) 2 with + | Some codepoint when add_codepoint codepoint -> loop (index + 4) + | Some _ | None -> None) + | 'u' when index + 2 < len && s.[index + 2] = '{' -> ( + match decode_braced_hex (index + 3) with + | Some (codepoint, next) when add_codepoint codepoint -> loop next + | Some _ | None -> None) + | 'u' -> ( + match decode_fixed_hex (index + 2) 4 with + | Some high when is_high_surrogate high -> + if index + 7 < len && s.[index + 6] = '\\' && s.[index + 7] = 'u' + then + match decode_fixed_hex (index + 8) 4 with + | Some low when is_low_surrogate low -> + let codepoint = combine_surrogate_pair high low in + if add_codepoint codepoint then loop (index + 12) else None + | Some _ | None -> None + else None + | Some codepoint when add_codepoint codepoint -> loop (index + 6) + | Some _ | None -> None) + | _ -> ( + (* JavaScript non-escape characters, such as [\a], evaluate to the + character following the backslash. This also handles escaped + quotes, backslashes, dollars, backticks, and spaces. *) + match copy_utf8 (index + 1) with + | Some next -> loop next + | None -> None)) + | '\r' when normalize_template_line_endings -> + (* JavaScript's template value normalizes literal CR and CRLF source + line endings to LF. This branch deliberately runs after escape + handling, so an explicit [\r] escape still decodes to CR, and the + ordinary string decoder continues to preserve literal line endings. *) + Buffer.add_char buf '\n'; + if index + 1 < len && s.[index + 1] = '\n' then loop (index + 2) + else loop (index + 1) + | '$' + when normalize_template_line_endings + && index + 1 < len + && s.[index + 1] = '{' -> + (* An unescaped interpolation opener cannot occur inside one template + segment. Treat it as invalid so callers can safely validate joined + segment sources with this decoder. *) + None + | _ -> ( + match copy_utf8 index with + | Some next -> loop next + | None -> None) + in + loop 0 + +let decode_js_escapes = + decode_js_escapes_with ~normalize_template_line_endings:false + +let decode_js_template_escapes = + decode_js_escapes_with ~normalize_template_line_endings:true + +type encode_js_mode = String | Template + +let encode_js mode s = + let buf = Buffer.create (String.length s) in + String.iter + (function + | '\b' -> Buffer.add_string buf {e|\b|e} + | '\012' -> Buffer.add_string buf {e|\f|e} + | '\n' -> Buffer.add_string buf {e|\n|e} + | '\r' -> Buffer.add_string buf {e|\r|e} + | '\t' -> Buffer.add_string buf {e|\t|e} + | '\011' -> Buffer.add_string buf {e|\v|e} + | '\\' -> Buffer.add_string buf {e|\\|e} + | ('\000' .. '\031' | '\127') as c -> + Buffer.add_string buf (Printf.sprintf {e|\x%02X|e} (Char.code c)) + | '"' as c -> ( + match mode with + | String -> Buffer.add_string buf {e|\"|e} + | Template -> Buffer.add_char buf c) + | ('`' | '$') as c -> ( + match mode with + | String -> Buffer.add_char buf c + | Template -> + Buffer.add_char buf '\\'; + Buffer.add_char buf c) + | c -> Buffer.add_char buf c) + s; + Buffer.contents buf + +let encode_js_string = encode_js String + +let encode_js_template = encode_js Template + +let string_from_source source : string_literal option = + match decode_js_escapes source with + | Some semantic -> Some (Valid {source; semantic}) + | None -> None + +let string_from_semantic semantic : string_literal = + let semantic = normalize_semantic semantic in + Valid {source = encode_js_string semantic; semantic} + +let invalid_string_for_recovery source : string_literal = Invalid_source source + +let template_from_source source : template_segment option = + match decode_js_template_escapes source with + | Some semantic -> Some (Valid {source; semantic}) + | None -> None + +let template_from_semantic semantic : template_segment = + let semantic = normalize_semantic semantic in + Valid {source = encode_js_template semantic; semantic} + +let concat_template segments = + let source = String.concat "" (List.map template_source segments) in + let semantic = String.concat "" (List.map template_semantic segments) in + (* Joining individually valid sources can change their interpretation at a + boundary, most notably by creating an unescaped [${]. Preserve the joined + spelling only if decoding it still produces the joined semantic value. *) + match decode_js_template_escapes source with + | Some decoded when decoded = semantic -> Valid {source; semantic} + | _ -> template_from_semantic semantic + +let encode_char_source codepoint = + match codepoint with + | 0x08 -> {e|\b|e} + | 0x09 -> {e|\t|e} + | 0x0a -> {e|\n|e} + | 0x0d -> {e|\r|e} + | 0x27 -> {e|\'|e} + | 0x5c -> {e|\\|e} + | codepoint when (codepoint >= 0x00 && codepoint <= 0x1f) || codepoint = 0x7f + -> + Printf.sprintf {e|\x%02X|e} codepoint + | codepoint when codepoint >= 0x20 && codepoint <= 0x7e -> + String.make 1 (Char.unsafe_chr codepoint) + | codepoint when Uchar.is_valid codepoint -> + Ext_utf8.encode_codepoint codepoint + | codepoint -> Printf.sprintf {e|\u{%X}|e} codepoint + +let decode_utf8_uchar_exn s index = + let decoded = String.get_utf_8_uchar s index in + if Uchar.utf_decode_is_valid decoded then decoded + else raise (Ext_utf8.Invalid_utf8 "Invalid UTF-8 sequence") + +let utf16_length s = + let len = String.length s in + let rec loop length index = + if index = len then length + else + let decoded = decode_utf8_uchar_exn s index in + let codepoint = Uchar.to_int (Uchar.utf_decode_uchar decoded) in + loop + (length + if codepoint > 0xffff then 2 else 1) + (index + Uchar.utf_decode_length decoded) + in + loop 0 0 + +let code_point_at_utf16_index s index = + if index < 0 then None + else + let len = String.length s in + let rec loop utf16_index byte_index = + if byte_index = len then None + else + let decoded = decode_utf8_uchar_exn s byte_index in + let codepoint = Uchar.to_int (Uchar.utf_decode_uchar decoded) in + if utf16_index = index then Some codepoint + else if codepoint > 0xffff && utf16_index + 1 = index then + Some (0xdc00 + ((codepoint - 0x10000) land 0x3ff)) + else + loop + (utf16_index + if codepoint > 0xffff then 2 else 1) + (byte_index + Uchar.utf_decode_length decoded) + in + loop 0 0 diff --git a/compiler/ml/string_literal.mli b/compiler/ml/string_literal.mli new file mode 100644 index 00000000000..78fcb617b89 --- /dev/null +++ b/compiler/ml/string_literal.mli @@ -0,0 +1,101 @@ +(** JavaScript string-literal representation and conversion utilities. + + A literal has two related values: [source] is the text between its source + delimiters, including escape spelling, while [semantic] is the UTF-8 text + observed at runtime after JavaScript escape decoding. Keeping them together + prevents compiler passes from accidentally treating source spelling as a + runtime value, or from emitting a semantic value without escaping it. + + Ordinary quoted strings and template segments have different grammars, so + they are distinct abstract types. Values should be created through the + constructors below so the source/semantic invariant holds. *) + +type string_literal +(** An ordinary JavaScript string body and its semantic value. Parser error + recovery may retain an invalid source spelling with an empty placeholder + semantic value. *) + +type template_segment +(** A validated JavaScript template segment and its semantic value. *) + +val string_source : string_literal -> string +(** Return the source text between the literal's delimiters. *) + +val string_semantic : string_literal -> string +(** Return the decoded runtime value. Invalid ordinary strings retained solely + for parser recovery return the empty placeholder value. *) + +val template_source : template_segment -> string +(** Return the source text between the template delimiters or interpolations. *) + +val template_semantic : template_segment -> string +(** Return the decoded runtime value of a template segment. *) + +val is_valid_utf8 : string -> bool +(** Whether a string consists entirely of valid UTF-8 scalar sequences. *) + +val replace_invalid_utf8 : string -> string +(** Replace each malformed UTF-8 sequence with the Unicode replacement + character. Use this for recovering source text intended for diagnostics. *) + +val normalize_semantic : string -> string +(** Convert each malformed byte to the corresponding Unicode code point while + preserving valid UTF-8 sequences. This retains the runtime value produced + by the JavaScript string dumper for legacy and compiler-generated bytes. + Valid UTF-8 is returned unchanged. *) + +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 decode_js_template_escapes : string -> string option +(** Decode the escape sequences in a JavaScript template segment into its + semantic UTF-8 value. Literal CR and CRLF line endings are normalized to LF + as required by JavaScript template-literal semantics. Returns [None] for + malformed escapes, malformed UTF-8, or an unescaped interpolation opener. *) + +val encode_js_string : string -> string +(** Encode a semantic UTF-8 string as a canonical JavaScript string-literal + body. *) + +val encode_js_template : string -> string +(** Encode a semantic UTF-8 string as a canonical JavaScript template-segment + body. *) + +val string_from_source : string -> string_literal option +(** Validate and decode an ordinary string-literal body. *) + +val string_from_semantic : string -> string_literal +(** Construct an ordinary string payload with canonical source spelling. + Malformed bytes are normalized with [normalize_semantic] first. *) + +val invalid_string_for_recovery : string -> string_literal +(** Preserve the source of an invalid parser input after its diagnostic has + been recorded. Its placeholder semantic value is the empty string. *) + +val template_from_source : string -> template_segment option +(** Validate and decode one template segment. *) + +val template_from_semantic : string -> template_segment +(** Construct a template segment with canonical source spelling. Malformed + bytes are normalized with [normalize_semantic] first. *) + +val concat_template : template_segment list -> template_segment +(** Concatenate template segments, preserving their combined source spelling + when it still decodes to the combined semantic value and otherwise using a + canonical spelling. Re-decoding is necessary because joining two valid + segments can create syntax such as an interpolation opener at the boundary. *) + +val encode_char_source : int -> string +(** Encode an integer as a canonical character-literal body. Non-scalar values + use braced Unicode escape spelling so compiler-generated ghost patterns and + legacy PPX output remain printable. *) + +val utf16_length : string -> int +(** Return the number of UTF-16 code units in a semantic UTF-8 string, matching + JavaScript's [String.length]. *) + +val code_point_at_utf16_index : string -> int -> int option +(** Return the result of JavaScript's [String.codePointAt] for a UTF-16 code + unit index into a semantic UTF-8 string. *) diff --git a/compiler/ml/tast_iterator.ml b/compiler/ml/tast_iterator.ml index a928e7dd6dd..81c8ac9bd97 100644 --- a/compiler/ml/tast_iterator.ml +++ b/compiler/ml/tast_iterator.ml @@ -199,6 +199,10 @@ let expr sub {exp_extra; exp_desc; exp_env; _} = | Texp_for_await_of (_, _, exp1, exp2) -> sub.expr sub exp1; sub.expr sub exp2 + | Texp_template {values} -> List.iter (sub.expr sub) values + | Texp_tagged_template {tag; values} -> + sub.expr sub tag; + List.iter (sub.expr sub) values | Texp_object_get (exp, _) -> sub.expr sub exp | Texp_object_set (exp, _, v) -> sub.expr sub exp; diff --git a/compiler/ml/tast_mapper.ml b/compiler/ml/tast_mapper.ml index 5a765aedd47..338f3c1da5c 100644 --- a/compiler/ml/tast_mapper.ml +++ b/compiler/ml/tast_mapper.ml @@ -253,6 +253,15 @@ let expr sub x = Texp_for_of (id, p, sub.expr sub exp1, sub.expr sub exp2) | Texp_for_await_of (id, p, exp1, exp2) -> Texp_for_await_of (id, p, sub.expr sub exp1, sub.expr sub exp2) + | Texp_template {segments; values} -> + Texp_template {segments; values = List.map (sub.expr sub) values} + | Texp_tagged_template {tag; raw_sources; values} -> + Texp_tagged_template + { + tag = sub.expr sub tag; + raw_sources; + values = List.map (sub.expr sub) values; + } | Texp_object_get (exp, name) -> Texp_object_get (sub.expr sub exp, name) | Texp_object_set (exp, name, v) -> Texp_object_set (sub.expr sub exp, name, sub.expr sub v) diff --git a/compiler/ml/transl_recmodule.ml b/compiler/ml/transl_recmodule.ml index 436fb419a27..986aba723d8 100644 --- a/compiler/ml/transl_recmodule.ml +++ b/compiler/ml/transl_recmodule.ml @@ -14,12 +14,11 @@ let undefined_location loc = let fname = Filename.basename fname in const (Const_block - ( Lambda.Blk_tuple, - [const_string fname None; const_int line; const_int char] )) + (Lambda.Blk_tuple, [const_string fname; const_int line; const_int char])) let init_shape modl = let add_name x id = - Const_block (Blk_tuple, [x; const_string (Ident.name id) None]) + Const_block (Blk_tuple, [x; const_string (Ident.name id)]) in let module_tag_info : Lambda.tag_info = Blk_constructor diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml index d8097648f29..70519a7ea21 100644 --- a/compiler/ml/translcore.ml +++ b/compiler/ml/translcore.ml @@ -462,7 +462,7 @@ let warn_polymorphic_comparison loc (builtin : Lambda.builtin) args = let lambda_of_inline_const (c : External_ffi_types.inline_const) : Lambda.structured_constant = match c with - | Const_str {s; delim} -> Const_string {s; delim} + | External_ffi_types.Const_string s -> Const_string s | Const_bool true -> Const_js_true | Const_bool false -> Const_js_false | Const_int i -> Const_int i @@ -734,23 +734,19 @@ let lam_of_loc kind loc = const (Const_block ( Blk_tuple, - [ - const_string file None; - const_int lnum; - const_int cnum; - const_int enum; - ] )) - | Loc_FILE -> const (const_string file None) + [const_string file; const_int lnum; const_int cnum; const_int enum] + )) + | Loc_FILE -> const (const_string file) | Loc_MODULE -> let filename = Filename.basename file in let name = Env.get_unit_name () in let module_name = if name = "" then "//" ^ filename ^ "//" else name in - const (const_string module_name None) + const (const_string module_name) | Loc_LOC -> let loc = Printf.sprintf "File %S, line %d, characters %d-%d" file lnum cnum enum in - const (const_string loc None) + const (const_string loc) | Loc_LINE -> const (const_int lnum) (* Eta-expand a primitive *) @@ -895,8 +891,7 @@ let assert_failed exp = const (Const_block ( Blk_tuple, - [const_string fname None; const_int line; const_int char] - )); + [const_string fname; const_int line; const_int char] )); ] exp.exp_loc; ] @@ -970,7 +965,10 @@ let pack_trywith_exn id handler = let extract_directive_for_fn exp = exp.exp_attributes |> List.find_map (fun ({txt}, payload) -> - if txt = "directive" then Ast_payload.is_single_string payload else None) + if txt = "directive" then ( + Ast_payload.reject_json_literal_payload payload; + Ast_payload.semantic_string_of_payload payload) + else None) let hoisted_function_attr_name = "res.hoistedFunction" @@ -1015,11 +1013,7 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.t = | Texp_let (rec_flag, pat_expr_list, body) -> transl_let ~js_hoist:None rec_flag pat_expr_list (transl_exp body) | Texp_function {params = fparams; body; async} -> - let directive = - match extract_directive_for_fn e with - | None -> None - | Some (directive, _) -> Some directive - in + let directive = extract_directive_for_fn e in let params, lbody, return_unit = transl_function e.exp_loc fparams body in let one_unit_arg = match (fparams, (Ctype.expand_head e.exp_env e.exp_type).desc) with @@ -1042,23 +1036,12 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.t = in let loc = e.exp_loc in function_ ~loc ~attr ~params ~body:lbody - | Texp_apply {funct; args = oargs} - when List.exists - (fun (attr, _) -> attr.txt = "res.taggedTemplate") - e.exp_attributes -> - (* Backtick tagged-template syntax on a value of the builtin - [taggedTemplate<'param, 'output>] type. Typecore has already checked the - tag's type, so here we just emit a real JS tagged-template literal, - regardless of how the tag value was obtained (external, let-binding, - function parameter, factory result, cross-module). *) - let strings, values = - match oargs with - | [(_, Some strings); (_, Some values)] -> (strings, values) - | _ -> assert false - in - prim ~primitive:Ptagged_template - ~args:[transl_exp funct; transl_exp strings; transl_exp values] + | Texp_tagged_template {tag; raw_sources; values} -> + prim ~primitive:(Ptagged_template raw_sources) + ~args:(transl_exp tag :: transl_list values) e.exp_loc + | Texp_template {segments; values} -> + prim ~primitive:(Ptemplate segments) ~args:(transl_list values) e.exp_loc | Texp_apply { funct = @@ -1110,13 +1093,13 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.t = (* an external: expand its FFI spec here; %raw parses and classifies its snippet *) match (p.prim_name, argl) with - | "#raw_expr", [Lconst (Const_string {s = code})] -> + | "#raw_expr", [Lconst (Const_string code)] -> let kind = Classify_function.classify code in wrap (prim ~primitive:(Praw_js_code {code; code_info = Exp kind}) ~args:[] e.exp_loc) - | "#raw_stmt", [Lconst (Const_string {s = code})] -> + | "#raw_stmt", [Lconst (Const_string code)] -> let kind = Classify_function.classify_stmt code in wrap (prim diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 2d2e1c180d3..00b6b60e729 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -82,6 +82,8 @@ type error = | Literal_overflow of string | Polyvar_literal_overflow | Unknown_literal of string * char + | Invalid_string_escape_sequence + | Json_literal_outside_external | Illegal_letrec_pat | Empty_record_literal | Uncurried_arity_mismatch of { @@ -172,6 +174,10 @@ let iter_expression f e = | Pexp_apply {funct = e; args = lel} -> expr e; List.iter (fun (_, e) -> expr e) lel + | Pexp_template {values} -> List.iter expr values + | Pexp_tagged_template {tag; values} -> + expr tag; + List.iter expr values | Pexp_let (_, pel, e) -> expr e; List.iter binding pel @@ -277,8 +283,11 @@ let constant : Parsetree.constant -> (Asttypes.constant, error) result = let sign, i = Bigint_utils.parse_bigint i in Ok (Const_bigint (sign, i)) | Pconst_integer (i, Some c) -> Error (Unknown_literal (i, c)) - | Pconst_char c -> Ok (Const_char c) - | Pconst_string (s, d) -> Ok (Const_string (s, d)) + | Pconst_char {semantic} -> Ok (Const_char semantic) + | Pconst_string payload -> + Ok (Const_string (String_literal.string_semantic payload)) + | Pconst_json _ -> Error Json_literal_outside_external + | Pconst_raw_source s -> Ok (Const_string s) | Pconst_float (f, None) -> Ok (Const_float f) | Pconst_float (f, Some c) -> Error (Unknown_literal (f, c)) @@ -1345,13 +1354,16 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp pat_attributes = sp.ppat_attributes; pat_env = !env; } - | Ppat_interval (Pconst_char c1, Pconst_char c2) -> + | Ppat_interval (Pconst_char {semantic = c1}, Pconst_char {semantic = c2}) -> let open Ast_helper.Pat in let gloc = {loc with Location.loc_ghost = true} in + let char semantic = + Pconst_char + {source = String_literal.encode_char_source semantic; semantic} + in let rec loop c1 c2 = - if c1 = c2 then constant ~loc:gloc (Pconst_char c1) - else - or_ ~loc:gloc (constant ~loc:gloc (Pconst_char c1)) (loop (c1 + 1) c2) + if c1 = c2 then constant ~loc:gloc (char c1) + else or_ ~loc:gloc (constant ~loc:gloc (char c1)) (loop (c1 + 1) c2) in let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in let p = {p with ppat_loc = loc} in @@ -1868,6 +1880,7 @@ let rec is_nonexpansive exp = match exp.exp_desc with | Texp_ident (_, _, _) -> true | Texp_constant _ -> true + | Texp_template {values = []} -> true | Texp_let (_rec_flag, pat_exp_list, body) -> List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list && is_nonexpansive body @@ -2526,6 +2539,69 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp | Pexp_fun {newtypes = []; params; body = sfun_body; async} -> type_function ~async loc sexp.pexp_attributes env ty_expected params sfun_body + | Pexp_template {source_segments; values} -> + begin_def (); + let segments : Asttypes.template_segment list = + List.map + (fun {Asttypes.txt = source; loc = source_loc} -> + match String_literal.template_from_source source with + | Some segment -> segment + | None -> + raise (Error (source_loc, env, Invalid_string_escape_sequence))) + source_segments + in + let values = + List.map + (fun value -> + type_expect ~context:(Some StringConcat) env value Predef.type_string) + values + in + end_def (); + rue + { + exp_desc = Texp_template {segments; values}; + exp_loc = loc; + exp_extra = []; + exp_type = instance_def Predef.type_string; + exp_attributes = sexp.pexp_attributes; + exp_env = env; + } + | Pexp_tagged_template {tag = stag; raw_sources; values = svalues} -> + begin_def (); + let tag = + type_exp ~deprecated_context:FunctionCall ~context:None env stag + in + let param_ty = newvar () in + let output_ty = newvar () in + (try + unify env + (instance env tag.exp_type) + (newconstr Predef.path_tagged_template [param_ty; output_ty]) + with Unify _ -> + raise (Error (tag.exp_loc, env, Tagged_template_non_tag tag.exp_type))); + let values = + List.map + (fun value -> + type_expect ~context:(Some TaggedTemplateValue) env value param_ty) + svalues + in + unify_var env (newvar ()) tag.exp_type; + end_def (); + rue + { + exp_desc = + Texp_tagged_template + { + tag; + raw_sources = List.map (fun {Asttypes.txt} -> txt) raw_sources; + values; + }; + exp_loc = loc; + exp_extra = []; + exp_type = output_ty; + exp_attributes = sexp.pexp_attributes; + exp_env = env; + } | Pexp_apply {funct = sfunct; args = sargs; partial; transformed_jsx} -> assert (sargs <> []); begin_def (); @@ -2552,70 +2628,10 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp if transformed_jsx then Some JsxComponent else type_clash_context_from_function sexp sfunct in - let is_tagged_template = - Ext_list.exists sexp.pexp_attributes (fun ({txt}, _) -> - txt = "res.taggedTemplate") - in let args, ty_res, fully_applied = - if is_tagged_template then ( - (* Backtick tagged-template syntax: the tag must be a value of the - builtin [taggedTemplate<'param, 'output>] type. The parser desugars - [tag`a ${x} b`] into [tag([|"a "; " b"|], [|x|])], so the two - arguments are the string parts and the interpolated values. *) - let param_ty = newvar () in - let output_ty = newvar () in - (try - unify env - (instance env funct.exp_type) - (newconstr Predef.path_tagged_template [param_ty; output_ty]) - with Unify _ -> - raise - (Error (funct.exp_loc, env, Tagged_template_non_tag funct.exp_type))); - match sargs with - | [(Nolabel, strings); (Nolabel, values)] -> - let typed_strings = - type_expect ~context:None env strings - (Predef.type_array Predef.type_string) - in - (* Type each interpolated value directly against [param_ty] with a - tagged-template-specific clash context, rather than routing the - desugared values array through the generic array typing (which - would report a confusing "array item" type error for what the user - wrote as a [${...}] interpolation). *) - let typed_values = - match values.pexp_desc with - | Pexp_array interpolations -> - let typed_interpolations = - List.map - (fun interp -> - type_expect ~context:(Some TaggedTemplateValue) env interp - param_ty) - interpolations - in - re - { - exp_desc = Texp_array typed_interpolations; - exp_loc = values.pexp_loc; - exp_extra = []; - exp_type = newconstr Predef.path_array [param_ty]; - exp_attributes = values.pexp_attributes; - exp_env = env; - } - (* The parser always desugars the interpolated values into an array - literal, so any other shape is a compiler invariant violation. *) - | _ -> assert false - in - ( [ - (Asttypes.Nolabel, Some typed_strings); - (Asttypes.Nolabel, Some typed_values); - ], - output_ty, - true ) - | _ -> assert false) - else - match translate_unified_ops env funct sargs with - | Some (targs, result_type) -> (targs, result_type, true) - | None -> type_application ~context total_app env funct sargs + match translate_unified_ops env funct sargs with + | Some (targs, result_type) -> (targs, result_type, true) + | None -> type_application ~context total_app env funct sargs in end_def (); unify_var env (newvar ()) funct.exp_type; @@ -5248,6 +5264,10 @@ let report_error env loc ppf error = values are required." | Unknown_literal (n, m) -> fprintf ppf "Unknown modifier '%c' for literal %s%c" m n m + | Invalid_string_escape_sequence -> + fprintf ppf "Invalid string escape sequence" + | Json_literal_outside_external -> + fprintf ppf "%s" Ast_payload.json_literal_outside_external_message | Illegal_letrec_pat -> fprintf ppf "Only variables are allowed as left-hand side of `let rec`" | Empty_record_literal -> diff --git a/compiler/ml/typecore.mli b/compiler/ml/typecore.mli index 432f9c45df7..cc0cc6415cd 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -115,6 +115,8 @@ type error = | Literal_overflow of string | Polyvar_literal_overflow | Unknown_literal of string * char + | Invalid_string_escape_sequence + | Json_literal_outside_external | Illegal_letrec_pat | Empty_record_literal | Uncurried_arity_mismatch of { diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml index ad04b6f2060..e6fecd92108 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -136,6 +136,23 @@ and expression_desc = breaks analysis when it reads CMTs produced by older compiler versions. *) | Texp_for_of of Ident.t * Parsetree.pattern * expression * expression | Texp_for_await_of of Ident.t * Parsetree.pattern * expression * expression + (* A typed JavaScript tagged template. For example, [sql`id = ${id}`] stores + the typed [sql] expression in [tag], [raw_sources = ["id = "; ""]], and + the typed [id] expression in [values]. Raw sources retain their exact + spelling and may contain invalid escapes, as JavaScript permits for tagged + templates. There is always one more raw source than value. *) + | Texp_tagged_template of { + tag: expression; + raw_sources: string list; + values: expression list; + } + (* A typed ordinary backquoted template. Each segment contains both its + validated source spelling and decoded semantic value; [values] contains + the typed interpolated expressions. For example, [`a ${value}\n`] has two + segments, with the final one represented as + [{source = "\\n"; semantic = "\n"}]. There is always one more segment + than value. *) + | Texp_template of {segments: template_segment list; values: expression list} and case = {c_lhs: pattern; c_guard: expression option; c_rhs: expression} diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli index ca682cc9260..ab624cf0089 100644 --- a/compiler/ml/typedtree.mli +++ b/compiler/ml/typedtree.mli @@ -237,6 +237,23 @@ and expression_desc = breaks analysis when it reads CMTs produced by older compiler versions. *) | Texp_for_of of Ident.t * Parsetree.pattern * expression * expression | Texp_for_await_of of Ident.t * Parsetree.pattern * expression * expression + (* A typed JavaScript tagged template. For example, [sql`id = ${id}`] stores + the typed [sql] expression in [tag], [raw_sources = ["id = "; ""]], and + the typed [id] expression in [values]. Raw sources retain their exact + spelling and may contain invalid escapes, as JavaScript permits for tagged + templates. There is always one more raw source than value. *) + | Texp_tagged_template of { + tag: expression; + raw_sources: string list; + values: expression list; + } + (* A typed ordinary backquoted template. Each segment contains both its + validated source spelling and decoded semantic value; [values] contains + the typed interpolated expressions. For example, [`a ${value}\n`] has two + segments, with the final one represented as + [{source = "\\n"; semantic = "\n"}]. There is always one more segment + than value. *) + | Texp_template of {segments: template_segment list; values: expression list} and case = {c_lhs: pattern; c_guard: expression option; c_rhs: expression} diff --git a/compiler/ml/typedtree_iter.ml b/compiler/ml/typedtree_iter.ml index 7937972c16c..b54b0953494 100644 --- a/compiler/ml/typedtree_iter.ml +++ b/compiler/ml/typedtree_iter.ml @@ -286,6 +286,10 @@ end = struct | Texp_for_await_of (_id, _, exp1, exp2) -> iter_expression exp1; iter_expression exp2 + | Texp_template {values} -> List.iter iter_expression values + | Texp_tagged_template {tag; values} -> + iter_expression tag; + List.iter iter_expression values | Texp_object_get (exp, _) -> iter_expression exp | Texp_object_set (exp, _, v) -> iter_expression exp; diff --git a/compiler/ml/untypeast.ml b/compiler/ml/untypeast.ml index 34dab0e2b10..2597c6d6fcb 100644 --- a/compiler/ml/untypeast.ml +++ b/compiler/ml/untypeast.ml @@ -17,8 +17,9 @@ open Asttypes open Parsetree let constant = function - | Const_char c -> Pconst_char c - | Const_string (s, d) -> Pconst_string (s, d) + | Const_char semantic -> + Pconst_char {source = String_literal.encode_char_source semantic; semantic} + | Const_string semantic -> Ast_helper.Const.string semantic | Const_int i -> Pconst_integer (string_of_int i, None) | Const_bigint (sign, i) -> Pconst_integer (Bigint_utils.to_string sign i, Some 'n') diff --git a/compiler/syntax/src/jsx_ppx.ml b/compiler/syntax/src/jsx_ppx.ml index 4b05e1995d9..16a1bf3a751 100644 --- a/compiler/syntax/src/jsx_ppx.ml +++ b/compiler/syntax/src/jsx_ppx.ml @@ -20,18 +20,14 @@ let get_jsx_config_by_key ~key ~type_ record_fields = let values = List.filter_map (fun ({lid; x = expr} : expression record_element) -> - match (type_, lid, expr) with - | ( Int, - {txt = Lident k}, - {pexp_desc = Pexp_constant (Pconst_integer (value, None))} ) - when k = key -> - Some value - | ( String, - {txt = Lident k}, - (* accept both normal strings and "js" strings *) - {pexp_desc = Pexp_constant (Pconst_string (value, _))} ) - when k = key -> - Some value + match lid with + | {txt = Lident k} when k = key -> ( + match type_ with + | Int -> ( + match expr.pexp_desc with + | Pexp_constant (Pconst_integer (value, None)) -> Some value + | _ -> None) + | String -> Ast_payload.semantic_string_of_expression expr) | _ -> None) record_fields in diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index db326f667e6..9b15ed3f301 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -30,7 +30,7 @@ let get_label str = | Nolabel -> "" let constant_string ~loc str = - Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) + Ast_helper.Exp.constant ~loc (Ast_helper.Const.string str) let unit_expr ~loc = Exp.construct ~loc (Location.mkloc (Lident "()") loc) None diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index a48f800739e..1dde1a25662 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -126,18 +126,23 @@ module Sexp_ast = struct match c with | Pconst_integer (txt, tag) -> Sexp.list [Sexp.atom "Pconst_integer"; string txt; opt_char tag] - | Pconst_char _ -> Sexp.list [Sexp.atom "Pconst_char"] - | Pconst_string (_, Some "INTERNAL_RES_CHAR_CONTENTS") -> - Sexp.list [Sexp.atom "Pconst_char"] - | Pconst_string (txt, tag) -> + | Pconst_char {source; semantic} -> + Sexp.list + [ + Sexp.atom "Pconst_char"; + string source; + Sexp.atom (string_of_int semantic); + ] + | Pconst_string payload -> Sexp.list [ Sexp.atom "Pconst_string"; - string txt; - (match tag with - | Some txt -> Sexp.list [Sexp.atom "Some"; string txt] - | None -> Sexp.atom "None"); + string (String_literal.string_source payload); + string (String_literal.string_semantic payload); ] + | Pconst_json source -> Sexp.list [Sexp.atom "Pconst_json"; string source] + | Pconst_raw_source source -> + Sexp.list [Sexp.atom "Pconst_raw_source"; string source] | Pconst_float (txt, tag) -> Sexp.list [Sexp.atom "Pconst_float"; string txt; opt_char tag] in @@ -762,6 +767,22 @@ module Sexp_ast = struct ] | Pexp_extension ext -> Sexp.list [Sexp.atom "Pexp_extension"; extension ext] + | Pexp_template {source_segments; values} -> + Sexp.list + [ + Sexp.atom "Pexp_template"; + Sexp.list + (List.map (fun {Asttypes.txt} -> string txt) source_segments); + Sexp.list (List.map expression values); + ] + | Pexp_tagged_template {tag; raw_sources; values} -> + Sexp.list + [ + Sexp.atom "Pexp_tagged_template"; + expression tag; + Sexp.list (List.map (fun {Asttypes.txt} -> string txt) raw_sources); + Sexp.list (List.map expression values); + ] | Pexp_await e -> Sexp.list [Sexp.atom "Pexp_await"; expression e] | Pexp_jsx_element (Jsx_fragment {jsx_fragment_children = xs}) -> Sexp.list diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml index ac8aae5392f..4a689a51c5e 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -1521,6 +1521,10 @@ and walk_expression expr t comments = } when Res_parsetree_viewer.is_tuple_array key_values -> walk_list [Expression key_values] t comments + | Pexp_tagged_template {tag; values} -> + walk_list (List.map (fun e -> Expression e) (tag :: values)) t comments + | Pexp_template {values} -> + walk_list (List.map (fun e -> Expression e) values) t comments | Pexp_apply {funct = call_expr; args = arguments} -> ( (* Special handling for array spread - treat it like an array *) match call_expr.pexp_desc with diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index e389a4b446e..adfb7f34e8c 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -223,6 +223,9 @@ module Error_messages = struct let string_interpolation_in_pattern = "String interpolation is not supported in pattern matching." + let tagged_template_in_pattern = + "Tagged template literals are not supported in patterns" + let object_quoted_field_name name = "An object type declaration needs quoted field names. Did you mean \"" ^ name ^ "\"?" @@ -271,16 +274,12 @@ let suppress_fragile_match_warning_attr = Parsetree.PStr [ Ast_helper.Str.eval - (Ast_helper.Exp.constant (Pconst_string ("-4", None))); + (Ast_helper.Exp.constant (Ast_helper.Const.string "-4")); ] ) let make_braces_attr loc = (Location.mkloc "res.braces" loc, Parsetree.PStr []) -let template_literal_attr = (Location.mknoloc "res.template", Parsetree.PStr []) let make_pat_variant_spread_attr = (Location.mknoloc "res.patVariantSpread", Parsetree.PStr []) -let tagged_template_literal_attr = - (Location.mknoloc "res.taggedTemplate", Parsetree.PStr []) - let spread_attr = (Location.mknoloc "res.spread", Parsetree.PStr []) let dict_spread_attr = (Location.mknoloc "res.dictSpread", Parsetree.PStr []) @@ -1001,6 +1000,26 @@ let parse_open_description ~attrs p = (* constant ::= integer-literal *) (* ∣ float-literal *) (* ∣ string-literal *) +let parse_string_constant (p : Parser.t) ~start_pos ~end_pos source = + match String_literal.string_from_source source with + | Some payload -> Parsetree.Pconst_string payload + | None -> + let has_literal_diagnostic = + List.exists + (fun diagnostic -> + let diagnostic_start = Diagnostics.get_start_pos diagnostic in + diagnostic_start.Lexing.pos_cnum >= start_pos.Lexing.pos_cnum + && diagnostic_start.Lexing.pos_cnum <= end_pos.Lexing.pos_cnum) + p.diagnostics + in + if not has_literal_diagnostic then + Parser.err ~start_pos ~end_pos p + (Diagnostics.message + (if String_literal.is_valid_utf8 source then + "Invalid string escape sequence" + else "Invalid code point")); + Parsetree.Pconst_string (String_literal.invalid_string_for_recovery source) + let parse_constant p = let is_negative = match p.Parser.token with @@ -1026,30 +1045,34 @@ let parse_constant p = | Float {f; suffix} -> let float_txt = if is_negative then "-" ^ f else f in Parsetree.Pconst_float (float_txt, suffix) - | String s -> - Pconst_string (s, if p.mode = ParseForTypeChecker then Some "js" else None) - | Codepoint {c; original} -> - if p.mode = ParseForTypeChecker then Pconst_char c - else - (* Pconst_char char does not have enough information for formatting. - * When parsing for the printer, we encode the char contents as a string - * with a special prefix. *) - Pconst_string (original, Some "INTERNAL_RES_CHAR_CONTENTS") + | String source -> + parse_string_constant p ~start_pos:p.start_pos ~end_pos:p.end_pos source + | Codepoint {c; original} -> Pconst_char {source = original; semantic = c} | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Pconst_string ("", None) + Ast_helper.Const.string "" in Parser.next_unsafe p; constant -let parse_template_constant ~prefix (p : Parser.t) = +let parse_template_constant ~start_pos ~prefix (p : Parser.t) = (* Arrived at the ` char *) - let start_pos = p.start_pos in Parser.next_template_literal_token p; match p.token with - | TemplateTail (txt, _) -> + | TemplateTail (txt, _) -> ( Parser.next p; - Parsetree.Pconst_string (txt, prefix) + match prefix with + | None -> ( + match String_literal.decode_js_template_escapes txt with + | Some semantic -> Ast_helper.Const.string semantic + | None -> + Parser.err ~start_pos ~end_pos:p.prev_end_pos p + (Diagnostics.message "Invalid string escape sequence"); + Ast_helper.Const.string "") + | Some _ -> + Parser.err ~start_pos ~end_pos:p.prev_end_pos p + (Diagnostics.message Error_messages.tagged_template_in_pattern); + Ast_helper.Const.string txt) | _ -> let rec skip_tokens () = if p.token <> Eof then ( @@ -1063,7 +1086,7 @@ let parse_template_constant ~prefix (p : Parser.t) = skip_tokens (); Parser.err ~start_pos ~end_pos:p.prev_end_pos p (Diagnostics.message Error_messages.string_interpolation_in_pattern); - Pconst_string ("", None) + Ast_helper.Const.string "" let parse_comma_delimited_region p ~grammar ~closing ~f = Parser.leave_breadcrumb p grammar; @@ -1233,10 +1256,8 @@ let rec parse_pattern ?(alias = true) ?(or_ = true) p = Ast_helper.Pat.interval ~loc:(mk_loc start_pos p.prev_end_pos) c c2 | _ -> Ast_helper.Pat.constant ~loc:(mk_loc start_pos p.prev_end_pos) c) | Backtick -> - let constant = parse_template_constant ~prefix:(Some "js") p in - Ast_helper.Pat.constant ~attrs:[template_literal_attr] - ~loc:(mk_loc start_pos p.prev_end_pos) - constant + let constant = parse_template_constant ~start_pos ~prefix:None p in + Ast_helper.Pat.constant ~loc:(mk_loc start_pos p.prev_end_pos) constant | Lparen -> ( Parser.next p; match p.token with @@ -1272,7 +1293,9 @@ let rec parse_pattern ?(alias = true) ?(or_ = true) p = Parser.next p; match p.token with | Backtick -> - let constant = parse_template_constant ~prefix:(Some ident) p in + let constant = + parse_template_constant ~start_pos ~prefix:(Some ident) p + in Ast_helper.Pat.constant ~loc:(mk_loc start_pos p.prev_end_pos) constant | _ -> Ast_helper.Pat.var ~loc ~attrs (Location.mkloc ident loc)) | Uident _ -> ( @@ -2083,9 +2106,7 @@ and parse_regex ~start_pos p pattern flags = [ Ast_helper.Str.eval ~loc (Ast_helper.Exp.constant ~loc - (Pconst_string - ( "/" ^ pattern ^ "/" ^ flags, - if p.mode = ParseForTypeChecker then Some "js" else None ))); + (Pconst_raw_source ("/" ^ pattern ^ "/" ^ flags))); ] in Ast_helper.Exp.extension (Location.mkloc "re" loc, payload) @@ -2496,14 +2517,6 @@ and parse_binary_expr ?(context = OrdinaryExpr) ?a p prec = (* ) *) and parse_template_expr ?prefix p = - let part_prefix = - (* we could stop treating json prefix as something special - but we would first need to remove @as(json`true`) feature *) - match prefix with - | Some {txt = Longident.Lident ("json" as prefix); _} -> Some prefix - | _ -> Some "js" - in - let parse_parts p = let rec aux acc = let start_pos = p.Parser.start_pos in @@ -2512,20 +2525,12 @@ and parse_template_expr ?prefix p = | TemplateTail (txt, last_pos) -> Parser.next p; let loc = mk_loc start_pos last_pos in - let str = - Ast_helper.Exp.constant ~attrs:[template_literal_attr] ~loc - (Pconst_string (txt, part_prefix)) - in - List.rev ((str, None) :: acc) + List.rev ((txt, loc, None) :: acc) | TemplatePart (txt, last_pos) -> Parser.next p; let loc = mk_loc start_pos last_pos in let expr = parse_expr_block p in - let str = - Ast_helper.Exp.constant ~attrs:[template_literal_attr] ~loc - (Pconst_string (txt, part_prefix)) - in - aux ((str, Some expr) :: acc) + aux ((txt, loc, Some expr) :: acc) | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); [] @@ -2533,59 +2538,42 @@ and parse_template_expr ?prefix p = aux [] in let parts = parse_parts p in - let strings = List.map fst parts in - let values = Ext_list.filter_map parts snd in - - let gen_tagged_template_call (lident_loc : Longident.t Location.loc) = + let sources = List.map (fun (txt, loc, _) -> {Location.txt; loc}) parts in + let values = Ext_list.filter_map parts (fun (_, _, value) -> value) in + let template_loc = + let _, first_loc, _ = List.hd parts in + let _, last_loc, _ = Ext_list.last parts in + mk_loc first_loc.loc_start last_loc.loc_end + in + let gen_tagged_template (lident_loc : Longident.t Location.loc) = let ident = Ast_helper.Exp.ident ~attrs:[] ~loc:lident_loc.loc lident_loc in - let strings_array = - Ast_helper.Exp.array ~attrs:[] ~loc:Location.none strings - in - let values_array = - Ast_helper.Exp.array ~attrs:[] ~loc:Location.none values - in - Ast_helper.Exp.apply - ~attrs:[tagged_template_literal_attr] - ~loc:lident_loc.loc ident - [(Nolabel, strings_array); (Nolabel, values_array)] - in - - let hidden_operator = - let op = Location.mknoloc (Longident.Lident "++") in - Ast_helper.Exp.ident op - in - let concat (e1 : Parsetree.expression) (e2 : Parsetree.expression) = - let loc = mk_loc e1.pexp_loc.loc_start e2.pexp_loc.loc_end in - Ast_helper.Exp.apply ~attrs:[template_literal_attr] ~loc hidden_operator - [(Nolabel, e1); (Nolabel, e2)] - in - let gen_interpolated_string () = - let subparts = - List.flatten - (List.map - (fun part -> - match part with - | s, Some v -> [s; v] - | s, None -> [s]) - parts) - in - let expr_option = - List.fold_left - (fun acc subpart -> - Some - (match acc with - | Some expr -> concat expr subpart - | None -> subpart)) - None subparts - in - match expr_option with - | Some expr -> expr - | None -> Ast_helper.Exp.constant (Pconst_string ("", None)) + let loc = mk_loc lident_loc.loc.loc_start p.prev_end_pos in + Ast_helper.Exp.tagged_template ~loc ident sources values in match prefix with - | Some {txt = Longident.Lident "json"; _} | None -> gen_interpolated_string () - | Some lident_loc -> gen_tagged_template_call lident_loc + | Some {txt = Longident.Lident "json"; _} -> ( + match (parts, values) with + | [(source, loc, None)], [] -> + Ast_helper.Exp.constant ~loc (Pconst_json source) + | (source, loc, _) :: _, _ -> + Parser.err ~start_pos:template_loc.loc_start ~end_pos:template_loc.loc_end + p + (Diagnostics.message "`json` literals do not support interpolation"); + Ast_helper.Exp.constant ~loc (Pconst_json source) + | [], _ -> assert false) + | None -> + List.iter + (fun ({Location.txt = source; loc} : string Location.loc) -> + if String_literal.decode_js_template_escapes source = None then + Parser.err ~start_pos:loc.loc_start ~end_pos:loc.loc_end p + (Diagnostics.message + (if String_literal.is_valid_utf8 source then + "Invalid string escape sequence" + else "Invalid code point"))) + sources; + Ast_helper.Exp.template ~loc:template_loc sources values + | Some lident_loc -> gen_tagged_template lident_loc (* Overparse: let f = a : int => a + 1, is it (a : int) => or (a): int => * Also overparse constraints: @@ -3172,10 +3160,10 @@ and parse_braced_or_record_expr p = Parser.expect Rbrace p; expr | _ -> ( - let tag = if p.mode = ParseForTypeChecker then Some "js" else None in let constant = Ast_helper.Exp.constant ~loc:field.loc - (Parsetree.Pconst_string (s, tag)) + (parse_string_constant p ~start_pos:field.loc.loc_start + ~end_pos:field.loc.loc_end s) in let a = parse_primary_expr ~operand:constant p in let e = parse_binary_expr ~a p 1 in @@ -4411,7 +4399,7 @@ and parse_dict_expr ~start_pos p = (Ast_helper.Exp.tuple ~loc:(mk_loc key_loc.loc_start value_loc.loc_end) [ - Ast_helper.Exp.constant ~loc:key_loc (Pconst_string (key, None)); + Ast_helper.Exp.constant ~loc:key_loc (Ast_helper.Const.string key); value_expr; ]) | _ -> None @@ -6723,7 +6711,7 @@ and parse_structure_item_region pending_structure_items p = PStr [ Ast_helper.Str.eval ~loc - (Ast_helper.Exp.constant ~loc (Pconst_string (s, None))); + (Ast_helper.Exp.constant ~loc (Ast_helper.Const.string s)); ] )) | AtAt -> let attr = parse_standalone_attribute p in @@ -7409,7 +7397,7 @@ and parse_signature_item_region pending_signature_items p = PStr [ Ast_helper.Str.eval ~loc - (Ast_helper.Exp.constant ~loc (Pconst_string (s, None))); + (Ast_helper.Exp.constant ~loc (Ast_helper.Const.string s)); ] )) | PercentPercent -> let extension = parse_extension ~module_language:true p in @@ -7636,7 +7624,7 @@ and doc_comment_to_attribute loc s : Parsetree.attribute = PStr [ Ast_helper.Str.eval ~loc - (Ast_helper.Exp.constant ~loc (Pconst_string (s, None))); + (Ast_helper.Exp.constant ~loc (Ast_helper.Const.string s)); ] ) and parse_attributes p = @@ -7693,6 +7681,37 @@ and parse_extension ?(module_language = false) p = else Parser.expect Percent p; let attr_id = parse_attribute_id ~start_pos p in let payload = parse_payload p in + let payload = + match (attr_id.txt, payload) with + | ( ("raw" | "ffi" | "re"), + Parsetree.PStr + [ + ({ + pstr_desc = + Pstr_eval + ( ({pexp_desc = Pexp_constant (Pconst_string payload)} as + expression), + eval_attrs ); + } as item); + ] ) -> + Parsetree.PStr + [ + { + item with + pstr_desc = + Pstr_eval + ( { + expression with + pexp_desc = + Pexp_constant + (Pconst_raw_source + (String_literal.string_source payload)); + }, + eval_attrs ); + }; + ] + | _ -> payload + in (attr_id, payload) (* module signature on the file level *) diff --git a/compiler/syntax/src/res_outcome_printer.ml b/compiler/syntax/src/res_outcome_printer.ml index 2638dd84a78..4876006d8a3 100644 --- a/compiler/syntax/src/res_outcome_printer.ml +++ b/compiler/syntax/src/res_outcome_printer.ml @@ -484,11 +484,7 @@ let print_string_literal_doc s = Doc.text ("\"" ^ String.escaped s ^ "\"") let print_inline_const_doc (c : External_ffi_types.inline_const) = match c with - | Const_str {s; delim = None | Some DNone | Some DStarJ} -> - (* DStarJ is the processed form of an ordinary double-quoted string *) - print_string_literal_doc s - | Const_str {s; delim = Some DBackQuotes} -> Doc.text ("`" ^ s ^ "`") - | Const_str {s; delim = Some DNoQuotes} -> Doc.text ("json`" ^ s ^ "`") + | Const_string s -> print_string_literal_doc s | Const_bool b -> Doc.text (if b then "true" else "false") | Const_int i -> Doc.text (Int32.to_string i) | Const_bigint {negative; digits} -> diff --git a/compiler/syntax/src/res_parser.ml b/compiler/syntax/src/res_parser.ml index 9daf79dc1d4..641a41ab244 100644 --- a/compiler/syntax/src/res_parser.ml +++ b/compiler/syntax/src/res_parser.ml @@ -49,14 +49,21 @@ let end_region p = | [] -> () | _ :: rest -> p.regions <- rest -let doc_comment_to_attribute_token comment = +let comment_text_for_attribute p comment = let txt = Comment.txt comment in let loc = Comment.loc comment in + if String_literal.is_valid_utf8 txt then (loc, txt) + else ( + p.scanner.err ~start_pos:loc.loc_start ~end_pos:loc.loc_end + (Diagnostics.message "Invalid code point"); + (loc, String_literal.replace_invalid_utf8 txt)) + +let doc_comment_to_attribute_token p comment = + let loc, txt = comment_text_for_attribute p comment in Token.DocComment (loc, txt) -let module_comment_to_attribute_token comment = - let txt = Comment.txt comment in - let loc = Comment.loc comment in +let module_comment_to_attribute_token p comment = + let loc, txt = comment_text_for_attribute p comment in Token.ModuleComment (loc, txt) (* Advance to the next non-comment token and store any encountered comment @@ -73,12 +80,12 @@ let rec next ?prev_end_pos p = match token with | Comment c -> if Comment.is_doc_comment c then ( - p.token <- doc_comment_to_attribute_token c; + p.token <- doc_comment_to_attribute_token p c; p.prev_end_pos <- prev_end_pos; p.start_pos <- start_pos; p.end_pos <- end_pos) else if Comment.is_module_comment c then ( - p.token <- module_comment_to_attribute_token c; + p.token <- module_comment_to_attribute_token p c; p.prev_end_pos <- prev_end_pos; p.start_pos <- start_pos; p.end_pos <- end_pos) diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml index e4f0c64f28c..0a2aeeb21bc 100644 --- a/compiler/syntax/src/res_parsetree_viewer.ml +++ b/compiler/syntax/src/res_parsetree_viewer.ml @@ -228,9 +228,8 @@ let filter_parsing_attrs attrs = | ( { Location.txt = ( "res.braces" | "ns.braces" | "res.iflet" | "res.ternary" - | "res.await" | "res.template" | "res.taggedTemplate" - | "res.patVariantSpread" | "res.dictPattern" | "res.dictSpread" - | "res.inlineRecordDefinition" ); + | "res.await" | "res.patVariantSpread" | "res.dictPattern" + | "res.dictSpread" | "res.inlineRecordDefinition" ); }, _ ) -> false @@ -265,13 +264,18 @@ let is_multiline_text txt = let is_huggable_expression expr = match expr.pexp_desc with | Pexp_array _ | Pexp_tuple _ - | Pexp_constant (Pconst_string (_, Some _)) + | Pexp_constant (Pconst_json _ | Pconst_char _) + | Pexp_template {values = []} | Pexp_construct ({txt = Longident.Lident ("::" | "[]")}, _) | Pexp_object_literal _ | Pexp_record _ -> true | _ when is_block_expr expr -> true | _ when is_braced_expr expr -> true - | Pexp_constant (Pconst_string (txt, None)) when is_multiline_text txt -> true + | Pexp_constant (Pconst_string payload) + when is_multiline_text (String_literal.string_source payload) -> + true + | Pexp_constant (Pconst_raw_source source) when is_multiline_text source -> + true | _ -> false let is_huggable_rhs expr = @@ -384,7 +388,7 @@ let has_attributes attrs = | ( { Location.txt = ( "res.braces" | "ns.braces" | "res.iflet" | "res.ternary" - | "res.await" | "res.template" | "res.inlineRecordDefinition" ); + | "res.await" | "res.inlineRecordDefinition" ); }, _ ) -> false @@ -395,10 +399,11 @@ let has_attributes attrs = { pstr_desc = Pstr_eval - ({pexp_desc = Pexp_constant (Pconst_string ("-4", None))}, _); + ({pexp_desc = Pexp_constant (Pconst_string payload)}, _); }; ] ) -> - not (has_if_let_attribute attrs) + String_literal.string_semantic payload <> "-4" + || not (has_if_let_attribute attrs) | _ -> true) attrs @@ -509,10 +514,10 @@ let filter_fragile_match_attributes attrs = { pstr_desc = Pstr_eval - ({pexp_desc = Pexp_constant (Pconst_string ("-4", _))}, _); + ({pexp_desc = Pexp_constant (Pconst_string payload)}, _); }; ] ) -> - false + String_literal.string_semantic payload <> "-4" | _ -> true) attrs @@ -560,8 +565,7 @@ let is_printable_attribute attr = | ( { Location.txt = ( "res.iflet" | "res.braces" | "ns.braces" | "JSX" | "res.await" - | "res.template" | "res.taggedTemplate" | "res.ternary" - | "res.inlineRecordDefinition" | "res.dictSpread" ); + | "res.ternary" | "res.inlineRecordDefinition" | "res.dictSpread" ); }, _ ) -> false @@ -583,8 +587,7 @@ let partition_doc_comment_attributes attrs = [ { pstr_desc = - Pstr_eval - ({pexp_desc = Pexp_constant (Pconst_string (_, _))}, _); + Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string _)}, _); }; ] ) -> true @@ -648,39 +651,14 @@ let rec collect_patterns_from_list_construct acc pattern = collect_patterns_from_list_construct (pat :: acc) rest | _ -> (List.rev acc, pattern) -let has_template_literal_attr attrs = - List.exists - (fun attr -> - match attr with - | {Location.txt = "res.template"}, _ -> true - | _ -> false) - attrs - -let has_tagged_template_literal_attr attrs = - List.exists - (fun attr -> - match attr with - | {Location.txt = "res.taggedTemplate"}, _ -> true - | _ -> false) - attrs - let is_template_literal expr = match expr.pexp_desc with - | Pexp_apply - { - funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"}}; - args = [(Nolabel, _); (Nolabel, _)]; - } - when has_template_literal_attr expr.pexp_attributes -> - true - | Pexp_constant (Pconst_string (_, Some "")) -> true - | Pexp_constant _ when has_template_literal_attr expr.pexp_attributes -> true + | Pexp_template _ -> true | _ -> false let is_tagged_template_literal expr = - match expr with - | {pexp_desc = Pexp_apply _; pexp_attributes = attrs} -> - has_tagged_template_literal_attr attrs + match expr.pexp_desc with + | Pexp_tagged_template _ -> true | _ -> false let has_spread_attr attrs = diff --git a/compiler/syntax/src/res_parsetree_viewer.mli b/compiler/syntax/src/res_parsetree_viewer.mli index d95ad69a4d7..8f378239f32 100644 --- a/compiler/syntax/src/res_parsetree_viewer.mli +++ b/compiler/syntax/src/res_parsetree_viewer.mli @@ -136,8 +136,6 @@ val is_block_expr : Parsetree.expression -> bool val is_template_literal : Parsetree.expression -> bool val is_tagged_template_literal : Parsetree.expression -> bool -val has_template_literal_attr : Parsetree.attributes -> bool - val is_spread_list : Parsetree.expression -> bool val is_spread_array : Parsetree.expression -> bool diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 3b44878362e..7893e4f3209 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -564,45 +564,51 @@ let print_string_contents txt = let lines = String.split_on_char '\n' txt in Doc.join ~sep:Doc.literal_line (List.map Doc.text lines) -let print_constant ?(template_literal = false) c = +let interleave_template_parts sources values = + let rec loop acc sources values = + match (sources, values) with + | [source], [] -> Doc.concat [acc; source] + | source :: sources, value :: values -> + loop (Doc.concat [acc; source; value]) sources values + | _ -> assert false + in + loop Doc.nil sources values + +let raw_source_fits_double_quotes source = + let rec loop index = + if index >= String.length source then true + else + match String.unsafe_get source index with + | '"' -> false + | '\\' -> index + 1 < String.length source && loop (index + 2) + | _ -> loop (index + 1) + in + loop 0 + +let print_constant c = match c with | Parsetree.Pconst_integer (s, suffix) -> ( match suffix with | Some c -> Doc.text (s ^ Char.escaped c) | None -> Doc.text s) - | Pconst_string (txt, None) -> - Doc.concat [Doc.text "\""; print_string_contents txt; Doc.text "\""] - | Pconst_string (txt, Some prefix) -> - if prefix = "INTERNAL_RES_CHAR_CONTENTS" then - Doc.concat [Doc.text "'"; Doc.text txt; Doc.text "'"] - else - let lquote, rquote = - if template_literal then ("`", "`") else ("\"", "\"") - in - Doc.concat - [ - (if prefix = "js" then Doc.nil else Doc.text prefix); - Doc.text lquote; - print_string_contents txt; - Doc.text rquote; - ] - | Pconst_float (s, _) -> Doc.text s - | Pconst_char c -> - let str = - match Char.unsafe_chr c with - | '\'' -> "\\'" - | '\\' -> "\\\\" - | '\n' -> "\\n" - | '\t' -> "\\t" - | '\r' -> "\\r" - | '\b' -> "\\b" - | ' ' .. '~' as c -> - let s = (Bytes.create [@doesNotRaise]) 1 in - Bytes.unsafe_set s 0 c; - Bytes.unsafe_to_string s - | _ -> Res_utf8.encode_code_point c + | Pconst_string payload -> + Doc.concat + [ + Doc.text "\""; + print_string_contents (String_literal.string_source payload); + Doc.text "\""; + ] + | Pconst_json source -> + Doc.concat [Doc.text "json`"; print_string_contents source; Doc.text "`"] + | Pconst_raw_source source -> + let delimiter = + if raw_source_fits_double_quotes source then "\"" else "`" in - Doc.text ("'" ^ str ^ "'") + Doc.concat + [Doc.text delimiter; print_string_contents source; Doc.text delimiter] + | Pconst_char {source} -> + Doc.concat [Doc.text "'"; Doc.text source; Doc.text "'"] + | Pconst_float (s, _) -> Doc.text s module State = struct let custom_layout_threshold = 2 @@ -1639,10 +1645,9 @@ and collect_literal_dict_rows (e : Parsetree.expression) = | { pexp_desc = Pexp_tuple - [ - {pexp_desc = Pexp_constant (Pconst_string (name, _)); pexp_loc}; value; - ]; + [{pexp_desc = Pexp_constant (Pconst_string payload); pexp_loc}; value]; } -> + let name = String_literal.string_semantic payload in Some ((Location.mkloc (Longident.Lident name) pexp_loc, value), e) | _ -> None in @@ -2524,8 +2529,7 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl } -> Parsetree_viewer.is_binary_expression if_expr || Parsetree_viewer.has_attributes if_expr.pexp_attributes - | {pexp_attributes = [({Location.txt = "res.taggedTemplate"}, _)]} -> - false + | {pexp_desc = Pexp_tagged_template _} -> false | {pexp_desc = Pexp_jsx_element _} -> true | e -> Parsetree_viewer.has_attributes e.pexp_attributes @@ -2616,11 +2620,7 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = match p.ppat_desc with | Ppat_any -> Doc.text "_" | Ppat_var var -> print_ident_like var.txt - | Ppat_constant c -> - let template_literal = - Parsetree_viewer.has_template_literal_attr p.ppat_attributes - in - print_constant ~template_literal c + | Ppat_constant c -> print_constant c | Ppat_tuple patterns -> Doc.group (Doc.concat @@ -3274,10 +3274,7 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = (Parsetree_viewer.rewrite_underscore_apply e) cmt_tbl | Pexp_fun _ -> print_arrow e - | Parsetree.Pexp_constant c -> - print_constant - ~template_literal:(Parsetree_viewer.is_template_literal e) - c + | Parsetree.Pexp_constant c -> print_constant c | Pexp_jsx_element (Jsx_fragment { @@ -3658,12 +3655,16 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = { pstr_desc = Pstr_eval - ({pexp_desc = Pexp_constant (Pconst_string (expr, _))}, []); + ({pexp_desc = Pexp_constant (Pconst_raw_source expr)}, []); }; ] ) -> Doc.text expr | extension -> print_extension ~state ~at_module_lvl:false extension cmt_tbl) + | Pexp_template {source_segments; values} -> + print_template_literal ~state ~source_segments ~values cmt_tbl + | Pexp_tagged_template {tag; raw_sources; values} -> + print_tagged_template_literal ~state ~tag ~raw_sources ~values cmt_tbl | Pexp_apply {funct = e; args = [(Nolabel, {pexp_desc = Pexp_array sub_lists})]} when Parsetree_viewer.is_spread_array e -> @@ -3672,13 +3673,9 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = {funct = e; args = [(Nolabel, {pexp_desc = Pexp_array sub_lists})]} when Parsetree_viewer.is_spread_list e -> print_list_spread_apply ~state sub_lists cmt_tbl - | Pexp_apply {funct = call_expr; args} -> + | Pexp_apply _ -> if Parsetree_viewer.is_unary_expression e then print_unary_expression ~state e cmt_tbl - else if Parsetree_viewer.is_template_literal e then - print_template_literal ~state e cmt_tbl - else if Parsetree_viewer.is_tagged_template_literal e then - print_tagged_template_literal ~state call_expr args cmt_tbl else if Parsetree_viewer.is_binary_expression e then print_binary_expression ~state e cmt_tbl else print_pexp_apply ~state e cmt_tbl @@ -4079,62 +4076,30 @@ and print_set_field_expr ~state attrs lhs longident_loc rhs loc cmt_tbl = in print_comments doc cmt_tbl loc -and print_template_literal ~state expr cmt_tbl = - let tag = ref "js" in - let rec walk_expr expr = - let open Parsetree in - match expr.pexp_desc with - | Pexp_apply - { - funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"}}; - args = [(Nolabel, arg1); (Nolabel, arg2)]; - } -> - let lhs = walk_expr arg1 in - let rhs = walk_expr arg2 in - Doc.concat [lhs; rhs] - | Pexp_constant (Pconst_string (txt, Some prefix)) -> - tag := prefix; - print_string_contents txt - | _ -> - let doc = print_expression_with_comments ~state expr cmt_tbl in - let doc = - match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces - | Nothing -> doc - in - Doc.group (Doc.concat [Doc.text "${"; Doc.indent doc; Doc.rbrace]) +and print_template_literal ~state ~source_segments ~values cmt_tbl = + let strings = + List.map (fun {Asttypes.txt} -> print_string_contents txt) source_segments in - let content = walk_expr expr in - Doc.concat - [ - (if !tag = "js" then Doc.nil else Doc.text !tag); - Doc.text "`"; - content; - Doc.text "`"; - ] - -and print_tagged_template_literal ~state call_expr args cmt_tbl = - let strings_list, values_list = - match args with - | [ - (_, {Parsetree.pexp_desc = Pexp_array strings}); - (_, {Parsetree.pexp_desc = Pexp_array values}); - ] -> - (strings, values) - | _ -> assert false + let values = + List.map + (fun expr -> + let doc = print_expression_with_comments ~state expr cmt_tbl in + let doc = + match Parens.expr expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces + | Nothing -> doc + in + Doc.group (Doc.concat [Doc.text "${"; Doc.indent doc; Doc.rbrace])) + values in + let content = interleave_template_parts strings values in + Doc.concat [Doc.text "`"; content; Doc.text "`"] +and print_tagged_template_literal ~state ~tag ~raw_sources ~values cmt_tbl = let strings = - List.map - (fun x -> - match x with - | {Parsetree.pexp_desc = Pexp_constant (Pconst_string (txt, _))} -> - print_string_contents txt - | _ -> assert false) - strings_list + List.map (fun {Asttypes.txt} -> print_string_contents txt) raw_sources in - let values = List.map (fun x -> @@ -4144,22 +4109,13 @@ and print_tagged_template_literal ~state call_expr args cmt_tbl = print_expression_with_comments ~state x cmt_tbl; Doc.text "}"; ]) - values_list + values in - let process strings values = - let rec aux acc = function - | [], [] -> acc - | a_head :: a_rest, b -> aux (Doc.concat [acc; a_head]) (b, a_rest) - | _ -> assert false - in - aux Doc.nil (strings, values) - in - - let content : Doc.t = process strings values in + let content = interleave_template_parts strings values in - let tag = print_expression_with_comments ~state call_expr cmt_tbl in - Doc.concat [tag; Doc.text "`"; content; Doc.text "`"] + let tag_doc = print_expression_with_comments ~state tag cmt_tbl in + Doc.concat [tag_doc; Doc.text "`"; content; Doc.text "`"] and print_unary_expression ~state expr cmt_tbl = let print_unary_operator op = @@ -4313,14 +4269,6 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = | _ -> assert false else match expr.pexp_desc with - | Pexp_apply - { - funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"; loc}}; - args = [(Nolabel, _); (Nolabel, _)]; - } - when loc.loc_ghost -> - let doc = print_template_literal ~state expr cmt_tbl in - print_comments doc cmt_tbl expr.Parsetree.pexp_loc | Pexp_setfield (lhs, field, rhs) -> let doc = print_set_field_expr ~state expr.pexp_attributes lhs field rhs @@ -6121,13 +6069,13 @@ and print_attribute ?(standalone = false) ~state [ { pstr_desc = - Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (txt, _))}, _); + Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string payload)}, _); }; ] ) -> ( Doc.concat [ Doc.text (if standalone then "/***" else "/**"); - Doc.text txt; + Doc.text (String_literal.string_semantic payload); Doc.text "*/"; ], Doc.hard_line ) diff --git a/compiler/syntax/src/res_scanner.ml b/compiler/syntax/src/res_scanner.ml index 67be55fdc5d..c21d1548083 100644 --- a/compiler/syntax/src/res_scanner.ml +++ b/compiler/syntax/src/res_scanner.ml @@ -89,10 +89,16 @@ let _printDebug ~start_pos ~end_pos scanner token = let next scanner = let next_offset = scanner.offset + 1 in let utf16len = - match Ext_utf8.classify scanner.ch with - | Single _ | Invalid -> 1 - | Leading (n, _) -> ( (((n + 1) / 2) [@doesNotRaise])) - | Cont _ -> 0 + let byte = Char.code scanner.ch in + if byte land 0xc0 = 0x80 then 0 + else if byte < 0x80 then 1 + else + let decoded = String.get_utf_8_uchar scanner.src scanner.offset in + if + Uchar.utf_decode_is_valid decoded + && Uchar.to_int (Uchar.utf_decode_uchar decoded) > 0xffff + then 2 + else 1 in let newline = scanner.ch = '\n' @@ -346,7 +352,12 @@ let scan_exotic_identifier scanner = else Token.Lident name let scan_string_escape_sequence ~start_pos scanner = - let scan ~n ~base ~max = + let invalid_unicode_code_point () = + let pos = position scanner in + let msg = "escape sequence is invalid unicode code point" in + scanner.err ~start_pos ~end_pos:pos (Diagnostics.message msg) + in + let scan_digits ~n ~base = let rec loop n x = if n == 0 then x else @@ -363,11 +374,11 @@ let scan_string_escape_sequence ~start_pos scanner = let () = next scanner in loop (n - 1) ((x * base) + d) in - let x = loop n 0 in - if x > max || (0xD800 <= x && x < 0xE000) then - let pos = position scanner in - let msg = "escape sequence is invalid unicode code point" in - scanner.err ~start_pos ~end_pos:pos (Diagnostics.message msg) + loop n 0 + in + let scan ~n ~base ~max = + let x = scan_digits ~n ~base in + if x > max || (0xD800 <= x && x < 0xE000) then invalid_unicode_code_point () in match scanner.ch with (* \ already consumed *) @@ -389,19 +400,38 @@ let scan_string_escape_sequence ~start_pos scanner = (* unicode code point escape sequence: '\u{7A}', one or more hex digits *) next scanner; let x = ref 0 in + let has_digit = ref false in while match scanner.ch with | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false do - x := (!x * 16) + digit_value scanner.ch; + has_digit := true; + let digit = digit_value scanner.ch in + x := + if !x > (Res_utf8.max - digit) / 16 then Res_utf8.max + 1 + else (!x * 16) + digit; next scanner done; (* consume '}' in '\u{7A}' *) match scanner.ch with - | '}' -> next scanner - | _ -> ()) - | _ -> scan ~n:4 ~base:16 ~max:Res_utf8.max) + | '}' -> + if (not !has_digit) || !x > Res_utf8.max || (0xD800 <= !x && !x < 0xE000) + then invalid_unicode_code_point (); + next scanner + | _ -> invalid_unicode_code_point ()) + | _ -> + let high = scan_digits ~n:4 ~base:16 in + if 0xD800 <= high && high <= 0xDBFF then + if scanner.ch = '\\' && peek scanner = 'u' then ( + next scanner; + next scanner; + let low = scan_digits ~n:4 ~base:16 in + if low >= 0 && (low < 0xDC00 || low > 0xDFFF) then + invalid_unicode_code_point ()) + else invalid_unicode_code_point () + else if high > Res_utf8.max || (0xDC00 <= high && high <= 0xDFFF) then + invalid_unicode_code_point ()) | _ -> (* unknown escape sequence * TODO: we should warn the user here. Let's not make it a hard error for now, for reason compat *) diff --git a/compiler/syntax/src/res_utf8.ml b/compiler/syntax/src/res_utf8.ml index c41621761da..46dd93ceaab 100644 --- a/compiler/syntax/src/res_utf8.ml +++ b/compiler/syntax/src/res_utf8.ml @@ -1,143 +1,21 @@ (* https://tools.ietf.org/html/rfc3629#section-10 *) (* let bom = 0xFEFF *) -let repl = 0xFFFD - -(* let min = 0x0000 *) -let max = 0x10FFFF - -let surrogate_min = 0xD800 -let surrogate_max = 0xDFFF - -(* - * Char. number range | UTF-8 octet sequence - * (hexadecimal) | (binary) - * --------------------+--------------------------------------------- - * 0000 0000-0000 007F | 0xxxxxxx - * 0000 0080-0000 07FF | 110xxxxx 10xxxxxx - * 0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx - * 0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - *) -let h2 = 0b1100_0000 -let h3 = 0b1110_0000 -let h4 = 0b1111_0000 - -let cont_mask = 0b0011_1111 - -type category = {low: int; high: int; size: int} - -let locb = 0b1000_0000 -let hicb = 0b1011_1111 - -let category_table = [| - (* 0 *) {low = -1; high= -1; size= 1}; (* invalid *) - (* 1 *) {low = 1; high= -1; size= 1}; (* ascii *) - (* 2 *) {low = locb; high= hicb; size= 2}; - (* 3 *) {low = 0xA0; high= hicb; size= 3}; - (* 4 *) {low = locb; high= hicb; size= 3}; - (* 5 *) {low = locb; high= 0x9F; size= 3}; - (* 6 *) {low = 0x90; high= hicb; size= 4}; - (* 7 *) {low = locb; high= hicb; size= 4}; - (* 8 *) {low = locb; high= 0x8F; size= 4}; -|] [@@ocamlformat "disable"] - -let categories = [| - 1; 1; 1; 1; 1; 1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1; - 1; 1; 1; 1; 1; 1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1; - 1; 1; 1; 1; 1; 1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1; - 1; 1; 1; 1; 1; 1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1; - 1; 1; 1; 1; 1; 1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1; - 1; 1; 1; 1; 1; 1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1; - 1; 1; 1; 1; 1; 1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1; - 1; 1; 1; 1; 1; 1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1 ;1; - - 0; 0; 0; 0;0; 0; 0; 0;0; 0; 0; 0;0; 0; 0; 0; - 0; 0; 0; 0;0; 0; 0; 0;0; 0; 0; 0;0; 0; 0; 0; - 0; 0; 0; 0;0; 0; 0; 0;0; 0; 0; 0;0; 0; 0; 0; - 0; 0; 0; 0;0; 0; 0; 0;0; 0; 0; 0;0; 0; 0; 0; - (* surrogate range U+D800 - U+DFFFF = 55296 - 917503 *) - 0; 0; 2; 2;2; 2; 2; 2;2; 2; 2; 2;2; 2; 2; 2; - 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; - 3; 4; 4; 4; 4; 4; 4; 4; 4; 4; 4; 4; 4; 5; 4; 4; - 6; 7; 7 ;7; 8; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; -|] [@@ocamlformat "disable"] +let repl = Uchar.to_int Uchar.rep +let max = Uchar.to_int Uchar.max let decode_code_point i s len = - if len < 1 then (repl, 1) + if i < 0 || i >= len || len > String.length s then (repl, 1) else - let first = int_of_char (String.unsafe_get s i) in - if first < 128 then (first, 1) - else - let index = Array.unsafe_get categories first in - if index = 0 then (repl, 1) - else - let cat = Array.unsafe_get category_table index in - if len < i + cat.size then (repl, 1) - else if cat.size == 2 then - let c1 = int_of_char (String.unsafe_get s (i + 1)) in - if c1 < cat.low || cat.high < c1 then (repl, 1) - else - let i1 = c1 land 0b00111111 in - let i0 = (first land 0b00011111) lsl 6 in - let uc = i0 lor i1 in - (uc, 2) - else if cat.size == 3 then - let c1 = int_of_char (String.unsafe_get s (i + 1)) in - let c2 = int_of_char (String.unsafe_get s (i + 2)) in - if c1 < cat.low || cat.high < c1 || c2 < locb || hicb < c2 then - (repl, 1) - else - let i0 = (first land 0b00001111) lsl 12 in - let i1 = (c1 land 0b00111111) lsl 6 in - let i2 = c2 land 0b00111111 in - let uc = i0 lor i1 lor i2 in - (uc, 3) - else - let c1 = int_of_char (String.unsafe_get s (i + 1)) in - let c2 = int_of_char (String.unsafe_get s (i + 2)) in - let c3 = int_of_char (String.unsafe_get s (i + 3)) in - if - c1 < cat.low || cat.high < c1 || c2 < locb || hicb < c2 || c3 < locb - || hicb < c3 - then (repl, 1) - else - let i1 = (c1 land 0x3f) lsl 12 in - let i2 = (c2 land 0x3f) lsl 6 in - let i3 = c3 land 0x3f in - let i0 = (first land 0x07) lsl 18 in - let uc = i0 lor i3 lor i2 lor i1 in - (uc, 4) + let decoded = String.get_utf_8_uchar s i in + let size = Uchar.utf_decode_length decoded in + if Uchar.utf_decode_is_valid decoded && i + size <= len then + (Uchar.to_int (Uchar.utf_decode_uchar decoded), size) + else (repl, 1) let encode_code_point c = - if c <= 127 then ( - let bytes = (Bytes.create [@doesNotRaise]) 1 in - Bytes.unsafe_set bytes 0 (Char.unsafe_chr c); - Bytes.unsafe_to_string bytes) - else if c <= 2047 then ( - let bytes = (Bytes.create [@doesNotRaise]) 2 in - Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h2 lor (c lsr 6))); - Bytes.unsafe_set bytes 1 - (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask))); - Bytes.unsafe_to_string bytes) - else if c <= 65535 then ( - let bytes = (Bytes.create [@doesNotRaise]) 3 in - Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h3 lor (c lsr 12))); - Bytes.unsafe_set bytes 1 - (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask))); - Bytes.unsafe_set bytes 2 - (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask))); - Bytes.unsafe_to_string bytes) - else - (* if c <= max then *) - let bytes = (Bytes.create [@doesNotRaise]) 4 in - Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h4 lor (c lsr 18))); - Bytes.unsafe_set bytes 1 - (Char.unsafe_chr (0b1000_0000 lor ((c lsr 12) land cont_mask))); - Bytes.unsafe_set bytes 2 - (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask))); - Bytes.unsafe_set bytes 3 - (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask))); - Bytes.unsafe_to_string bytes + let buf = Buffer.create 4 in + Buffer.add_utf_8_uchar buf (Uchar.of_int c); + Buffer.contents buf -let is_valid_code_point c = - (0 <= c && c < surrogate_min) || (surrogate_max < c && c <= max) +let is_valid_code_point = Uchar.is_valid diff --git a/packages/@rescript/runtime/lib/es6/Stdlib_Error.mjs b/packages/@rescript/runtime/lib/es6/Stdlib_Error.mjs index accca809358..10dd999fec7 100644 --- a/packages/@rescript/runtime/lib/es6/Stdlib_Error.mjs +++ b/packages/@rescript/runtime/lib/es6/Stdlib_Error.mjs @@ -22,7 +22,7 @@ let $$TypeError = {}; let $$URIError = {}; function panic(msg) { - throw new Error(`Panic! ` + msg); + throw new Error(`Panic! ${msg}`); } export { diff --git a/packages/@rescript/runtime/lib/es6/Stdlib_JsError.mjs b/packages/@rescript/runtime/lib/es6/Stdlib_JsError.mjs index b97281d70aa..27c38895d0b 100644 --- a/packages/@rescript/runtime/lib/es6/Stdlib_JsError.mjs +++ b/packages/@rescript/runtime/lib/es6/Stdlib_JsError.mjs @@ -54,7 +54,7 @@ let $$URIError$1 = { }; function panic(msg) { - throw new Error(`Panic! ` + msg); + throw new Error(`Panic! ${msg}`); } export { diff --git a/packages/@rescript/runtime/lib/es6/Stdlib_Option.mjs b/packages/@rescript/runtime/lib/es6/Stdlib_Option.mjs index 72490d88a73..641d5d11299 100644 --- a/packages/@rescript/runtime/lib/es6/Stdlib_Option.mjs +++ b/packages/@rescript/runtime/lib/es6/Stdlib_Option.mjs @@ -1,6 +1,5 @@ -import * as Stdlib_JsError from "./Stdlib_JsError.mjs"; import * as Primitive_option from "./Primitive_option.mjs"; function filter(opt, p) { @@ -18,9 +17,9 @@ function forEach(opt, f) { function getOrThrow(x, message) { if (x !== undefined) { return Primitive_option.valFromOption(x); - } else { - return Stdlib_JsError.panic(message !== undefined ? message : "Option.getOrThrow called for None value"); } + let msg = message !== undefined ? message : "Option.getOrThrow called for None value"; + throw new Error(`Panic! ${msg}`); } function mapOr(opt, $$default, f) { diff --git a/packages/@rescript/runtime/lib/es6/Stdlib_Result.mjs b/packages/@rescript/runtime/lib/es6/Stdlib_Result.mjs index 5fc77b5d29b..b93ac4d4c1d 100644 --- a/packages/@rescript/runtime/lib/es6/Stdlib_Result.mjs +++ b/packages/@rescript/runtime/lib/es6/Stdlib_Result.mjs @@ -1,13 +1,12 @@ -import * as Stdlib_JsError from "./Stdlib_JsError.mjs"; function getOrThrow(x, message) { if (x.TAG === "Ok") { return x._0; - } else { - return Stdlib_JsError.panic(message !== undefined ? message : "Result.getOrThrow called for Error value"); } + let msg = message !== undefined ? message : "Result.getOrThrow called for Error value"; + throw new Error(`Panic! ${msg}`); } function mapOr(opt, $$default, f) { diff --git a/packages/@rescript/runtime/lib/js/Stdlib_Error.cjs b/packages/@rescript/runtime/lib/js/Stdlib_Error.cjs index ffde90d0e9d..46b3fbde47a 100644 --- a/packages/@rescript/runtime/lib/js/Stdlib_Error.cjs +++ b/packages/@rescript/runtime/lib/js/Stdlib_Error.cjs @@ -22,7 +22,7 @@ let $$TypeError = {}; let $$URIError = {}; function panic(msg) { - throw new Error(`Panic! ` + msg); + throw new Error(`Panic! ${msg}`); } exports.fromException = fromException; diff --git a/packages/@rescript/runtime/lib/js/Stdlib_JsError.cjs b/packages/@rescript/runtime/lib/js/Stdlib_JsError.cjs index 9aaf7a5d37d..4dd4a355100 100644 --- a/packages/@rescript/runtime/lib/js/Stdlib_JsError.cjs +++ b/packages/@rescript/runtime/lib/js/Stdlib_JsError.cjs @@ -54,7 +54,7 @@ let $$URIError$1 = { }; function panic(msg) { - throw new Error(`Panic! ` + msg); + throw new Error(`Panic! ${msg}`); } exports.$$EvalError = $$EvalError$1; diff --git a/packages/@rescript/runtime/lib/js/Stdlib_Option.cjs b/packages/@rescript/runtime/lib/js/Stdlib_Option.cjs index b61adb99ca6..3dcde51fceb 100644 --- a/packages/@rescript/runtime/lib/js/Stdlib_Option.cjs +++ b/packages/@rescript/runtime/lib/js/Stdlib_Option.cjs @@ -1,6 +1,5 @@ 'use strict'; -let Stdlib_JsError = require("./Stdlib_JsError.cjs"); let Primitive_option = require("./Primitive_option.cjs"); function filter(opt, p) { @@ -18,9 +17,9 @@ function forEach(opt, f) { function getOrThrow(x, message) { if (x !== undefined) { return Primitive_option.valFromOption(x); - } else { - return Stdlib_JsError.panic(message !== undefined ? message : "Option.getOrThrow called for None value"); } + let msg = message !== undefined ? message : "Option.getOrThrow called for None value"; + throw new Error(`Panic! ${msg}`); } function mapOr(opt, $$default, f) { diff --git a/packages/@rescript/runtime/lib/js/Stdlib_Result.cjs b/packages/@rescript/runtime/lib/js/Stdlib_Result.cjs index a854fd04c33..590300c7f34 100644 --- a/packages/@rescript/runtime/lib/js/Stdlib_Result.cjs +++ b/packages/@rescript/runtime/lib/js/Stdlib_Result.cjs @@ -1,13 +1,12 @@ 'use strict'; -let Stdlib_JsError = require("./Stdlib_JsError.cjs"); function getOrThrow(x, message) { if (x.TAG === "Ok") { return x._0; - } else { - return Stdlib_JsError.panic(message !== undefined ? message : "Result.getOrThrow called for Error value"); } + let msg = message !== undefined ? message : "Result.getOrThrow called for Error value"; + throw new Error(`Panic! ${msg}`); } function mapOr(opt, $$default, f) { diff --git a/tests/ERROR_VARIANTS.md b/tests/ERROR_VARIANTS.md index 4d681bf6db1..5f6afa03430 100644 --- a/tests/ERROR_VARIANTS.md +++ b/tests/ERROR_VARIANTS.md @@ -242,6 +242,8 @@ Source: [typecore.ml:27](../compiler/ml/typecore.ml). | `Literal_overflow` | ✓ | `intoverflow.res` | | | `Polyvar_literal_overflow` | ✓ | `polyvar_int_overflow.res`, `polyvar_int_overflow_payload.res`, `polyvar_int_overflow_pattern.res` | | | `Unknown_literal` | ✓ | `unknown_literal.res` | | +| `Invalid_string_escape_sequence` | ☐ | — | Regular source is rejected by the parser; the typer check remains defensive for malformed AST produced by a PPX. `syntaxErrors_invalid_ordinary_template_escape.res` covers the parser diagnostic. | +| `Json_literal_outside_external` | ✓ | `json_literal_outside_external.res` | Constant `json` payloads are reserved for external attributes such as `@as`. | | `Illegal_letrec_pat` | ✓ | `illegal_letrec_pat.res` | | | `Empty_record_literal` | ✓ | `empty_record_literal.res` | | | `Uncurried_arity_mismatch` | ✓ | `arity_mismatch3.res` etc. | | @@ -532,43 +534,6 @@ multi-file harnesses, which never set `-ppx`. | `compiler/ext/bsc_args.ml` | `Unknown` | ☐ (needs CLI harness) | — | bsc_args.ml:45. Reachable trivially via `bsc --bogus`, but the `super_errors{,_multi}` runners only pass `bsc` a fixed flag list plus the source file — they can't exercise CLI-level errors. | | `compiler/ext/bsc_args.ml` | `Missing` | ☐ (needs CLI harness) | — | Same as above: `bsc -o` (no following filename). Needs a harness that invokes `bsc` with crafted argv. | ---- - -## `compiler/frontend/ast_utf8_string.ml` (retained defensive family) - -Source: [ast_utf8_string.ml:25](../compiler/frontend/ast_utf8_string.ml). Re-validation found these are source-unreachable for regular ReScript, but not completely dead: `transform_test` and the defensive string-transform path still raise them, and the OUnit unicode tests assert their offsets. Retained. - -| Variant | Status | -|---|---| -| `Invalid_code_point` | ? (source-unreachable, retained defensive/test helper) | -| `Unterminated_backslash` | ? (source-unreachable, retained defensive/test helper) | -| `Invalid_hex_escape` | ? (source-unreachable, retained defensive/test helper) | -| `Invalid_unicode_escape` | ? (source-unreachable, retained defensive/test helper) | -| `Invalid_unicode_codepoint_escape` | ? (source-unreachable, retained defensive/test helper) | - -## `compiler/frontend/ast_utf8_string_interp.ml` (retained test family) - -Source: [ast_utf8_string_interp.ml:25](../compiler/frontend/ast_utf8_string_interp.ml). - -`pos_error` is reached through `transform_test`, which is intentionally -used by OUnit tests. Modern ReScript backtick templates take the -`BackQuotes` branch of `transform_exp` and skip the interpolation parser, -so these are source-unreachable for regular ReScript, but not completely -dead. Retained. - -| Variant | Status | -|---|---| -| `Invalid_code_point` | ? (source-unreachable, retained test helper) | -| `Unterminated_backslash` | ? (source-unreachable, retained test helper) | -| `Invalid_escape_code` | ? (source-unreachable, retained test helper) | -| `Invalid_hex_escape` | ? (source-unreachable, retained test helper) | -| `Invalid_unicode_escape` | ? (source-unreachable, retained test helper) | -| `Unterminated_variable` | ? (source-unreachable, retained test helper) | -| `Unmatched_paren` | ? (source-unreachable, retained test helper) | -| `Invalid_syntax_of_var` | ? (source-unreachable, retained test helper) | - ---- - ## Removal audit notes All variants that were confirmed completely dead in this pass are listed @@ -589,7 +554,8 @@ enabled. Fixtures use `-w +A` (everything on) so default-disabled warnings still fire. Fixtures follow the naming convention `warning__.res` -so coverage gaps stay greppable. +so coverage gaps stay greppable. Warning 11 (`Unused_match`) is covered by +`warning_11_equivalent_string_patterns.res`. ### Removed warnings diff --git a/tests/analysis_tests/tests/src/CompletionTaggedTemplate.res b/tests/analysis_tests/tests/src/CompletionTaggedTemplate.res index 7186c53bc3f..3a6e625f000 100644 --- a/tests/analysis_tests/tests/src/CompletionTaggedTemplate.res +++ b/tests/analysis_tests/tests/src/CompletionTaggedTemplate.res @@ -16,3 +16,17 @@ let w = meh`` // let x = meh`foo`. // ^com + +let ordinaryInterpolation = `value: ${{ + module LocalOrdinary = M + // LocalOrdinary. + // ^com + LocalOrdinary.b(w) +}}` + +let taggedInterpolation = meh`value: ${{ + module LocalTagged = M + // LocalTagged. + // ^com + LocalTagged.b(w) +}}` diff --git a/tests/analysis_tests/tests/src/InlayHintTemplate.res b/tests/analysis_tests/tests/src/InlayHintTemplate.res new file mode 100644 index 00000000000..4b7912041f6 --- /dev/null +++ b/tests/analysis_tests/tests/src/InlayHintTemplate.res @@ -0,0 +1,8 @@ +@module("tag") +external tag: taggedTemplate = "default" + +let value = "x" +let template = `value: ${value}` +let tagged = tag`value: ${value}` + +//^hin diff --git a/tests/analysis_tests/tests/src/XformTemplate.res b/tests/analysis_tests/tests/src/XformTemplate.res new file mode 100644 index 00000000000..1236e376478 --- /dev/null +++ b/tests/analysis_tests/tests/src/XformTemplate.res @@ -0,0 +1,8 @@ +let value = "foo" + +if value == `foo` { + // ^xfm + () +} else { + () +} diff --git a/tests/analysis_tests/tests/src/expected/Completion.res.txt b/tests/analysis_tests/tests/src/expected/Completion.res.txt index fd340378c3c..fb6b507c8a4 100644 --- a/tests/analysis_tests/tests/src/expected/Completion.res.txt +++ b/tests/analysis_tests/tests/src/expected/Completion.res.txt @@ -1934,9 +1934,6 @@ Path ForAuto.a Complete src/Completion.res 234:34 posCursor:[234:34] posNoWhite:[234:33] Found expr:[234:18->234:36] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[234:18->234:34], ...[234:34->234:35]) -posCursor:[234:34] posNoWhite:[234:33] Found expr:[234:18->234:34] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[234:18->234:30], ...[234:32->234:34]) posCursor:[234:34] posNoWhite:[234:33] Found expr:[234:32->234:34] Pexp_ident na:[234:32->234:34] Completable: Cpath Value[na] @@ -2648,9 +2645,6 @@ Path AndThatOther.T Complete src/Completion.res 381:24 posCursor:[381:24] posNoWhite:[381:23] Found expr:[381:12->381:26] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[381:12->381:24], ...[381:24->381:25]) -posCursor:[381:24] posNoWhite:[381:23] Found expr:[381:12->381:24] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[381:12->381:14], ...[381:16->381:24]) posCursor:[381:24] posNoWhite:[381:23] Found expr:[381:16->381:24] Pexp_ident ForAuto.:[381:16->381:24] Completable: Cpath Value[ForAuto, ""] @@ -2666,9 +2660,6 @@ Path ForAuto. Complete src/Completion.res 384:38 posCursor:[384:38] posNoWhite:[384:37] Found expr:[384:12->384:41] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[384:12->384:39], ...[384:39->384:40]) -posCursor:[384:38] posNoWhite:[384:37] Found expr:[384:12->384:39] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[384:12->384:17], ...[384:19->384:39]) posCursor:[384:38] posNoWhite:[384:37] Found expr:[384:19->384:39] Pexp_object_get [384:38->384:38] e:[384:19->384:36] Completable: Cpath Value[FAO, forAutoObject][""] @@ -2690,9 +2681,6 @@ Path FAO.forAutoObject Complete src/Completion.res 387:24 posCursor:[387:24] posNoWhite:[387:23] Found expr:[387:11->387:26] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[387:11->387:24], ...[387:24->387:25]) -posCursor:[387:24] posNoWhite:[387:23] Found expr:[387:11->387:24] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[387:11->387:12], ...[387:14->387:24]) posCursor:[387:24] posNoWhite:[387:23] Found expr:[387:14->387:24] Pexp_field [387:14->387:23] _:[387:24->387:24] Completable: Cpath Value[funRecord]."" @@ -2769,9 +2757,6 @@ Path ma Complete src/Completion.res 399:14 posCursor:[399:14] posNoWhite:[399:13] Found expr:[398:14->399:20] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[398:14->399:16], ...[399:16->399:19]) -posCursor:[399:14] posNoWhite:[399:13] Found expr:[398:14->399:16] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[398:14->399:11], ...[399:13->399:16]) posCursor:[399:14] posNoWhite:[399:13] Found expr:[399:13->399:16] Pexp_ident red:[399:13->399:16] Completable: Cpath Value[red] @@ -2784,9 +2769,6 @@ Path red Complete src/Completion.res 404:25 posCursor:[404:25] posNoWhite:[404:24] Found expr:[402:14->404:31] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[402:14->404:27], ...[404:27->404:30]) -posCursor:[404:25] posNoWhite:[404:24] Found expr:[402:14->404:27] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[402:14->404:22], ...[404:24->404:27]) posCursor:[404:25] posNoWhite:[404:24] Found expr:[404:24->404:27] Pexp_ident red:[404:24->404:27] Completable: Cpath Value[red] @@ -2799,9 +2781,6 @@ Path red Complete src/Completion.res 407:22 posCursor:[407:22] posNoWhite:[407:21] Found expr:[407:11->485:0] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[407:11->425:17], ...[430:0->485:0]) -posCursor:[407:22] posNoWhite:[407:21] Found expr:[407:11->425:17] -Pexp_apply ...__ghost__[0:-1->0:-1] (...[407:11->407:19], ...[407:21->425:17]) posCursor:[407:22] posNoWhite:[407:21] Found expr:[407:21->425:17] posCursor:[407:22] posNoWhite:[407:21] Found expr:[407:21->407:22] Pexp_ident r:[407:21->407:22] diff --git a/tests/analysis_tests/tests/src/expected/CompletionTaggedTemplate.res.txt b/tests/analysis_tests/tests/src/expected/CompletionTaggedTemplate.res.txt index 7fe6d09ca6a..de28166dc94 100644 --- a/tests/analysis_tests/tests/src/expected/CompletionTaggedTemplate.res.txt +++ b/tests/analysis_tests/tests/src/expected/CompletionTaggedTemplate.res.txt @@ -137,3 +137,59 @@ Path } ] +Complete src/CompletionTaggedTemplate.res 21:19 +posCursor:[21:19] posNoWhite:[21:18] Found expr:[19:28->24:3] +posCursor:[21:19] posNoWhite:[21:18] Found expr:[20:2->23:20] +posCursor:[21:19] posNoWhite:[21:18] Found expr:[21:5->23:20] +Pexp_apply ...[21:5->23:17] (...[23:18->23:19]) +posCursor:[21:19] posNoWhite:[21:18] Found expr:[21:5->23:17] +Pexp_ident LocalOrdinary.:[21:5->23:17] +Completable: Cpath Value[LocalOrdinary, ""] +Package opens Stdlib.place holder Pervasives.JsxModules.place holder +Resolved opens 1 Stdlib +ContextPath Value[LocalOrdinary, ""] +Path LocalOrdinary. +[ + { + "detail": "type t", + "documentation": { + "kind": "markdown", + "value": "```rescript\ntype t = promise\n```" + }, + "kind": 22, + "label": "t", + "tags": [] + }, + { "detail": "t => int", "kind": 12, "label": "a", "tags": [] }, + { "detail": "t => string", "kind": 12, "label": "b", "tags": [] }, + { "detail": "(t, int) => int", "kind": 12, "label": "xyz", "tags": [] } +] + +Complete src/CompletionTaggedTemplate.res 28:17 +posCursor:[28:17] posNoWhite:[28:16] Found expr:[26:26->31:3] +posCursor:[28:17] posNoWhite:[28:16] Found expr:[27:2->30:18] +posCursor:[28:17] posNoWhite:[28:16] Found expr:[28:5->30:18] +Pexp_apply ...[28:5->30:15] (...[30:16->30:17]) +posCursor:[28:17] posNoWhite:[28:16] Found expr:[28:5->30:15] +Pexp_ident LocalTagged.:[28:5->30:15] +Completable: Cpath Value[LocalTagged, ""] +Package opens Stdlib.place holder Pervasives.JsxModules.place holder +Resolved opens 1 Stdlib +ContextPath Value[LocalTagged, ""] +Path LocalTagged. +[ + { + "detail": "type t", + "documentation": { + "kind": "markdown", + "value": "```rescript\ntype t = promise\n```" + }, + "kind": 22, + "label": "t", + "tags": [] + }, + { "detail": "t => int", "kind": 12, "label": "a", "tags": [] }, + { "detail": "t => string", "kind": 12, "label": "b", "tags": [] }, + { "detail": "(t, int) => int", "kind": 12, "label": "xyz", "tags": [] } +] + diff --git a/tests/analysis_tests/tests/src/expected/DocComments.res.txt b/tests/analysis_tests/tests/src/expected/DocComments.res.txt index f9adbf2b358..e9641d78e17 100644 --- a/tests/analysis_tests/tests/src/expected/DocComments.res.txt +++ b/tests/analysis_tests/tests/src/expected/DocComments.res.txt @@ -2,7 +2,7 @@ Hover src/DocComments.res 9:9 { "contents": { "kind": "markdown", - "value": "```rescript\nint\n```\n---\n Doc comment with a triple-backquote example\\n \\n ```res example\\n let a = 10\\n /*\\n * stuff\\n */\\n ```\\n" + "value": "```rescript\nint\n```\n---\n Doc comment with a triple-backquote example\n \n ```res example\n let a = 10\n /*\n * stuff\n */\n ```\n" } } @@ -18,7 +18,7 @@ Hover src/DocComments.res 33:9 { "contents": { "kind": "markdown", - "value": "```rescript\nint\n```\n---\n Doc comment with a triple-backquote example\\n \\n ```res example\\n let a = 10\\n let b = 20\\n ```\\n" + "value": "```rescript\nint\n```\n---\n Doc comment with a triple-backquote example\n \n ```res example\n let a = 10\n let b = 20\n ```\n" } } diff --git a/tests/analysis_tests/tests/src/expected/DocumentSymbol.res.txt b/tests/analysis_tests/tests/src/expected/DocumentSymbol.res.txt index 18d32d157e1..72433bc69c7 100644 --- a/tests/analysis_tests/tests/src/expected/DocumentSymbol.res.txt +++ b/tests/analysis_tests/tests/src/expected/DocumentSymbol.res.txt @@ -1,7 +1,7 @@ DocumentSymbol src/DocumentSymbol.res [ { - "kind": 13, + "kind": 15, "name": "templateString", "range": { "end": { "character": 49, "line": 32 }, diff --git a/tests/analysis_tests/tests/src/expected/InlayHintTemplate.res.txt b/tests/analysis_tests/tests/src/expected/InlayHintTemplate.res.txt new file mode 100644 index 00000000000..96b3e572739 --- /dev/null +++ b/tests/analysis_tests/tests/src/expected/InlayHintTemplate.res.txt @@ -0,0 +1,25 @@ +Inlay Hint src/InlayHintTemplate.res 1:34 +[ + { + "kind": 1, + "label": ": string", + "paddingLeft": true, + "paddingRight": false, + "position": { "character": 10, "line": 5 } + }, + { + "kind": 1, + "label": ": string", + "paddingLeft": true, + "paddingRight": false, + "position": { "character": 12, "line": 4 } + }, + { + "kind": 1, + "label": ": string", + "paddingLeft": true, + "paddingRight": false, + "position": { "character": 9, "line": 3 } + } +] + diff --git a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt index 1742f63294a..39e94f4ae4b 100644 --- a/tests/analysis_tests/tests/src/expected/RecordRest.res.txt +++ b/tests/analysis_tests/tests/src/expected/RecordRest.res.txt @@ -47,8 +47,8 @@ Source: expr: Pexp_record( fields: - name: Pexp_constant(Pconst_string(v)) - version: Pexp_constant(Pconst_string(1)) + name: Pexp_constant(Pconst_string(source=v, semantic=v)) + version: Pexp_constant(Pconst_string(source=1, semantic=1)) ) ) diff --git a/tests/analysis_tests/tests/src/expected/XformTemplate.res.txt b/tests/analysis_tests/tests/src/expected/XformTemplate.res.txt new file mode 100644 index 00000000000..290f769aa15 --- /dev/null +++ b/tests/analysis_tests/tests/src/expected/XformTemplate.res.txt @@ -0,0 +1,24 @@ +Xform src/XformTemplate.res 2:5 +posCursor:[2:3] posNoWhite:[2:1] Found expr:[2:0->7:1] +Completable: Cpath Value[value] +Package opens Stdlib.place holder Pervasives.JsxModules.place holder +Resolved opens 1 Stdlib +ContextPath Value[value] +Path value +Package opens Stdlib.place holder Pervasives.JsxModules.place holder +Resolved opens 1 Stdlib +Hit: Replace with switch + +TextDocumentEdit: XformTemplate.res +{ + "end": { "character": 1, "line": 7 }, + "start": { "character": 0, "line": 2 } +} +newText: +<--here +switch value { +| "foo" => // ^xfm + () +| _ => () +} + diff --git a/tests/build_tests/super_errors/expected/hoisted_function_export_collision.res.expected b/tests/build_tests/super_errors/expected/hoisted_function_export_collision.res.expected index a8c130e227f..7969277ca0f 100644 --- a/tests/build_tests/super_errors/expected/hoisted_function_export_collision.res.expected +++ b/tests/build_tests/super_errors/expected/hoisted_function_export_collision.res.expected @@ -8,4 +8,4 @@ 4 │ } 5 │ let \"One$make" = () => () - Cannot hoist this function as `One$make` because that name is already used by a top-level binding. + Cannot hoist this function as `One$make` because that name is already used by a top-level binding. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/hoisted_function_path_collision.res.expected b/tests/build_tests/super_errors/expected/hoisted_function_path_collision.res.expected index 3f049f96977..3299c8be04c 100644 --- a/tests/build_tests/super_errors/expected/hoisted_function_path_collision.res.expected +++ b/tests/build_tests/super_errors/expected/hoisted_function_path_collision.res.expected @@ -8,4 +8,4 @@ 8 │ } 9 │ let after = () - Cannot hoist this function as `A$B$make` because that name is already used by a top-level binding. + Cannot hoist this function as `A$B$make` because that name is already used by a top-level binding. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/json_literal_inline.res.expected b/tests/build_tests/super_errors/expected/json_literal_inline.res.expected new file mode 100644 index 00000000000..0e6bf0eab50 --- /dev/null +++ b/tests/build_tests/super_errors/expected/json_literal_inline.res.expected @@ -0,0 +1,9 @@ + + We've found a bug for you! + /.../fixtures/json_literal_inline.res:2:17-28 + + 1 │ @inline + 2 │ let value = json`{foo: true}` + 3 │ + + A `json` literal can only be used in an external attribute such as `@as` \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/json_literal_inline_payload.res.expected b/tests/build_tests/super_errors/expected/json_literal_inline_payload.res.expected new file mode 100644 index 00000000000..349ce978301 --- /dev/null +++ b/tests/build_tests/super_errors/expected/json_literal_inline_payload.res.expected @@ -0,0 +1,9 @@ + + We've found a bug for you! + /.../fixtures/json_literal_inline_payload.res:1:13-17 + + 1 │ @inline(json`null`) + 2 │ let value = "ignored" + 3 │ + + A `json` literal can only be used in an external attribute such as `@as` \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/json_literal_outside_external.res.expected b/tests/build_tests/super_errors/expected/json_literal_outside_external.res.expected new file mode 100644 index 00000000000..258909bc038 --- /dev/null +++ b/tests/build_tests/super_errors/expected/json_literal_outside_external.res.expected @@ -0,0 +1,8 @@ + + We've found a bug for you! + /.../fixtures/json_literal_outside_external.res:1:17-29 + + 1 │ let value = json`{answer: 42}` + 2 │ + + A `json` literal can only be used in an external attribute such as `@as` \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/json_literal_todo_payload.res.expected b/tests/build_tests/super_errors/expected/json_literal_todo_payload.res.expected index f42889000bb..4998cb09352 100644 --- a/tests/build_tests/super_errors/expected/json_literal_todo_payload.res.expected +++ b/tests/build_tests/super_errors/expected/json_literal_todo_payload.res.expected @@ -1,13 +1,8 @@ - Warning number 110 - /.../fixtures/json_literal_todo_payload.res:3:13-32 + We've found a bug for you! + /.../fixtures/json_literal_todo_payload.res:1:23-30 - 1 │ /* Known bug: json literals are only meaningful in external attributes, - │ but - 2 │ this is currently treated as a regular todo payload. */ - 3 │ let value = %todo(json`message`) - 4 │ + 1 │ let value = %todo(json`message`) + 2 │ - Todo found: message - - This code is not implemented yet and will crash at runtime. Make sure you implement this before running the code. \ No newline at end of file + A `json` literal can only be used in an external attribute such as `@as` \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/object_write_original_after_alias.res.expected b/tests/build_tests/super_errors/expected/object_write_original_after_alias.res.expected index 37d98ba4f5b..fe732b1bbb3 100644 --- a/tests/build_tests/super_errors/expected/object_write_original_after_alias.res.expected +++ b/tests/build_tests/super_errors/expected/object_write_original_after_alias.res.expected @@ -8,4 +8,4 @@ 13 │ This has type: {"x": int} - But this function argument is expecting: {..@set "x": int} + But this function argument is expecting: {..@set "x": int} \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_field_not_optional.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_not_optional.res.expected index 73870f3e36b..35fd22c8923 100644 --- a/tests/build_tests/super_errors/expected/record_rest_field_not_optional.res.expected +++ b/tests/build_tests/super_errors/expected/record_rest_field_not_optional.res.expected @@ -10,4 +10,4 @@ The following field appears in both the explicit pattern and the rest type `sub`: - a -This is not type-safe because the field would always be absent from the rest value. Remove it from the rest type, or match it as optional if absence is intended. +This is not type-safe because the field would always be absent from the rest value. Remove it from the rest type, or match it as optional if absence is intended. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected b/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected index 53cebe701af..fee93f2ae43 100644 --- a/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected +++ b/tests/build_tests/super_errors/expected/record_rest_field_not_optional_plural.res.expected @@ -11,4 +11,4 @@ - a - b -This is not type-safe because these fields would always be absent from the rest value. Remove them from the rest type, or match them as optional if absence is intended. +This is not type-safe because these fields would always be absent from the rest value. Remove them from the rest type, or match them as optional if absence is intended. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_optional_overlap_warning.res.expected b/tests/build_tests/super_errors/expected/record_rest_optional_overlap_warning.res.expected index 83f8bc80450..20b3679b319 100644 --- a/tests/build_tests/super_errors/expected/record_rest_optional_overlap_warning.res.expected +++ b/tests/build_tests/super_errors/expected/record_rest_optional_overlap_warning.res.expected @@ -10,4 +10,4 @@ The following optional field appears in both the explicit pattern and the rest type: - a -It will always be absent from the rest record. +It will always be absent from the rest record. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected b/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected index 36391ac4e88..1f0ed47e0b1 100644 --- a/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected +++ b/tests/build_tests/super_errors/expected/record_rest_private_type.res.expected @@ -7,4 +7,4 @@ 9 │ let {a, ...M.t as rest} = ({a: 1, b: "x"}: source) 10 │ - Cannot create values of the private type M.t + Cannot create values of the private type M.t \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/syntaxErrors_invalid_ordinary_template_escape.res.expected b/tests/build_tests/super_errors/expected/syntaxErrors_invalid_ordinary_template_escape.res.expected new file mode 100644 index 00000000000..30b734054f6 --- /dev/null +++ b/tests/build_tests/super_errors/expected/syntaxErrors_invalid_ordinary_template_escape.res.expected @@ -0,0 +1,10 @@ + + Syntax error! + /.../fixtures/syntaxErrors_invalid_ordinary_template_escape.res:2:15-23 + + 1 │ let before = "ok" + 2 │ let invalid = `\unicode` + 3 │ let after = "ok" + 4 │ let fartherAfter = "ok" + + Invalid string escape sequence diff --git a/tests/build_tests/super_errors/expected/syntaxErrors_json_interpolation.res.expected b/tests/build_tests/super_errors/expected/syntaxErrors_json_interpolation.res.expected new file mode 100644 index 00000000000..9476845ce36 --- /dev/null +++ b/tests/build_tests/super_errors/expected/syntaxErrors_json_interpolation.res.expected @@ -0,0 +1,8 @@ + + Syntax error! + /.../fixtures/syntaxErrors_json_interpolation.res:1:17-35 + + 1 │ let value = json`head${"value"}tail` + 2 │ + + `json` literals do not support interpolation \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/syntaxErrors_tagged_template_pattern.res.expected b/tests/build_tests/super_errors/expected/syntaxErrors_tagged_template_pattern.res.expected new file mode 100644 index 00000000000..30373645b00 --- /dev/null +++ b/tests/build_tests/super_errors/expected/syntaxErrors_tagged_template_pattern.res.expected @@ -0,0 +1,11 @@ + + Syntax error! + /.../fixtures/syntaxErrors_tagged_template_pattern.res:3:5-14 + + 1 │ let classify = value => + 2 │ switch value { + 3 │ | json`\x61` => 1 + 4 │ | _ => 2 + 5 │ } + + Tagged template literals are not supported in patterns \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/warning_11_equivalent_string_patterns.res.expected b/tests/build_tests/super_errors/expected/warning_11_equivalent_string_patterns.res.expected new file mode 100644 index 00000000000..54eedb5d7f4 --- /dev/null +++ b/tests/build_tests/super_errors/expected/warning_11_equivalent_string_patterns.res.expected @@ -0,0 +1,11 @@ + + Warning number 11 + /.../fixtures/warning_11_equivalent_string_patterns.res:4:5-10 + + 2 ┆ switch value { + 3 ┆ | "a" => 1 + 4 ┆ | "\x61" => 2 + 5 ┆ | _ => 3 + 6 ┆ } + + this match case is unused. \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/json_literal_inline.res b/tests/build_tests/super_errors/fixtures/json_literal_inline.res new file mode 100644 index 00000000000..c496f5e47c9 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/json_literal_inline.res @@ -0,0 +1,2 @@ +@inline +let value = json`{foo: true}` diff --git a/tests/build_tests/super_errors/fixtures/json_literal_inline_payload.res b/tests/build_tests/super_errors/fixtures/json_literal_inline_payload.res new file mode 100644 index 00000000000..285bd2605c1 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/json_literal_inline_payload.res @@ -0,0 +1,2 @@ +@inline(json`null`) +let value = "ignored" diff --git a/tests/build_tests/super_errors/fixtures/json_literal_outside_external.res b/tests/build_tests/super_errors/fixtures/json_literal_outside_external.res new file mode 100644 index 00000000000..e5fcc0bb2c3 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/json_literal_outside_external.res @@ -0,0 +1 @@ +let value = json`{answer: 42}` diff --git a/tests/build_tests/super_errors/fixtures/json_literal_todo_payload.res b/tests/build_tests/super_errors/fixtures/json_literal_todo_payload.res index af38c52fd62..df4ea11cb6a 100644 --- a/tests/build_tests/super_errors/fixtures/json_literal_todo_payload.res +++ b/tests/build_tests/super_errors/fixtures/json_literal_todo_payload.res @@ -1,3 +1 @@ -/* Known bug: json literals are only meaningful in external attributes, but - this is currently treated as a regular todo payload. */ let value = %todo(json`message`) diff --git a/tests/build_tests/super_errors/fixtures/syntaxErrors_invalid_ordinary_template_escape.res b/tests/build_tests/super_errors/fixtures/syntaxErrors_invalid_ordinary_template_escape.res new file mode 100644 index 00000000000..3e0702f580e --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/syntaxErrors_invalid_ordinary_template_escape.res @@ -0,0 +1,4 @@ +let before = "ok" +let invalid = `\unicode` +let after = "ok" +let fartherAfter = "ok" diff --git a/tests/build_tests/super_errors/fixtures/syntaxErrors_json_interpolation.res b/tests/build_tests/super_errors/fixtures/syntaxErrors_json_interpolation.res new file mode 100644 index 00000000000..6565548d4d9 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/syntaxErrors_json_interpolation.res @@ -0,0 +1 @@ +let value = json`head${"value"}tail` diff --git a/tests/build_tests/super_errors/fixtures/syntaxErrors_tagged_template_pattern.res b/tests/build_tests/super_errors/fixtures/syntaxErrors_tagged_template_pattern.res new file mode 100644 index 00000000000..79f24d297fc --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/syntaxErrors_tagged_template_pattern.res @@ -0,0 +1,5 @@ +let classify = value => + switch value { + | json`\x61` => 1 + | _ => 2 + } diff --git a/tests/build_tests/super_errors/fixtures/warning_11_equivalent_string_patterns.res b/tests/build_tests/super_errors/fixtures/warning_11_equivalent_string_patterns.res new file mode 100644 index 00000000000..ff9150bb9ec --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/warning_11_equivalent_string_patterns.res @@ -0,0 +1,6 @@ +let classify = value => + switch value { + | "a" => 1 + | "\x61" => 2 + | _ => 3 + } diff --git a/tests/docstring_tests/DocTest.res.js b/tests/docstring_tests/DocTest.res.js index ced1ac1dac7..eb5a8f19120 100644 --- a/tests/docstring_tests/DocTest.res.js +++ b/tests/docstring_tests/DocTest.res.js @@ -50,7 +50,7 @@ async function extractDocFromFile(file) { let e = Primitive_exceptions.internalToException(raw_e); if (e.RE_EXN_ID === "JsExn") { console.error(e._1); - return Stdlib_JsError.panic(`Failed to extract code blocks from ` + file); + return Stdlib_JsError.panic(`Failed to extract code blocks from ${file}`); } throw e; } @@ -78,7 +78,7 @@ async function extractExamples() { } }).map(f => Nodepath.join(docPath, f)); }); - console.log(`Extracting examples from ` + docFiles.length.toString() + ` runtime and Belt files...`); + console.log(`Extracting examples from ${docFiles.length.toString()} runtime and Belt files...`); let examples = []; await ArrayUtils.forEachAsyncInBatches(docFiles, batchSize, async file => { let doc = await extractDocFromFile(file); @@ -110,23 +110,23 @@ async function main() { } }); if (ignoreExample) { - console.warn(`Ignoring ` + example.id + ` tests. Not supported by Node ` + nodeVersion.toString()); + console.warn(`Ignoring ${example.id} tests. Not supported by Node ${nodeVersion.toString()}`); return; } let code = example.code; if (code.length === 0) { return; } else if (code.includes("await")) { - return `testAsync("` + example.name + `", async () => { + return `testAsync("${example.name}", async () => { module Test = { - ` + code + ` + ${code} } () })`; } else { - return `test("` + example.name + `", () => { + return `test("${example.name}", () => { module Test = { - ` + code + ` + ${code} } () })`; @@ -135,8 +135,8 @@ async function main() { if (codeExamples.length === 0) { return; } - let content = `describe("` + key + `", () => { -` + codeExamples.join("\n") + ` + let content = `describe("${key}", () => { +${codeExamples.join("\n")} })`; output.push(content); }); @@ -145,7 +145,7 @@ async function main() { let fileContent = `open Mocha @@warning("-32-34-60-37-109-3-44") -` + output.join("\n"); +${output.join("\n")}`; return await Promises.writeFile(filepath, fileContent); } diff --git a/tests/gentype_tests/typescript-react-example/src/ImportJsValue.gen.tsx b/tests/gentype_tests/typescript-react-example/src/ImportJsValue.gen.tsx index a238cc104f3..3b1fe08a73b 100644 --- a/tests/gentype_tests/typescript-react-example/src/ImportJsValue.gen.tsx +++ b/tests/gentype_tests/typescript-react-example/src/ImportJsValue.gen.tsx @@ -3,7 +3,7 @@ /* eslint-disable */ /* tslint:disable */ -import {round as roundNotChecked} from './MyM\x61th'; +import {round as roundNotChecked} from './MyMath'; import {round2 as round2NotChecked} from './MyMath'; @@ -25,7 +25,7 @@ import {polymorphic as polymorphicNotChecked} from './MyMath'; import {default as defaultNotChecked} from './MyMath'; -// In case of type error, check the type of 'round' in 'ImportJsValue.res' and './MyM\x61th'. +// In case of type error, check the type of 'round' in 'ImportJsValue.res' and './MyMath'. export const roundTypeChecked: (_1:number) => number = roundNotChecked as any; // Export 'round' early to allow circular import from the '.bs.js' file. diff --git a/tests/gentype_tests/typescript-react-example/src/ImportJsValue.res.js b/tests/gentype_tests/typescript-react-example/src/ImportJsValue.res.js index 4b6a11a0a9b..8a66e36eb2c 100644 --- a/tests/gentype_tests/typescript-react-example/src/ImportJsValue.res.js +++ b/tests/gentype_tests/typescript-react-example/src/ImportJsValue.res.js @@ -51,7 +51,7 @@ function useEscapedInlineVariant(prim) { return ImportJsValueGen$1.useEscapedInlineVariant((() => { switch (prim) { case "illegalName" : - return "Illegal\\\"Name"; + return "Illegal\"Name"; } })()); } @@ -60,7 +60,7 @@ function useUtf8InlineVariant(prim) { return ImportJsValueGen$1.useUtf8InlineVariant((() => { switch (prim) { case "utf8" : - return "café\\npath\\\\name"; + return "café\npath\\name"; } })()); } diff --git a/tests/gentype_tests/typescript-react-example/src/Records.gen.tsx b/tests/gentype_tests/typescript-react-example/src/Records.gen.tsx index f605dc6ec05..b0a412eec10 100644 --- a/tests/gentype_tests/typescript-react-example/src/Records.gen.tsx +++ b/tests/gentype_tests/typescript-react-example/src/Records.gen.tsx @@ -52,7 +52,7 @@ export type myRecBsAs = { readonly jsValid0: string; readonly type: string; readonly "the-key": string; - readonly "with\\\"dquote": string; + readonly "with\"dquote": string; readonly "with'squote": string; readonly "1number": string }; diff --git a/tests/gentype_tests/typescript-react-example/src/Records.res.js b/tests/gentype_tests/typescript-react-example/src/Records.res.js index bd78028a8ff..de7bc02a4fe 100644 --- a/tests/gentype_tests/typescript-react-example/src/Records.res.js +++ b/tests/gentype_tests/typescript-react-example/src/Records.res.js @@ -98,7 +98,7 @@ function testMyRecBsAs(x) { x.jsValid0, x.type, x["the-key"], - x["with\\\"dquote"], + x["with\"dquote"], x["with'squote"], x["1number"] ]; diff --git a/tests/ounit_tests/dune b/tests/ounit_tests/dune index 73bd6f0ce25..01e508fe0a2 100644 --- a/tests/ounit_tests/dune +++ b/tests/ounit_tests/dune @@ -13,4 +13,4 @@ (backend bisect_ppx)) (flags (:standard -w +a-4-9-30-40-41-42-48-70)) - (libraries core ounit2 analysis)) + (libraries core gentype ounit2 analysis)) diff --git a/tests/ounit_tests/ounit_ast_mapper0_tests.ml b/tests/ounit_tests/ounit_ast_mapper0_tests.ml index 47febb7cd9d..32e2564b049 100644 --- a/tests/ounit_tests/ounit_ast_mapper0_tests.ml +++ b/tests/ounit_tests/ounit_ast_mapper0_tests.ml @@ -3,6 +3,15 @@ let assert_failure = OUnit.assert_failure let loc = Location.none +let located_string ?(loc = loc) txt = {Location.txt; loc} + +let source_loc start_cnum end_cnum = + { + Location.loc_start = {Lexing.dummy_pos with pos_cnum = start_cnum}; + loc_end = {Lexing.dummy_pos with pos_cnum = end_cnum}; + loc_ghost = false; + } + let attr name payload = ({Location.txt = name; loc}, payload) let has_attr name attrs = @@ -180,6 +189,421 @@ let map_expr_to0 e = let attr_names attrs = List.map (fun ({Location.txt}, _) -> txt) attrs +let assert_string_expr ~expected_source ~expected_semantic expr = + match expr.Parsetree.pexp_desc with + | Pexp_constant (Pconst_string payload) -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected_source + (String_literal.string_source payload); + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected_semantic + (String_literal.string_semantic payload) + | _ -> assert_failure "Expected a string expression" + +let assert_string_pat ~expected_source ~expected_semantic pat = + match pat.Parsetree.ppat_desc with + | Ppat_constant (Pconst_string payload) -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected_source + (String_literal.string_source payload); + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected_semantic + (String_literal.string_semantic payload) + | _ -> assert_failure "Expected a string pattern" + +let assert_template_expr ~expected expr = + match expr.Parsetree.pexp_desc with + | Pexp_template {source_segments = [actual]; values = []} -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected actual.txt + | _ -> assert_failure "Expected a template expression" + +let test_ast0_strings_convert_to_internal_representation _ = + let encoded = {|a\n\uD83D\uDE00|} in + let expr0 = + Ast_helper0.Exp.constant ~loc + (Parsetree0.Pconst_string (encoded, Some "js")) + in + assert_string_expr ~expected_source:encoded ~expected_semantic:"a\n😀" + (map_expr0 expr0); + let pat0 = + Ast_helper0.Pat.constant ~loc + (Parsetree0.Pconst_string (encoded, Some "js")) + in + assert_string_pat ~expected_source:encoded ~expected_semantic:"a\n😀" + (map_pat0 pat0); + (* Older compiler-produced ast0 files can contain the processed [*j] + delimiter. Decode those directly instead of interpreting them as source + text again. *) + let legacy_expr0 = + Ast_helper0.Exp.constant ~loc (Parsetree0.Pconst_string ({|\"|}, Some "*j")) + in + assert_string_expr ~expected_source:{|\"|} ~expected_semantic:"\"" + (map_expr0 legacy_expr0); + let template_expr0 = + Ast_helper0.Exp.constant ~loc + ~attrs:[attr "res.template" (Parsetree0.PStr [])] + (Parsetree0.Pconst_string (encoded, Some "js")) + in + assert_template_expr ~expected:encoded (map_expr0 template_expr0); + let quoted_expr0 = + Ast_helper0.Exp.constant ~loc + (Parsetree0.Pconst_string ({|\x61|}, Some "custom")) + in + assert_string_expr ~expected_source:{|\\x61|} ~expected_semantic:{|\x61|} + (map_expr0 quoted_expr0); + (* A tagged pattern cannot invoke its tag. Treating its raw contents as a + string made json`\x61` collide with the ordinary "\\x61" pattern during + string-switch sorting. Reject both known and arbitrary PPX delimiters. *) + List.iter + (fun tag -> + let tagged_pattern0 = + Ast_helper0.Pat.constant ~loc + (Parsetree0.Pconst_string ({|\x61|}, Some tag)) + in + match map_pat0 tagged_pattern0 with + | _ -> assert_failure "Expected the ast0 tagged pattern to be rejected" + | exception Location.Error _ -> ()) + ["custom"; "json"]; + let invalid_expr0 = + Ast_helper0.Exp.constant ~loc + (Parsetree0.Pconst_string ({|\uD800|}, Some "js")) + in + match map_expr0 invalid_expr0 with + | _ -> assert_failure "Expected an invalid ast0 string escape" + | exception Location.Error _ -> () + +let test_ppx_byte_strings_convert_to_valid_utf8 _ = + let byte_string = "a\xff\xc3\xa9" in + let expression0 = + Ast_helper0.Exp.constant ~loc (Ast_helper0.Const.string byte_string) + in + match (map_expr0 expression0).pexp_desc with + | Pexp_constant (Pconst_string payload) -> + let source = String_literal.string_source payload in + let semantic = String_literal.string_semantic payload in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") "aÿé" source; + OUnit.assert_equal ~printer:(Printf.sprintf "%S") "aÿé" semantic; + OUnit.assert_equal ~printer:string_of_int 3 + (String_literal.utf16_length semantic) + | _ -> assert_failure "Expected a normalized PPX string" + +let test_string_literals_roundtrip_through_ast0 _ = + let semantic = "a\n😀" in + let expr = Ast_helper.Exp.constant ~loc (Ast_helper.Const.string semantic) in + assert_string_expr ~expected_source:{|a\n😀|} ~expected_semantic:semantic + (map_expr0 (map_expr_to0 expr)); + let encoded = {|a\n\uD83D\uDE00|} in + let template_expr = + Ast_helper.Exp.template ~loc [located_string encoded] [] + in + let template_expr0 = map_expr_to0 template_expr in + (match template_expr0.Parsetree0.pexp_desc with + | Pexp_constant (Pconst_string (actual, Some "js")) -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") encoded actual; + OUnit.assert_bool "expected the ast0 template marker" + (List.mem "res.template" (attr_names template_expr0.pexp_attributes)) + | _ -> assert_failure "Expected ast0's template string representation"); + let template_expr = map_expr0 template_expr0 in + assert_template_expr ~expected:encoded template_expr; + OUnit.assert_bool "the ast0 template marker was consumed" + (not (List.mem "res.template" (attr_names template_expr.pexp_attributes))); + let template_pat = + Ast_helper.Pat.constant ~loc (Ast_helper.Const.string "a\n😀") + in + let template_pat0 = + Ast_mapper_to0.default_mapper.pat Ast_mapper_to0.default_mapper template_pat + in + OUnit.assert_bool "ordinary string patterns need no ast0 template marker" + (not (List.mem "res.template" (attr_names template_pat0.ppat_attributes))); + let template_pat = map_pat0 template_pat0 in + (match template_pat.ppat_desc with + | Ppat_constant (Pconst_string payload) -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") "a\n😀" + (String_literal.string_semantic payload) + | _ -> assert_failure "Expected a string pattern after ast0 roundtrip"); + let json_expr = + Ast_helper.Exp.constant ~loc (Parsetree.Pconst_json {|{"answer":42}|}) + in + (match (map_expr0 (map_expr_to0 json_expr)).pexp_desc with + | Pexp_constant (Pconst_json actual) -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {|{"answer":42}|} actual + | _ -> assert_failure "Expected a JSON literal"); + let char_pattern = + Ast_helper.Pat.constant ~loc + (Parsetree.Pconst_char {source = {|\u{61}|}; semantic = 0x61}) + in + let char_pattern0 = + Ast_mapper_to0.default_mapper.pat Ast_mapper_to0.default_mapper char_pattern + in + (match char_pattern0.ppat_desc with + | Ppat_constant (Pconst_char actual) -> + OUnit.assert_equal ~printer:string_of_int 0x61 actual + | _ -> assert_failure "Expected an ast0 character literal"); + (match (map_pat0 char_pattern0).ppat_desc with + | Ppat_constant (Pconst_char {source; semantic}) -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") "a" source; + OUnit.assert_equal ~printer:string_of_int 0x61 semantic + | _ -> assert_failure "Expected a character literal after ast0 roundtrip"); + let source_string = + Ast_helper.Exp.constant ~loc + (Parsetree.Pconst_string + (match String_literal.string_from_source {|\x61|} with + | Some payload -> payload + | None -> assert_failure "Expected a valid source string")) + in + assert_string_expr ~expected_source:{|\x61|} ~expected_semantic:"a" + (map_expr0 (map_expr_to0 source_string)) + +let assert_raw_extension_payload ~name ~expected expression = + match expression.Parsetree.pexp_desc with + | Pexp_extension + ( {txt}, + PStr + [ + { + pstr_desc = + Pstr_eval + ({pexp_desc = Pexp_constant (Pconst_raw_source actual)}, _); + }; + ] ) -> + OUnit.assert_equal name txt; + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected actual + | _ -> assert_failure "Expected a raw extension string payload" + +let test_raw_extension_payloads_roundtrip_through_ast0 _ = + let encoded = {|'\\n'|} in + List.iter + (fun name -> + let payload = + Parsetree0.PStr + [ + Ast_helper0.Str.eval ~loc + (Ast_helper0.Exp.constant ~loc + (Parsetree0.Pconst_string (encoded, Some "js"))); + ] + in + let expression0 = + Ast_helper0.Exp.extension ~loc (Location.mknoloc name, payload) + in + let expression = map_expr0 expression0 in + assert_raw_extension_payload ~name ~expected:encoded expression; + assert_raw_extension_payload ~name ~expected:encoded + (map_expr0 (map_expr_to0 expression))) + ["raw"; "ffi"; "re"] + +let test_tagged_templates_roundtrip_through_ast0 _ = + let head_loc = source_loc 4 16 in + let tail_loc = source_loc 20 25 in + let tag = + Ast_helper.Exp.ident ~loc (Location.mknoloc (Longident.Lident "tag")) + in + let value = Ast_helper.Exp.constant ~loc (Ast_helper.Const.integer "1") in + let expression = + Ast_helper.Exp.tagged_template ~loc + ~attrs:[attr "keep" (Parsetree.PStr [])] + tag + [ + located_string ~loc:head_loc {|raw\unicode|}; + located_string ~loc:tail_loc " tail"; + ] + [value] + in + let expression0 = map_expr_to0 expression in + OUnit.assert_bool "the frozen AST uses the tagged-template marker" + (List.mem "res.taggedTemplate" (attr_names expression0.pexp_attributes)); + (match expression0.pexp_desc with + | Pexp_apply + ( _, + [ + (_, {pexp_desc = Pexp_array [head; tail]}); + (_, {pexp_desc = Pexp_array [_]}); + ] ) -> + OUnit.assert_equal ~printer:Ext_obj.dump [head_loc; tail_loc] + [head.pexp_loc; tail.pexp_loc] + | _ -> assert_failure "Expected frozen-AST tagged-template arrays"); + match (map_expr0 expression0).pexp_desc with + | Pexp_tagged_template + { + tag = {pexp_desc = Pexp_ident {txt = Longident.Lident "tag"}}; + raw_sources; + values = [{pexp_desc = Pexp_constant (Pconst_integer ("1", None))}]; + } -> + OUnit.assert_equal ~printer:Ext_obj.dump [{|raw\unicode|}; " tail"] + (List.map (fun {Location.txt} -> txt) raw_sources); + OUnit.assert_equal ~printer:Ext_obj.dump [head_loc; tail_loc] + (List.map (fun (source : string Location.loc) -> source.loc) raw_sources); + OUnit.assert_equal ["keep"] + (attr_names (map_expr0 expression0).pexp_attributes) + | _ -> assert_failure "Expected an explicit tagged template after roundtrip" + +let test_ppx_rewritten_tagged_template_segments _ = + let semantic = "${value}`\\" in + let segment = + Ast_helper0.Exp.constant ~loc (Ast_helper0.Const.string semantic) + in + let tag = + Ast_helper0.Exp.ident ~loc (Location.mknoloc (Longident.Lident "tag")) + in + let expression0 = + Ast_helper0.Exp.apply ~loc + ~attrs:[attr "res.taggedTemplate" (Parsetree0.PStr [])] + tag + [ + (Nolabel, Ast_helper0.Exp.array ~loc [segment]); + (Nolabel, Ast_helper0.Exp.array ~loc []); + ] + in + match (map_expr0 expression0).pexp_desc with + | Pexp_tagged_template {raw_sources = [{txt}]} -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {e|\${value}\`\\|e} txt + | _ -> assert_failure "Expected a rewritten tagged template after roundtrip" + +let test_ppx_rewritten_template_segments _ = + let template_attr = attr "res.template" (Parsetree0.PStr []) in + let semantic = "${value}`\\" in + let uninterpolated = + Ast_helper0.Exp.constant ~loc ~attrs:[template_attr] + (Ast_helper0.Const.string semantic) + in + assert_template_expr ~expected:{e|\${value}\`\\|e} (map_expr0 uninterpolated); + let segment semantic = + Ast_helper0.Exp.constant ~loc ~attrs:[template_attr] + (Ast_helper0.Const.string semantic) + in + let concat lhs rhs = + Ast_helper0.Exp.apply ~loc ~attrs:[template_attr] + (Ast_helper0.Exp.ident ~loc (Location.mknoloc (Longident.Lident "^"))) + [(Asttypes.Noloc.Nolabel, lhs); (Asttypes.Noloc.Nolabel, rhs)] + in + let value = + Ast_helper0.Exp.ident ~loc (Location.mknoloc (Longident.Lident "value")) + in + let interpolated = + concat (concat (segment "${head}") value) (segment "`\\") + in + match (map_expr0 interpolated).pexp_desc with + | Pexp_template + { + source_segments = [{txt = head}; {txt = tail}]; + values = [{pexp_desc = Pexp_ident {txt = Longident.Lident "value"}}]; + } -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {e|\${head}|e} head; + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {e|\`\\|e} tail + | _ -> assert_failure "Expected a rewritten template after roundtrip" + +let test_interpolated_templates_roundtrip_through_ast0 _ = + let head_loc = source_loc 1 8 in + let tail_loc = source_loc 12 16 in + let value = Ast_helper.Exp.constant ~loc (Ast_helper.Const.integer "1") in + let expression = + Ast_helper.Exp.template ~loc + ~attrs:[attr "keep" (Parsetree.PStr [])] + [ + located_string ~loc:head_loc {|head\n|}; + located_string ~loc:tail_loc "tail"; + ] + [value] + in + let expression0 = map_expr_to0 expression in + OUnit.assert_bool "the frozen AST uses the template marker" + (List.mem "res.template" (attr_names expression0.pexp_attributes)); + let rec first_segment (expression : Parsetree0.expression) = + match expression.pexp_desc with + | Pexp_apply (_, [(_, lhs); (_, _)]) -> first_segment lhs + | Pexp_constant (Pconst_string (source, Some actual_delimiter)) -> + OUnit.assert_equal "js" actual_delimiter; + OUnit.assert_equal {|head\n|} source + | _ -> assert_failure "Expected a frozen-AST template segment" + in + first_segment expression0; + let rec segment_locations (expression : Parsetree0.expression) = + match expression.pexp_desc with + | Pexp_apply (_, [(_, lhs); (_, rhs)]) -> + segment_locations lhs @ segment_locations rhs + | Pexp_constant (Pconst_string (_, Some "js")) -> [expression.pexp_loc] + | _ -> [] + in + OUnit.assert_equal ~printer:Ext_obj.dump [head_loc; tail_loc] + (segment_locations expression0); + match map_expr0 expression0 with + | { + pexp_desc = + Pexp_template + { + source_segments; + values = [{pexp_desc = Pexp_constant (Pconst_integer ("1", None))}]; + }; + pexp_attributes; + } -> + OUnit.assert_equal ~printer:Ext_obj.dump [{|head\n|}; "tail"] + (List.map (fun {Location.txt} -> txt) source_segments); + OUnit.assert_equal ~printer:Ext_obj.dump [head_loc; tail_loc] + (List.map + (fun (source : string Location.loc) -> source.loc) + source_segments); + OUnit.assert_equal ["keep"] (attr_names pexp_attributes) + | _ -> assert_failure "Expected an explicit template after roundtrip" + +let test_ast0_json_interpolation_is_rejected _ = + let template_attr = attr "res.template" (Parsetree0.PStr []) in + let segment source = + Ast_helper0.Exp.constant ~loc ~attrs:[template_attr] + (Parsetree0.Pconst_string (source, Some "json")) + in + let concat lhs rhs = + Ast_helper0.Exp.apply ~loc ~attrs:[template_attr] + (Ast_helper0.Exp.ident ~loc (Location.mknoloc (Longident.Lident "^"))) + [(Asttypes.Noloc.Nolabel, lhs); (Asttypes.Noloc.Nolabel, rhs)] + in + let value = + Ast_helper0.Exp.constant ~loc (Parsetree0.Pconst_integer ("1", None)) + in + let expression = concat (concat (segment "head") value) (segment "tail") in + match map_expr0 expression with + | _ -> assert_failure "Expected ast0 JSON interpolation to be rejected" + | exception Location.Error _ -> () + +let test_string_source_reprints_after_ast0_roundtrip _ = + let source = + {|let newline = "\n" +let slashN = "\\n" +let quote = "\"" +let slash = "\\"|} + in + let parsed = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringReprintTest.res" ~source + in + OUnit.assert_bool "expected valid ReScript source" (not parsed.invalid); + let structure0 = + Ast_mapper_to0.default_mapper.structure Ast_mapper_to0.default_mapper + parsed.parsetree + in + let round_tripped = + Ast_mapper_from0.default_mapper.structure Ast_mapper_from0.default_mapper + structure0 + in + let reprinted = + Res_printer.print_implementation round_tripped ~comments:[] ~width:80 + in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") (source ^ "\n") reprinted + +let test_invalid_utf8_doc_comment_roundtrips_through_ast0 _ = + let source = "/** doc " ^ "\xff" ^ " byte */\nlet value = 1" in + let parsed = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"InvalidDocComment.res" ~source + in + OUnit.assert_bool "expected invalid UTF-8 to be diagnosed" parsed.invalid; + OUnit.assert_bool "expected an invalid-code-point diagnostic" + (List.exists + (fun diagnostic -> + Res_diagnostics.explain diagnostic = "Invalid code point") + parsed.diagnostics); + let structure0 = + Ast_mapper_to0.default_mapper.structure Ast_mapper_to0.default_mapper + parsed.parsetree + in + ignore + (Ast_mapper_from0.default_mapper.structure Ast_mapper_from0.default_mapper + structure0) + (* Function-node attributes such as [@this] must stay node attributes across the v0 bridge: the built-in PPX reads decorators from [pexp_attributes], so a round trip that moves them into [p_attrs] silently disables them. *) @@ -226,25 +650,22 @@ let test_fun_param_attrs_roundtrip_through_ast0 _ = (attr_names p_attrs) | _ -> assert_failure "Expected a function after ast0 roundtrip" -let test_error_extension_encoded_strings _ = - let encoded_string value = +let test_error_extension_backquoted_strings _ = + let backquoted_string value = Ast_helper.Str.eval ~loc - (Ast_helper.Exp.constant ~loc - (Parsetree.Pconst_string (value, Some "js"))) + (Ast_helper.Exp.template ~loc [located_string value] []) in let extension = ( Location.mknoloc "error", Parsetree.PStr [ - encoded_string {|plain\nmessage|}; - encoded_string {|highlighted\nmessage|}; + backquoted_string {|plain\nmessage|}; + backquoted_string {|highlighted\nmessage|}; ] ) in let error = Builtin_attributes.error_of_extension extension in - (* Known bug: these are encoded string bodies, but error extensions expose - their source spelling instead of their decoded semantic values. *) - OUnit.assert_equal ~printer:(Printf.sprintf "%S") {|plain\nmessage|} error.msg; - OUnit.assert_equal ~printer:(Printf.sprintf "%S") {|highlighted\nmessage|} + OUnit.assert_equal ~printer:(Printf.sprintf "%S") "plain\nmessage" error.msg; + OUnit.assert_equal ~printer:(Printf.sprintf "%S") "highlighted\nmessage" error.if_highlight let suites = @@ -256,6 +677,28 @@ let suites = >:: test_fun_node_attrs_roundtrip_through_ast0; "fun_param_attrs_roundtrip_through_ast0" >:: test_fun_param_attrs_roundtrip_through_ast0; + "ast0_strings_convert_to_internal_representation" + >:: test_ast0_strings_convert_to_internal_representation; + "ppx_byte_strings_convert_to_valid_utf8" + >:: test_ppx_byte_strings_convert_to_valid_utf8; + "string_literals_roundtrip_through_ast0" + >:: test_string_literals_roundtrip_through_ast0; + "raw_extension_payloads_roundtrip_through_ast0" + >:: test_raw_extension_payloads_roundtrip_through_ast0; + "tagged_templates_roundtrip_through_ast0" + >:: test_tagged_templates_roundtrip_through_ast0; + "ppx_rewritten_tagged_template_segments" + >:: test_ppx_rewritten_tagged_template_segments; + "ppx_rewritten_template_segments" + >:: test_ppx_rewritten_template_segments; + "interpolated_templates_roundtrip_through_ast0" + >:: test_interpolated_templates_roundtrip_through_ast0; + "ast0_json_interpolation_is_rejected" + >:: test_ast0_json_interpolation_is_rejected; + "string_source_reprints_after_ast0_roundtrip" + >:: test_string_source_reprints_after_ast0_roundtrip; + "invalid_utf8_doc_comment_roundtrips_through_ast0" + >:: test_invalid_utf8_doc_comment_roundtrips_through_ast0; "malformed_internal_record_rest_attr_fails" >:: test_malformed_internal_record_rest_attr_fails; "record_rest_roundtrips_through_ast0" @@ -264,6 +707,6 @@ let suites = >:: test_value_constraint_roundtrips_through_ast0; "function_cases_desugar_to_fun_match" >:: test_function_cases_desugar_to_fun_match; - "error_extensions_expose_encoded_strings" - >:: test_error_extension_encoded_strings; + "error_extensions_accept_backquoted_strings" + >:: test_error_extension_backquoted_strings; ] diff --git a/tests/ounit_tests/ounit_gentype_tests.ml b/tests/ounit_tests/ounit_gentype_tests.ml new file mode 100644 index 00000000000..2b3e363efbc --- /dev/null +++ b/tests/ounit_tests/ounit_gentype_tests.ml @@ -0,0 +1,25 @@ +open OUnit + +let suites = + "gentype" + >::: [ + ( "escape semantic import paths" >:: fun _ -> + let emit path = + path |> Import_path.from_string_unsafe |> Import_path.emit + in + assert_equal "./foo\\\\bar" (emit "./foo\\bar"); + assert_equal "./foo\\'bar" (emit "./foo'bar"); + assert_equal "./foo\\nbar" (emit "./foo\nbar"); + let line_separator = Ext_utf8.encode_codepoint 0x2028 in + let paragraph_separator = Ext_utf8.encode_codepoint 0x2029 in + assert_equal "./foo\\u2028bar\\u2029baz" + (emit + ("./foo" ^ line_separator ^ "bar" ^ paragraph_separator ^ "baz")) + ); + ( "escape semantic TypeScript strings" >:: fun _ -> + let escape = Emit_text.escape_string_contents in + assert_equal "é" (escape "é"); + assert_equal "a\\\"b\\\\c" (escape "a\"b\\c"); + assert_equal "\\b\\f\\n\\r\\t\\v\\x7F" + (escape "\b\012\n\r\t\011\127") ); + ] diff --git a/tests/ounit_tests/ounit_lambda_constant_tests.ml b/tests/ounit_tests/ounit_lambda_constant_tests.ml index ef285a8a559..242139c5c4b 100644 --- a/tests/ounit_tests/ounit_lambda_constant_tests.ml +++ b/tests/ounit_tests/ounit_lambda_constant_tests.ml @@ -2,17 +2,19 @@ open OUnit let ( =~ ) = OUnit.assert_equal -let assert_string_constant raw_delim expected_delim = - Lambda.const_string "value" raw_delim - =~ Lambda.Const_string {s = "value"; delim = expected_delim} - let suites = __FILE__ >::: [ - ( "processed string delimiters" >:: fun _ -> - assert_string_constant None (Some DNone); - assert_string_constant (Some "json") (Some DNoQuotes); - assert_string_constant (Some "*j") (Some DStarJ); - assert_string_constant (Some "bq") (Some DBackQuotes); - assert_string_constant (Some "js") None ); + ( "typed string constants" >:: fun _ -> + Lambda.const_string "value" =~ Lambda.Const_string "value" ); + ( "compiler-generated strings normalize malformed bytes" >:: fun _ -> + let constant = Lambda.const_string "a\xffé" in + constant =~ Lambda.Const_string "aÿé"; + match + Lambda.prim ~primitive:Lambda.Pstringlength + ~args:[Lambda.const constant] + Location.none + with + | Lambda.Lconst (Lambda.Const_int length) -> 3l =~ length + | _ -> OUnit.assert_failure "expected a folded string length" ); ] diff --git a/tests/ounit_tests/ounit_string_literal_tests.ml b/tests/ounit_tests/ounit_string_literal_tests.ml new file mode 100644 index 00000000000..a8fdb3e542a --- /dev/null +++ b/tests/ounit_tests/ounit_string_literal_tests.ml @@ -0,0 +1,798 @@ +let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: )) + +let located_string txt = Location.mknoloc txt + +let assert_decoded ~encoded ~expected = + OUnit.assert_equal ~printer:Ext_obj.dump (Some expected) + (String_literal.decode_js_escapes encoded) + +let assert_template_decoded ~encoded ~expected = + OUnit.assert_equal ~printer:Ext_obj.dump (Some expected) + (String_literal.decode_js_template_escapes encoded) + +let assert_invalid_template encoded = + OUnit.assert_equal ~printer:Ext_obj.dump None + (String_literal.decode_js_template_escapes encoded) + +let assert_encoded ~semantic ~expected = + let encoded = String_literal.encode_js_string semantic in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected encoded; + assert_decoded ~encoded ~expected:semantic + +let assert_invalid_backquoted_pattern encoded = + let source = "let f = value => switch value { | `" ^ encoded ^ "` => 1 }" in + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" ~source + in + OUnit.assert_bool "expected an invalid string escape" result.invalid + +let assert_invalid_backquoted_pattern_after_diagnostic () = + let source = + {| +let invalidBigint = 0x1n +let f = value => switch value { | `\uD800` => 1 } +|} + in + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" ~source + in + OUnit.assert_equal ~printer:string_of_int 2 (List.length result.diagnostics) + +let assert_invalid_tagged_template_pattern tag = + let source = + "let f = value => switch value { | " ^ tag ^ "`literal` => 1 }" + in + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" ~source + in + OUnit.assert_bool "expected a tagged template pattern error" result.invalid + +let assert_invalid_string encoded = + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" + ~source:("let value = \"" ^ encoded ^ "\"") + in + OUnit.assert_bool "expected an invalid string escape" result.invalid + +let assert_invalid_template_expression source = + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" + ~source:("let value = `" ^ source ^ "`") + in + OUnit.assert_bool "expected an invalid template escape" result.invalid + +let assert_parsed_string ~source ~expected_semantic = + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" + ~source:("let value = \"" ^ source ^ "\"") + in + match result.parsetree with + | [ + { + pstr_desc = + Pstr_value + (_, [{pvb_expr = {pexp_desc = Pexp_constant (Pconst_string actual)}}]); + }; + ] -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") source + (String_literal.string_source actual); + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected_semantic + (String_literal.string_semantic actual) + | _ -> OUnit.assert_failure "expected a parsed string literal" + +let assert_invalid_utf8_after_diagnostic () = + let source = "let x = (1,\nlet value = \"bad " ^ "\xff" ^ " byte\"" in + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" ~source + in + OUnit.assert_equal ~printer:string_of_int 2 (List.length result.diagnostics); + OUnit.assert_bool "expected an invalid-code-point diagnostic" + (List.exists + (fun diagnostic -> + Res_diagnostics.explain diagnostic = "Invalid code point") + result.diagnostics) + +let assert_parsed_char ~for_printer ~source ~expected_semantic = + let result = + Res_driver.parse_implementation_from_source ~for_printer + ~display_filename:"StringLiteralTest.res" + ~source:("let value = '" ^ source ^ "'") + in + match result.parsetree with + | [ + { + pstr_desc = + Pstr_value + ( _, + [ + { + pvb_expr = + { + pexp_desc = + Pexp_constant + (Pconst_char {source = actual_source; semantic}); + }; + }; + ] ); + }; + ] -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") source actual_source; + OUnit.assert_equal ~printer:string_of_int expected_semantic semantic + | _ -> OUnit.assert_failure "expected a parsed character literal" + +let assert_parsed_template_literal ~source = + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" + ~source:("let value = `" ^ source ^ "`") + in + match result.parsetree with + | [ + { + pstr_desc = + Pstr_value + ( _, + [ + { + pvb_expr = + { + pexp_desc = + Pexp_template {source_segments = [actual]; values = []}; + pexp_attributes = []; + }; + }; + ] ); + }; + ] -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") source actual.txt + | _ -> OUnit.assert_failure "expected an explicit template expression" + +let assert_parsed_template_pattern ~source ~expected_semantic = + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" + ~source:("let f = value => switch value { | `" ^ source ^ "` => 1 }") + in + let actual = ref None in + let mapper = + { + Ast_mapper.default_mapper with + pat = + (fun self pattern -> + (match pattern.ppat_desc with + | Ppat_constant (Pconst_string payload) -> + actual := + Some + ( String_literal.string_source payload, + String_literal.string_semantic payload, + pattern.ppat_attributes ) + | _ -> ()); + Ast_mapper.default_mapper.pat self pattern); + } + in + ignore (mapper.structure mapper result.parsetree); + match !actual with + | Some (actual_source, semantic, []) -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") + (String_literal.encode_js_string expected_semantic) + actual_source; + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected_semantic semantic + | _ -> OUnit.assert_failure "expected a normalized string pattern" + +let assert_parsed_template () = + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" + ~source:"let value = `head\\n${item}tail`" + in + match result.parsetree with + | [ + { + pstr_desc = + Pstr_value + ( _, + [ + { + pvb_expr = + { + pexp_desc = + Pexp_template + { + source_segments; + values = + [ + { + pexp_desc = + Pexp_ident {txt = Longident.Lident "item"}; + }; + ]; + }; + }; + }; + ] ); + }; + ] -> + OUnit.assert_equal ~printer:Ext_obj.dump [{|head\n|}; "tail"] + (List.map (fun {Location.txt} -> txt) source_segments) + | _ -> OUnit.assert_failure "expected an explicit parsed template" + +let assert_tagged_template_location () = + let prefix = "let value = " in + let source = prefix ^ "tag`head${item}tail`" in + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" ~source + in + match result.parsetree with + | [ + { + pstr_desc = + Pstr_value + (_, [{pvb_expr = {pexp_desc = Pexp_tagged_template _; pexp_loc}}]); + }; + ] -> + OUnit.assert_equal ~printer:string_of_int (String.length prefix) + pexp_loc.loc_start.pos_cnum; + OUnit.assert_equal ~printer:string_of_int (String.length source) + pexp_loc.loc_end.pos_cnum + | _ -> OUnit.assert_failure "expected a parsed tagged template" + +let assert_invalid_json_interpolation () = + let result = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"StringLiteralTest.res" + ~source:{|let value = json`head${item}tail`|} + in + OUnit.assert_bool "expected JSON interpolation to be rejected" result.invalid + +let assert_int_equal expected actual = + OUnit.assert_equal ~printer:string_of_int expected actual + +let assert_code_point_at string index expected = + OUnit.assert_equal ~printer:Ext_obj.dump expected + (String_literal.code_point_at_utf16_index string index) + +let semantic_string s = Lambda.const (Lambda.Const_string s) + +let template_segment source = + match String_literal.template_from_source source with + | Some segment -> segment + | None -> OUnit.assert_failure "expected a valid template segment" + +let template_literal source = + Js_exp_make.template_literal (template_segment source) + +let lam_int i = Lambda.const (Lambda.Const_int (Int32.of_int i)) + +let assert_lam_int expected = function + | Lambda.Lconst (Lambda.Const_int i) -> + OUnit.assert_equal ~printer:Int32.to_string (Int32.of_int expected) i + | _ -> OUnit.assert_failure "expected a folded Lambda integer" + +let assert_lam_char expected = function + | Lambda.Lconst (Lambda.Const_char actual) -> assert_int_equal expected actual + | _ -> OUnit.assert_failure "expected a folded Lambda character" + +let typed_string s = + match Typecore.constant (Ast_helper.Const.string s) with + | Ok constant -> constant + | Error _ -> OUnit.assert_failure "expected a typed string constant" + +let assert_typed_template ~source_segments ~expected_semantics = + let value = Ast_helper.Exp.constant (Ast_helper.Const.string "value") in + let expression = + Ast_helper.Exp.template (List.map located_string source_segments) [value] + in + let typed = + Typecore.type_exp Env.initial_safe_string expression + ~context:(Some Error_message_utils.StringConcat) + in + begin match typed.exp_desc with + | Texp_template + {segments; values = [{exp_desc = Texp_constant (Const_string "value")}]} + -> + OUnit.assert_equal ~printer:Ext_obj.dump source_segments + (List.map String_literal.template_source segments); + OUnit.assert_equal ~printer:Ext_obj.dump expected_semantics + (List.map String_literal.template_semantic segments) + | _ -> OUnit.assert_failure "expected an explicit typed template" + end; + match Translcore.transl_exp typed with + | Lprim + {primitive = Ptemplate segments; args = [Lconst (Const_string "value")]} + -> + OUnit.assert_equal ~printer:Ext_obj.dump source_segments + (List.map String_literal.template_source segments); + OUnit.assert_equal ~printer:Ext_obj.dump expected_semantics + (List.map String_literal.template_semantic segments) + | _ -> OUnit.assert_failure "expected an explicit Lambda template" + +let convert_typed_constant constant = Lambda.const_of_typed constant + +let assert_js_string ~expected constant = + match (Lam_compile_const.translate constant).J.expression_desc with + | Str actual -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected actual + | _ -> OUnit.assert_failure "expected a JavaScript string expression" + +let assert_external_js_string ~expected constant = + match (Lam_compile_const.translate_arg_cst constant).J.expression_desc with + | Str actual -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected actual + | _ -> OUnit.assert_failure "expected a JavaScript string expression" + +let assert_external_json_literal ~expected constant = + match (Lam_compile_const.translate_arg_cst constant).J.expression_desc with + | Json_literal actual -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected actual + | _ -> OUnit.assert_failure "expected a JavaScript JSON literal expression" + +let inline_string semantic = + match Ast_external_mk.inline_string semantic with + | Prim_inline_const constant -> constant + | _ -> OUnit.assert_failure "expected an inline constant" + +let assert_js_global ~expected (expression : J.expression) = + match expression.expression_desc with + | Var (Id ident) -> + OUnit.assert_bool "expected a JavaScript global" (Ext_ident.is_js ident); + OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected ident.name + | _ -> OUnit.assert_failure "expected a JavaScript global reference" + +let string_payload constant = + Parsetree.PStr [Ast_helper.Str.eval (Ast_helper.Exp.constant constant)] + +let template_payload source = + Parsetree.PStr + [Ast_helper.Str.eval (Ast_helper.Exp.template [located_string source] [])] + +let suites = + __FILE__ + >::: [ + ( "plain text" >:: fun _ -> + assert_decoded ~encoded:"plain" ~expected:"plain" ); + ( "named escapes" >:: fun _ -> + assert_decoded ~encoded:{|\b\f\n\r\t\v\0|} + ~expected:"\b\012\n\r\t\011\000" ); + ( "semantic strings get canonical source spelling" >:: fun _ -> + assert_encoded ~semantic:"\b\012\n\r\t\011\000\"\\😀" + ~expected:{|\b\f\n\r\t\v\x00\"\\😀|} ); + ( "escaped punctuation and non-escapes" >:: fun _ -> + assert_decoded ~encoded:{|\\\"\'\ \$\`\a|} ~expected:{|\"' $`a|}; + assert_decoded ~encoded:"\\é" ~expected:"é" ); + ( "hex escapes" >:: fun _ -> + assert_decoded ~encoded:{|\x61\xE9|} ~expected:"aé" ); + ( "unicode escapes" >:: fun _ -> + assert_decoded ~encoded:{|\u0061\u20AC|} ~expected:"a€"; + assert_decoded ~encoded:{|\u{1f600}|} ~expected:"😀"; + assert_decoded ~encoded:{|\uD83D\uDE00|} ~expected:"😀" ); + ( "malformed UTF-8 is rejected" >:: fun _ -> + List.iter + (fun encoded -> + OUnit.assert_equal ~printer:Ext_obj.dump None + (String_literal.decode_js_escapes encoded); + OUnit.assert_equal ~printer:Ext_obj.dump None + (String_literal.decode_js_template_escapes encoded)) + ["\xc0\x80"; "\xed\xa0\x80"; "\xf4\x90\x80\x80"] ); + ( "line continuations" >:: fun _ -> + assert_decoded ~encoded:"a\\\nb" ~expected:"ab"; + assert_decoded ~encoded:"a\\\rb" ~expected:"ab"; + assert_decoded ~encoded:"a\\\r\nb" ~expected:"ab"; + List.iter + (fun codepoint -> + let separator = Ext_utf8.encode_codepoint codepoint in + let encoded = "a\\" ^ separator ^ "b" in + assert_decoded ~encoded ~expected:"ab"; + assert_template_decoded ~encoded ~expected:"ab") + [0x2028; 0x2029] ); + ( "template line endings use JavaScript normalization" >:: fun _ -> + assert_decoded ~encoded:"a\r\nb" ~expected:"a\r\nb"; + assert_template_decoded ~encoded:"a\rb" ~expected:"a\nb"; + assert_template_decoded ~encoded:"a\r\nb" ~expected:"a\nb"; + assert_template_decoded ~encoded:"a\\r\\nb" ~expected:"a\r\nb" ); + ( "templates reject legacy octal and decimal escapes" >:: fun _ -> + assert_template_decoded ~encoded:{|a\0b|} ~expected:"a\000b"; + List.iter + (fun encoded -> + OUnit.assert_equal ~printer:Ext_obj.dump None + (String_literal.decode_js_template_escapes encoded)) + [{|a\1b|}; {|a\01b|}; {|a\8b|}] ); + ( "template segments reject interpolation openers" >:: fun _ -> + assert_invalid_template "${value}"; + assert_template_decoded ~encoded:"\\${value}" ~expected:"${value}" ); + ( "ordinary literals become semantic strings" >:: fun _ -> + assert_parsed_string ~source:{|\x61\n\uD83D\uDE00|} + ~expected_semantic:"a\n😀" ); + ( "template expressions preserve source spelling" >:: fun _ -> + let encoded = {|\x61|} in + assert_parsed_template_literal ~source:encoded; + assert_parsed_template_pattern ~source:encoded ~expected_semantic:"a"; + let expression = + Ast_helper.Exp.template [located_string encoded] [] + in + match + (Bs_builtin_ppx.mapper.expr Bs_builtin_ppx.mapper expression) + .pexp_desc + with + | Pexp_template {source_segments = [actual]; values = []} -> + OUnit.assert_equal ~printer:(Printf.sprintf "%S") encoded + actual.txt + | _ -> OUnit.assert_failure "expected a template expression" ); + ( "tagged templates are rejected in patterns" >:: fun _ -> + assert_invalid_tagged_template_pattern "json"; + assert_invalid_tagged_template_pattern "js" ); + ( "interpolated templates have an explicit parser representation" + >:: fun _ -> + assert_parsed_template (); + assert_tagged_template_location (); + assert_invalid_json_interpolation () ); + ( "template expression escapes are parser diagnostics" >:: fun _ -> + List.iter assert_invalid_template_expression + [{|bad \xZZ escape|}; {|a\1b|}; {|a\01b|}; {|a\8b|}] ); + ( "interpolated templates have an explicit typed representation" + >:: fun _ -> + assert_typed_template ~source_segments:[{|head\n|}; {|\u0061|}] + ~expected_semantics:["head\n"; "a"]; + assert_typed_template ~source_segments:["head\r\n"; "tail\r"] + ~expected_semantics:["head\n"; "tail\n"] ); + ( "constant templates remain nonexpansive" >:: fun _ -> + let expression = + Ast_helper.Exp.template [located_string "literal"] [] + in + let typed = + Typecore.type_exp Env.initial_safe_string expression ~context:None + in + OUnit.assert_bool + "an interpolation-free template should generalize like a string \ + constant" + (Typecore.is_nonexpansive typed) ); + ( "invalid encoded values are rejected" >:: fun _ -> + List.iter + (fun encoded -> + OUnit.assert_equal ~printer:Ext_obj.dump None + (String_literal.decode_js_escapes encoded)) + [ + {|trailing\|}; + {|\x6|}; + {|\xGG|}; + {|\u061|}; + {|\u{}|}; + {|\u{110000}|}; + {|\uD800|}; + {|\uDC00|}; + {|\uD800\u0041|}; + {|\uDC00\uD800|}; + "\128"; + "\195"; + "\195A"; + "\\\195"; + ] ); + ( "invalid UTF-8 is reported after an earlier diagnostic" >:: fun _ -> + assert_invalid_utf8_after_diagnostic () ); + ( "scanner rejects invalid braced Unicode escapes" >:: fun _ -> + assert_invalid_string {|\u{}|}; + assert_invalid_string {|\u{110000}|} ); + ( "backquoted patterns reject lone surrogate escapes" >:: fun _ -> + assert_invalid_backquoted_pattern {|\uD800|}; + assert_invalid_backquoted_pattern {|\uDC00|} ); + ( "invalid backquoted pattern after an earlier diagnostic" >:: fun _ -> + assert_invalid_backquoted_pattern_after_diagnostic () ); + ( "character literals retain source and semantic forms" >:: fun _ -> + assert_parsed_char ~for_printer:false ~source:{|\u{61}|} + ~expected_semantic:0x61; + assert_parsed_char ~for_printer:true ~source:{|\u{61}|} + ~expected_semantic:0x61; + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {e|\x00|e} + (String_literal.encode_char_source 0x00); + OUnit.assert_equal ~printer:(Printf.sprintf "%S") "😀" + (String_literal.encode_char_source 0x1f600); + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {|\u{D800}|} + (String_literal.encode_char_source 0xd800) ); + ( "character patterns are not tagged templates" >:: fun _ -> + let pattern = + Ast_helper.Pat.constant + (Parsetree.Pconst_char {source = "a"; semantic = 0x61}) + in + let transformed = + Bs_builtin_ppx.mapper.pat Bs_builtin_ppx.mapper pattern + in + OUnit.assert_equal ~printer:Ext_obj.dump pattern.ppat_desc + transformed.ppat_desc ); + ( "typed constants contain only semantic strings" >:: fun _ -> + let semantic = typed_string "a\n😀" in + OUnit.assert_equal ~printer:Ext_obj.dump + (Asttypes.Const_string "a\n😀") semantic; + OUnit.assert_equal ~printer:Ext_obj.dump + (Ast_helper.Const.string "a\n😀") + (Untypeast.constant semantic); + OUnit.assert_equal ~printer:Ext_obj.dump + (Error Typecore.Json_literal_outside_external) + (Typecore.constant (Parsetree.Pconst_json {|{"answer":42}|})) ); + ( "constant backquoted attribute strings become semantic" >:: fun _ -> + OUnit.assert_equal ~printer:Ext_obj.dump (Some "a\n😀") + (Ast_payload.semantic_string_of_payload + (template_payload {|\x61\n\uD83D\uDE00|})); + OUnit.assert_equal ~printer:Ext_obj.dump (Some "a\n😀") + (Builtin_attributes.deprecated_of_attrs + [ + ( Location.mkloc "deprecated" Location.none, + template_payload {|\x61\n\uD83D\uDE00|} ); + ]); + OUnit.assert_equal ~printer:Ext_obj.dump None + (Ast_payload.semantic_string_of_payload + (string_payload (Pconst_json {|{"answer":42}|}))); + match + Ast_payload.semantic_string_of_payload + (template_payload {|\uD800|}) + with + | _ -> OUnit.assert_failure "expected an invalid string escape" + | exception Location.Error _ -> () ); + ( "error extensions accept backquoted messages" >:: fun _ -> + let extension = + ( Location.mknoloc "error", + template_payload {|message\nwith context|} ) + in + let error = Builtin_attributes.error_of_extension extension in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") + "message\nwith context" error.msg; + let extension_with_highlight = + ( Location.mknoloc "error", + Parsetree.PStr + [ + Ast_helper.Str.eval + (Ast_helper.Exp.template + [located_string {|plain\nmessage|}] + []); + Ast_helper.Str.eval + (Ast_helper.Exp.template + [located_string {|highlighted\nmessage|}] + []); + ] ) + in + let error = + Builtin_attributes.error_of_extension extension_with_highlight + in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") + "highlighted\nmessage" error.if_highlight ); + ( "external string constants have explicit representations" >:: fun _ -> + OUnit.assert_equal ~printer:Ext_obj.dump + (External_ffi_types.Const_string "a\n😀") (inline_string "a\n😀"); + assert_external_js_string ~expected:{|\x61|} + (External_arg_spec.cst_string {|\x61|}); + assert_external_json_literal ~expected:{|{"answer":42}|} + (External_arg_spec.cst_json {|{"answer":42}|}); + let json = Js_exp_make.json_literal {| {answer: 42} |} in + OUnit.assert_bool "expected JSON literals to be side-effect free" + (Js_analyzer.no_side_effect_expression json); + OUnit.assert_bool + "expected allocating JSON literals not to duplicate" + (not (Js_analyzer.is_okay_to_duplicate json)); + OUnit.assert_bool "expected JSON literals not to compare as strings" + (not + (Js_analyzer.eq_expression json + (Js_exp_make.json_literal {| {answer: 42} |}))); + (match (Js_exp_make.typeof json).expression_desc with + | Typeof argument -> + OUnit.assert_bool "expected typeof to preserve the JSON expression" + (json == argument) + | _ -> OUnit.assert_failure "expected a runtime typeof expression"); + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {| {answer: 42} |} + (Js_dump.string_of_expression json) ); + ( "Lambda constants contain semantic strings" >:: fun _ -> + let semantic = + convert_typed_constant (Asttypes.Const_string "a\n😀") + in + OUnit.assert_equal ~printer:Ext_obj.dump (Lambda.Const_string "a\n😀") + semantic ); + ( "JavaScript IR distinguishes strings and template literals" + >:: fun _ -> + assert_js_string ~expected:"a\n😀" (Lambda.Const_string "a\n😀"); + let semantic = Js_exp_make.str "a" in + let template = template_literal {|\x61|} in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {|`\x61`|} + (Js_dump.string_of_expression template); + (match (Js_exp_make.string_length template).expression_desc with + | Number (Int {i = 1l}) -> () + | _ -> + OUnit.assert_failure + "expected template literal length to use its semantic value"); + (match + (Js_exp_make.string_append semantic template).expression_desc + with + | Str "aa" -> () + | _ -> OUnit.assert_failure "expected string literals to fold"); + (match + (Js_exp_make.string_append template (template_literal "b")) + .expression_desc + with + | Str "ab" -> () + | _ -> OUnit.assert_failure "expected template literals to fold"); + let tagged = + Js_exp_make.tagged_template + (Js_exp_make.js_global "tag") + [{|a\n|}; " b"] + [Js_exp_make.small_int 1] + in + (match tagged.expression_desc with + | Tagged_template (_, segments, [_]) -> + OUnit.assert_equal ~printer:Ext_obj.dump [{|a\n|}; " b"] segments + | _ -> + OUnit.assert_failure + "expected tagged templates to own their encoded segments"); + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {|tag`a\n${1} b`|} + (Js_dump.string_of_expression tagged) ); + ( "template line-ending semantics drive constant folding" >:: fun _ -> + let source = "a\r\nb" in + let template = template_literal source in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") "`a\r\nb`" + (Js_dump.string_of_expression template); + (match (Js_exp_make.string_length template).expression_desc with + | Number (Int {i = 3l}) -> () + | _ -> + OUnit.assert_failure + "expected template length to use normalized line endings"); + match + (Js_exp_make.string_equal template (Js_exp_make.str "a\nb")) + .expression_desc + with + | Bool true -> () + | _ -> + OUnit.assert_failure + "expected template equality to use normalized line endings" ); + ( "interpolated templates remain explicit in JavaScript IR" >:: fun _ -> + let segments = + [template_segment {|head\n\${literal}\`|}; template_segment "tail"] + in + let value = + Js_exp_make.string_append + (Js_exp_make.js_global "left") + (Js_exp_make.js_global "right") + in + let template = Js_exp_make.interpolated_template segments [value] in + (match template.expression_desc with + | Interpolated_template {segments = actual_segments; values = [_]} -> + OUnit.assert_equal ~printer:Ext_obj.dump segments actual_segments + | _ -> + OUnit.assert_failure + "expected an explicit JavaScript IR interpolation"); + OUnit.assert_equal ~printer:(Printf.sprintf "%S") + {|`head\n\${literal}\`${left + right}tail`|} + (Js_dump.string_of_expression template); + let nested_literal = template_literal {e|\${nested}\`|e} in + let flattened = + Js_exp_make.interpolated_template + [template_segment "head"; template_segment "tail"] + [nested_literal] + in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") + {e|`head\${nested}\`tail`|e} + (Js_dump.string_of_expression flattened); + let escaped_literal = template_literal {e|\x61|e} in + let canonicalized = + Js_exp_make.interpolated_template + [template_segment "head"; template_segment "tail"] + [escaped_literal] + in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") + {e|`head\x61tail`|e} + (Js_dump.string_of_expression canonicalized); + let boundary = + Js_exp_make.interpolated_template + [template_segment "$"; template_segment ""] + [template_literal "{x}"] + in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {e|`\${x}`|e} + (Js_dump.string_of_expression boundary); + let already_escaped_boundary = + Js_exp_make.interpolated_template + [template_segment "\\$"; template_segment ""] + [template_literal "{x}"] + in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {e|`\${x}`|e} + (Js_dump.string_of_expression already_escaped_boundary); + let null_digit_boundary = + Js_exp_make.interpolated_template + [template_segment "\\0"; template_segment ""] + [template_literal "1"] + in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {e|`\x001`|e} + (Js_dump.string_of_expression null_digit_boundary); + let escaped_slash_null_boundary = + Js_exp_make.interpolated_template + [template_segment "\\\\0"; template_segment ""] + [template_literal "1"] + in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {e|`\\01`|e} + (Js_dump.string_of_expression escaped_slash_null_boundary); + let line_ending_boundary = + Js_exp_make.interpolated_template + [template_segment "a\r"; template_segment "\nb"] + [template_literal ""] + in + OUnit.assert_equal ~printer:(Printf.sprintf "%S") {e|`a\n\nb`|e} + (Js_dump.string_of_expression line_ending_boundary) ); + ( "JavaScript references are not encoded as strings" >:: fun _ -> + let value = Js_exp_make.var (Ext_ident.create "value") in + (match (Js_exp_make.is_array value).expression_desc with + | Call + ( {expression_desc = Static_index (array, "isArray", None)}, + [argument], + _ ) -> + assert_js_global ~expected:"Array" array; + OUnit.assert_bool "expected the original argument" + (Js_analyzer.eq_expression value argument) + | _ -> OUnit.assert_failure "expected an Array.isArray call"); + (match + Js_exp_make.and_ + (Js_exp_make.is_array value) + (Js_exp_make.triple_equal value (Js_exp_make.str "literal")) + with + | {expression_desc = Bool false} -> () + | _ -> + OUnit.assert_failure + "expected Array.isArray simplification to remain active"); + let open Ast_untagged_variants.Dynamic_checks in + let date = Variant_runtime.Instance.Date in + assert_js_global ~expected:"Date" + (Js_exp_make.emit_check + (TagType (Variant_runtime.Untagged (InstanceType date)))); + match Js_exp_make.emit_check (IsInstanceOf (date, Expr value)) with + | {expression_desc = Bin (InstanceOf, argument, constructor)} -> + OUnit.assert_bool "expected the original argument" + (Js_analyzer.eq_expression value argument); + assert_js_global ~expected:"Date" constructor + | _ -> OUnit.assert_failure "expected an instanceof expression" ); + ( "semantic string equality folds directly" >:: fun _ -> + let assert_equal_result expected left right = + match (Js_exp_make.string_equal left right).expression_desc with + | Bool actual -> OUnit.assert_equal expected actual + | _ -> OUnit.assert_failure "expected folded string equality" + in + assert_equal_result true + (Js_exp_make.str "a\n😀") + (Js_exp_make.str "a\n😀"); + assert_equal_result false (Js_exp_make.str "a") (Js_exp_make.str "é"); + assert_equal_result true (Js_exp_make.str "a") + (template_literal {|\x61|}) ); + ( "UTF-16 length" >:: fun _ -> + assert_int_equal 0 (String_literal.utf16_length ""); + assert_int_equal 3 (String_literal.utf16_length "abc"); + assert_int_equal 1 (String_literal.utf16_length "é"); + assert_int_equal 2 (String_literal.utf16_length "😀"); + assert_int_equal 4 (String_literal.utf16_length "a😀b") ); + ( "codePointAt with UTF-16 indices" >:: fun _ -> + assert_code_point_at "a😀b" (-1) None; + assert_code_point_at "a😀b" 0 (Some 0x61); + assert_code_point_at "a😀b" 1 (Some 0x1f600); + assert_code_point_at "a😀b" 2 (Some 0xde00); + assert_code_point_at "a😀b" 3 (Some 0x62); + assert_code_point_at "a😀b" 4 None ); + ( "Lambda string length uses UTF-16 units" >:: fun _ -> + Lambda.prim ~primitive:Lambda.Pstringlength + ~args:[semantic_string "a😀b"] + Location.none + |> assert_lam_int 4 ); + ( "Lambda string indexing uses codePointAt semantics" >:: fun _ -> + Lambda.prim ~primitive:Lambda.Pstringrefs + ~args:[semantic_string "a😀b"; lam_int 1] + Location.none + |> assert_lam_char 0x1f600; + Lambda.prim ~primitive:Lambda.Pstringrefu + ~args:[semantic_string "a😀b"; lam_int 2] + Location.none + |> assert_lam_char 0xde00 ); + ( "JS string length uses UTF-16 units" >:: fun _ -> + match + (Js_exp_make.string_length (Js_exp_make.str "a😀b")).expression_desc + with + | J.Number (Js_op.Int {i}) -> + OUnit.assert_equal ~printer:Int32.to_string 4l i + | _ -> OUnit.assert_failure "expected a folded JavaScript integer" ); + ] diff --git a/tests/ounit_tests/ounit_tests_main.ml b/tests/ounit_tests/ounit_tests_main.ml index ebe2df98590..260c75e3482 100644 --- a/tests/ounit_tests/ounit_tests_main.ml +++ b/tests/ounit_tests/ounit_tests_main.ml @@ -12,11 +12,11 @@ let suites = Ounit_map_tests.suites; Ounit_hashtbl_tests.suites; Ounit_string_tests.suites; + Ounit_string_literal_tests.suites; Ounit_int_vec_tests.suites; Ounit_ident_mask_tests.suites; Ounit_lid_of_path_tests.suites; Ounit_utf8_test.suites; - Ounit_unicode_tests.suites; Ounit_util_tests.suites; Ounit_rec_check_tests.suites; Ounit_lambda_constant_tests.suites; @@ -29,6 +29,7 @@ let suites = Ounit_analysis_config_tests.suites; Ounit_analysis_references_tests.suites; Ounit_ffi_inclusion_tests.suites; + Ounit_gentype_tests.suites; ] let _ = OUnit.run_test_tt_main suites diff --git a/tests/ounit_tests/ounit_unicode_tests.ml b/tests/ounit_tests/ounit_unicode_tests.ml deleted file mode 100644 index f48c48bc08a..00000000000 --- a/tests/ounit_tests/ounit_unicode_tests.ml +++ /dev/null @@ -1,174 +0,0 @@ -let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: )) - -let ( =~ ) a b = OUnit.assert_equal ~cmp:Ext_string.equal a b - -(** Test for single line *) -let ( ==~ ) a b = - OUnit.assert_equal - (Ext_list.map - (Ast_utf8_string_interp.transform_test a - |> List.filter (fun x -> not @@ Ast_utf8_string_interp.empty_segment x)) - (fun ({start = {offset = a}; finish = {offset = b}; kind; content} : - Ast_utf8_string_interp.segment) - -> (a, b, kind, content))) - b - -let ( ==* ) a b = - let segments = - Ext_list.map - (Ast_utf8_string_interp.transform_test a - |> List.filter (fun x -> not @@ Ast_utf8_string_interp.empty_segment x)) - (fun ({ - start = {lnum = la; offset = a}; - finish = {lnum = lb; offset = b}; - kind; - content; - } : - Ast_utf8_string_interp.segment) - -> (la, a, lb, b, kind, content)) - in - OUnit.assert_equal segments b - -let var_paren : Ast_utf8_string_interp.kind = Var (2, -1) -let var : Ast_utf8_string_interp.kind = Var (1, 0) -let suites = - __FILE__ - >::: [ - (__LOC__ >:: fun _ -> Ast_utf8_string.transform_test {|x|} =~ {|x|}); - (__LOC__ >:: fun _ -> Ast_utf8_string.transform_test "a\nb" =~ {|a\nb|}); - (__LOC__ >:: fun _ -> Ast_utf8_string.transform_test "\\n" =~ "\\n"); - ( __LOC__ >:: fun _ -> - Ast_utf8_string.transform_test {|\h\e\l\lo \"world\"!|} - =~ {|\h\e\l\lo \"world\"!|} ); - ( __LOC__ >:: fun _ -> - Ast_utf8_string.transform_test "\\u{1d306}" =~ "\\u{1d306}" ); - ( __LOC__ >:: fun _ -> - Ast_utf8_string.transform_test "unicode escape: \\u{1d306}" - =~ "unicode escape: \\u{1d306}" ); - ( __LOC__ >:: fun _ -> - Ast_utf8_string.transform_test - "unicode escape: \\u{1d306} with suffix text" - =~ "unicode escape: \\u{1d306} with suffix text" ); - ( __LOC__ >:: fun _ -> - Ast_utf8_string.transform_test "\\\\\\b\\t\\n\\v\\f\\r\\0\\$" - =~ "\\\\\\b\\t\\n\\v\\f\\r\\0\\$" ); - ( __LOC__ >:: fun _ -> - match Ast_utf8_string.transform_test {|\|} with - | exception Ast_utf8_string.Error (offset, _) -> - OUnit.assert_equal offset 1 - | _ -> OUnit.assert_failure __LOC__ ); - ( __LOC__ >:: fun _ -> - match Ast_utf8_string.transform_test {|你\|} with - | exception Ast_utf8_string.Error (offset, _) -> - OUnit.assert_equal offset 2 - | _ -> OUnit.assert_failure __LOC__ ); - ( __LOC__ >:: fun _ -> - match Ast_utf8_string.transform_test {|你BuckleScript,好啊\uffff\|} with - | exception Ast_utf8_string.Error (offset, _) -> - OUnit.assert_equal offset 23 - | _ -> OUnit.assert_failure __LOC__ ); - ( __LOC__ >:: fun _ -> - match Ast_utf8_string.transform_test {js|\u{110000}|js} with - (* bigger than max valid unicode codepoint *) - | exception Ast_utf8_string.Error (offset, _) -> - OUnit.assert_equal offset 3 - | _ -> OUnit.assert_failure __LOC__ ); - ( __LOC__ >:: fun _ -> - match - Ast_utf8_string.transform_test - {js|\u{FFFFFFFFFFFFFFFFFFFFFFFFFFFFF}|js} - with - (* overflow *) - | exception Ast_utf8_string.Error (offset, _) -> - OUnit.assert_equal offset 3 - | _ -> OUnit.assert_failure __LOC__ ); - ( __LOC__ >:: fun _ -> - "hie $x hi 你好" - ==~ [ - (0, 4, String, "hie "); - (4, 6, var, "x"); - (6, 12, String, " hi 你好"); - ] ); - (__LOC__ >:: fun _ -> "x" ==~ [(0, 1, String, "x")]); - (__LOC__ >:: fun _ -> "" ==~ []); - (__LOC__ >:: fun _ -> "你好" ==~ [(0, 2, String, "你好")]); - ( __LOC__ >:: fun _ -> - "你好$x" ==~ [(0, 2, String, "你好"); (2, 4, var, "x")] ); - ( __LOC__ >:: fun _ -> - "你好$this" ==~ [(0, 2, String, "你好"); (2, 7, var, "this")] ); - ( __LOC__ >:: fun _ -> - "你好$(this)" ==~ [(0, 2, String, "你好"); (2, 9, var_paren, "this")]; - - "你好$this)" - ==~ [(0, 2, String, "你好"); (2, 7, var, "this"); (7, 8, String, ")")]; - {|\xff\xff你好 $x |} - ==~ [ - (0, 11, String, {|\xff\xff你好 |}); - (11, 13, var, "x"); - (13, 14, String, " "); - ]; - {|\xff\xff你好 $x 不吃亏了buckle $y $z = $sum|} - ==~ [ - (0, 11, String, {|\xff\xff你好 |}); - (11, 13, var, "x"); - (13, 25, String, {| 不吃亏了buckle |}); - (25, 27, var, "y"); - (27, 28, String, " "); - (28, 30, var, "z"); - (30, 33, String, " = "); - (33, 37, var, "sum"); - ] ); - ( __LOC__ >:: fun _ -> - "你好 $(this_is_a_var) x" - ==~ [ - (0, 3, String, "你好 "); - (3, 19, var_paren, "this_is_a_var"); - (19, 22, String, " x"); - ] ); - ( __LOC__ >:: fun _ -> - "hi\n$x\n" - ==* [ - (0, 0, 1, 0, String, "hi\\n"); - (1, 0, 1, 2, var, "x"); - (1, 2, 2, 0, String, "\\n"); - ]; - "$x" ==* [(0, 0, 0, 2, var, "x")]; - - "\n$x\n" - ==* [ - (0, 0, 1, 0, String, "\\n"); - (1, 0, 1, 2, var, "x"); - (1, 2, 2, 0, String, "\\n"); - ] ); - ( __LOC__ >:: fun _ -> - "\n$(x_this_is_cool) " - ==* [ - (0, 0, 1, 0, String, "\\n"); - (1, 0, 1, 17, var_paren, "x_this_is_cool"); - (1, 17, 1, 18, String, " "); - ] ); - ( __LOC__ >:: fun _ -> - " $x + $y = $sum " - ==* [ - (0, 0, 0, 1, String, " "); - (0, 1, 0, 3, var, "x"); - (0, 3, 0, 6, String, " + "); - (0, 6, 0, 8, var, "y"); - (0, 8, 0, 11, String, " = "); - (0, 11, 0, 15, var, "sum"); - (0, 15, 0, 16, String, " "); - ] ); - ( __LOC__ >:: fun _ -> - "中文 | $a " - ==* [ - (0, 0, 0, 5, String, "中文 | "); - (0, 5, 0, 7, var, "a"); - (0, 7, 0, 8, String, " "); - ] ); - ( __LOC__ >:: fun _ -> - {|Hello \\$world|} - ==* [(0, 0, 0, 8, String, "Hello \\\\"); (0, 8, 0, 14, var, "world")] - ); - ( __LOC__ >:: fun _ -> - {|$x)|} ==* [(0, 0, 0, 2, var, "x"); (0, 2, 0, 3, String, ")")] ); - ] diff --git a/tests/ounit_tests/ounit_utf8_test.ml b/tests/ounit_tests/ounit_utf8_test.ml index b94babc4ea1..d68790464bd 100644 --- a/tests/ounit_tests/ounit_utf8_test.ml +++ b/tests/ounit_tests/ounit_utf8_test.ml @@ -30,6 +30,17 @@ let suites = 105; ] ); (__LOC__ >:: fun _ -> Ext_utf8.decode_utf8_string "" =~ []); + ( "reject malformed UTF-8" >:: fun _ -> + List.iter + (fun input -> + OUnit.assert_raises + (Ext_utf8.Invalid_utf8 "Invalid UTF-8 sequence") (fun () -> + ignore (Ext_utf8.decode_utf8_string input))) + ["\xc0\x80"; "\xed\xa0\x80"; "\xf4\x90\x80\x80"] ); + ( "escape malformed UTF-8 in JavaScript strings" >:: fun _ -> + Js_dump_string.escape_to_string + "\xc0\x80\xed\xa0\x80\xf4\x90\x80\x80" + =~ {|"\xc0\x80\xed\xa0\x80\xf4\x90\x80\x80"|} ); ( __LOC__ >:: fun _ -> Code_frame.break_long_line 4 "abc—def" =~ ["abc—"; "def"] ); ] diff --git a/tests/syntax_tests/data/ast-mapping/TemplateExpressions.res b/tests/syntax_tests/data/ast-mapping/TemplateExpressions.res new file mode 100644 index 00000000000..7080900a2ec --- /dev/null +++ b/tests/syntax_tests/data/ast-mapping/TemplateExpressions.res @@ -0,0 +1,6 @@ +// Round-trip coverage for ordinary and tagged templates through the +// Parsetree0 bridge (ast_mapper_to0 / ast_mapper_from0). + +let value = "world" +let ordinary = `hello ${value}\n` +let tagged = tag`raw \unicode ${value}\x61` diff --git a/tests/syntax_tests/data/ast-mapping/expected/TemplateExpressions.res.txt b/tests/syntax_tests/data/ast-mapping/expected/TemplateExpressions.res.txt new file mode 100644 index 00000000000..7080900a2ec --- /dev/null +++ b/tests/syntax_tests/data/ast-mapping/expected/TemplateExpressions.res.txt @@ -0,0 +1,6 @@ +// Round-trip coverage for ordinary and tagged templates through the +// Parsetree0 bridge (ast_mapper_to0 / ast_mapper_from0). + +let value = "world" +let ordinary = `hello ${value}\n` +let tagged = tag`raw \unicode ${value}\x61` diff --git a/tests/syntax_tests/data/conversion/reason/expected/string.res.txt b/tests/syntax_tests/data/conversion/reason/expected/string.res.txt index 30bf3f0c2ab..045fa042a98 100644 --- a/tests/syntax_tests/data/conversion/reason/expected/string.res.txt +++ b/tests/syntax_tests/data/conversion/reason/expected/string.res.txt @@ -30,7 +30,7 @@ let var1 = "three" let var2 = "a string" switch (var1, var2) { -| (`3`, `a string`) => Console.log("worked") -| (` test with \` \${here} \``, _) => Console.log("escapes ` and ${") +| ("3", "a string") => Console.log("worked") +| (" test with ` ${here} `", _) => Console.log("escapes ` and ${") | _ => Console.log("didn't match") } diff --git a/tests/syntax_tests/data/parsing/errors/expressions/expected/ifLet.res.txt b/tests/syntax_tests/data/parsing/errors/expressions/expected/ifLet.res.txt index 873f9faa1b1..7c23f147c2a 100644 --- a/tests/syntax_tests/data/parsing/errors/expressions/expected/ifLet.res.txt +++ b/tests/syntax_tests/data/parsing/errors/expressions/expected/ifLet.res.txt @@ -37,11 +37,12 @@ switch result { ;;((match result with | Some x -> Console.log {js|The sky is blue|js} - | _ -> ())[@res.iflet ][@warning "-4"]) + | _ -> ())[@res.iflet ][@warning {js|-4|js}]) ;;((match result with | Error x -> Console.log {js|The sky is red|js} | _ -> (((match result with | Ok y -> Console.log {js|The sky is blue|js} | _ -> ())) - [@res.iflet ][@warning "-4"]))[@res.iflet ][@warning "-4"]) \ No newline at end of file + [@res.iflet ][@warning {js|-4|js}])) + [@res.iflet ][@warning {js|-4|js}]) \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateEmptyInterpolation.res.txt b/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateEmptyInterpolation.res.txt index dd4580b5fea..43c07a7a7ad 100644 --- a/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateEmptyInterpolation.res.txt +++ b/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateEmptyInterpolation.res.txt @@ -6,8 +6,4 @@ It seems that this expression block is empty -let q = - ((sql - [|(({js|SELECT * FROM |js})[@res.template ]);(({js||js}) - [@res.template ])|] [|([%rescript.exprhole ])|]) - [@res.taggedTemplate ]) \ No newline at end of file +let q = sql`SELECT * FROM ${[%rescript.exprhole ]}` \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateLiterals.res.txt b/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateLiterals.res.txt index 6abb32886f6..1f13389a9ac 100644 --- a/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateLiterals.res.txt +++ b/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateLiterals.res.txt @@ -7,4 +7,4 @@ Tagged template literals are currently restricted to names like: myTagFunction`foo ${bar}`. -;;(({js|null|js})[@res.template ]) \ No newline at end of file +;;`null` \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateUnclosed.res.txt b/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateUnclosed.res.txt index 4daa96c6b4c..5a6538d6a9a 100644 --- a/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateUnclosed.res.txt +++ b/tests/syntax_tests/data/parsing/errors/expressions/expected/taggedTemplateUnclosed.res.txt @@ -6,8 +6,4 @@ Did you forget to close this template expression with a backtick? -let q = - ((sql - [|(({js|SELECT * FROM users WHERE id = |js}) - [@res.template ]);(({js||js})[@res.template ])|] [|id|]) - [@res.taggedTemplate ]) \ No newline at end of file +let q = sql`SELECT * FROM users WHERE id = ${id}` \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/pattern/expected/templateLiteral.res.txt b/tests/syntax_tests/data/parsing/errors/pattern/expected/templateLiteral.res.txt index 380027d9ba3..0bb2635e691 100644 --- a/tests/syntax_tests/data/parsing/errors/pattern/expected/templateLiteral.res.txt +++ b/tests/syntax_tests/data/parsing/errors/pattern/expected/templateLiteral.res.txt @@ -35,7 +35,4 @@ String interpolation is not supported in pattern matching. let zeroCoord = {js|0.0|js} -;;match l with - | (("")[@res.template ]) -> () - | (("")[@res.template ]) -> () - | _ -> () \ No newline at end of file +;;match l with | {js||js} -> () | {js||js} -> () | _ -> () \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/scanner/expected/invalidSurrogatePair.res.txt b/tests/syntax_tests/data/parsing/errors/scanner/expected/invalidSurrogatePair.res.txt index e49dc6d3b49..f2b6f9082db 100644 --- a/tests/syntax_tests/data/parsing/errors/scanner/expected/invalidSurrogatePair.res.txt +++ b/tests/syntax_tests/data/parsing/errors/scanner/expected/invalidSurrogatePair.res.txt @@ -1,46 +1,8 @@ Syntax error! - syntax_tests/data/parsing/errors/scanner/invalidSurrogatePair.res:3:35-40 + syntax_tests/data/parsing/errors/scanner/invalidSurrogatePair.res:5:18-25 - 1 │ /* Known bug: this valid JavaScript surrogate pair is rejected as two in - │ valid - 2 │ standalone surrogate escapes. */ - 3 │ let validPairCurrentlyRejected = "\uD83D\uDE00" - 4 │ - 5 │ let malformed = "\uD83D\uZZZZ" - - escape sequence is invalid unicode code point - - - Syntax error! - syntax_tests/data/parsing/errors/scanner/invalidSurrogatePair.res:3:41-46 - - 1 │ /* Known bug: this valid JavaScript surrogate pair is rejected as two in - │ valid - 2 │ standalone surrogate escapes. */ - 3 │ let validPairCurrentlyRejected = "\uD83D\uDE00" - 4 │ - 5 │ let malformed = "\uD83D\uZZZZ" - - escape sequence is invalid unicode code point - - - Syntax error! - syntax_tests/data/parsing/errors/scanner/invalidSurrogatePair.res:5:18-23 - - 3 │ let validPairCurrentlyRejected = "\uD83D\uDE00" - 4 │ - 5 │ let malformed = "\uD83D\uZZZZ" - 6 │ let after = 1 - 7 │ - - escape sequence is invalid unicode code point - - - Syntax error! - syntax_tests/data/parsing/errors/scanner/invalidSurrogatePair.res:5:24-25 - - 3 │ let validPairCurrentlyRejected = "\uD83D\uDE00" + 3 │ let validPair = "\uD83D\uDE00" 4 │ 5 │ let malformed = "\uD83D\uZZZZ" 6 │ let after = 1 @@ -48,6 +10,6 @@ unknown escape sequence -let validPairCurrentlyRejected = {js|\uD83D\uDE00|js} +let validPair = {js|\uD83D\uDE00|js} let malformed = {js|\uD83D\uZZZZ|js} let after = 1 \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/scanner/invalidSurrogatePair.res b/tests/syntax_tests/data/parsing/errors/scanner/invalidSurrogatePair.res index 4f8a5bee55a..e64c85d6a63 100644 --- a/tests/syntax_tests/data/parsing/errors/scanner/invalidSurrogatePair.res +++ b/tests/syntax_tests/data/parsing/errors/scanner/invalidSurrogatePair.res @@ -1,6 +1,6 @@ -/* Known bug: this valid JavaScript surrogate pair is rejected as two invalid - standalone surrogate escapes. */ -let validPairCurrentlyRejected = "\uD83D\uDE00" +/* A valid JavaScript surrogate pair must not be rejected along with the + malformed escape below. */ +let validPair = "\uD83D\uDE00" let malformed = "\uD83D\uZZZZ" let after = 1 diff --git a/tests/syntax_tests/data/parsing/errors/structure/expected/gh16B.res.txt b/tests/syntax_tests/data/parsing/errors/structure/expected/gh16B.res.txt index 2deda092e0b..9ccd682f928 100644 --- a/tests/syntax_tests/data/parsing/errors/structure/expected/gh16B.res.txt +++ b/tests/syntax_tests/data/parsing/errors/structure/expected/gh16B.res.txt @@ -14,17 +14,10 @@ open Ws let wss = Server.make { port = 82 } let address = wss -> Server.address -let log [arity:1]msg = - Console.log - (((((({js|> Server: |js})[@res.template ]) ++ msg)[@res.template ]) ++ - (({js||js})[@res.template ]))[@res.template ]) +let log [arity:1]msg = Console.log (`> Server: ${msg}`) ;;log - (((((((((((((({js|Running on: |js})[@res.template ]) ++ address.address) - [@res.template ]) ++ (({js|:|js})[@res.template ])) - [@res.template ]) ++ (address.port -> string_of_int)) - [@res.template ]) ++ (({js| (|js})[@res.template ])) - [@res.template ]) ++ address.family) - [@res.template ]) ++ (({js|)|js})[@res.template ]))[@res.template ]) + (`Running on: ${address.address}:${address.port -> string_of_int} (${ + address.family})`) module ClientSet = struct module T = diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/block.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/block.res.txt index 2c8fc40923a..509028d0e0e 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/block.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/block.res.txt @@ -51,9 +51,10 @@ let reifyStyle (type a) [arity:1](x : 'a) = external canvasGradient : constructor = "CanvasGradient"[@@val ] external canvasPattern : constructor = "CanvasPattern"[@@val ] let instanceOf = - ([%raw - (({js|function(x,y) {return +(x instanceof y)}|js}) - [@res.template ])] : 'a -> constructor -> bool (a:2)) + ([%raw `function(x,y) {return +(x instanceof y)}`] : 'a -> + constructor + -> + bool (a:2)) end in ((if (typeof x) == {js|string|js} then Obj.magic String diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/constants.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/constants.res.txt index dac7ad468e5..d42b6cb01fe 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/constants.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/constants.res.txt @@ -3,12 +3,11 @@ let y = false let txt = {js|a string|js} let txtWithEscapedChar = {js|foo\nbar|js} let number = 1 -let template = (({js|amazing +let template = `amazing multine template string -|js}) - [@res.template ]) +` let complexNumber = 1.6 let x = 0b0000_0001 let int32 = 42l @@ -46,7 +45,7 @@ let x = '\t' let x = '\b' let x = '\r' let x = ' ' -let x = '\170' +let x = '\xAA' let () = ((getResult (); (-10))[@res.braces ]) let x = {js|foo\0bar|js} let x = {js|foo\x0Abar|js} diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/dict.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/dict.res.txt index 59bf2a29da8..922e373c2e6 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/dict.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/dict.res.txt @@ -1,19 +1,22 @@ let x = Primitive_dict.make [||] -let x = Primitive_dict.make [|("foo", {js|bar|js})|] -let x = Primitive_dict.make [|("foo", {js|bar|js});("bar", {js|baz|js})|] +let x = Primitive_dict.make [|({js|foo|js}, {js|bar|js})|] +let x = + Primitive_dict.make + [|({js|foo|js}, {js|bar|js});({js|bar|js}, {js|baz|js})|] let baz = {js|foo|js} let x = Primitive_dict.make - [|("foo", {js|bar|js});("bar", {js|baz|js});("baz", baz)|] -let foo = Primitive_dict.make [|("a", 1)|] -let qux = Primitive_dict.make [|("c", 3)|] + [|({js|foo|js}, {js|bar|js});({js|bar|js}, {js|baz|js});({js|baz|js}, + baz)|] +let foo = Primitive_dict.make [|({js|a|js}, 1)|] +let qux = Primitive_dict.make [|({js|c|js}, 3)|] let x = ((Primitive_dict.spread)[@res.dictSpread ]) (Primitive_dict.make [||]) - [|foo;(Primitive_dict.make [|("bar", 2)|]);qux|] + [|foo;(Primitive_dict.make [|({js|bar|js}, 2)|]);qux|] let x = ((Primitive_dict.spread)[@res.dictSpread ]) - (Primitive_dict.make [|("before", 1)|]) - [|foo;(Primitive_dict.make [|("after", 2)|])|] + (Primitive_dict.make [|({js|before|js}, 1)|]) + [|foo;(Primitive_dict.make [|({js|after|js}, 2)|])|] let x = ((Primitive_dict.spread)[@res.dictSpread ]) (Primitive_dict.make [||]) [|foo|] \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/es6template.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/es6template.res.txt index f88334a2e2d..1de94e6031a 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/es6template.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/es6template.res.txt @@ -1,81 +1,24 @@ -let s = (({js|foo|js})[@res.template ]) -let s = (({js|multi +let s = `foo` +let s = `multi line string -|js})[@res.template ]) -let s = - (((((({js||js})[@res.template ]) ++ foo)[@res.template ]) ++ (({js||js}) - [@res.template ])) - [@res.template ]) -let s = - (((((({js|before|js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js||js})[@res.template ])) - [@res.template ]) -let s = - (((((({js|before |js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js||js})[@res.template ])) - [@res.template ]) -let s = - (((((({js|before |js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js||js})[@res.template ])) - [@res.template ]) -let s = - (((((({js||js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js|after|js})[@res.template ])) - [@res.template ]) -let s = - (((((({js||js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js| after|js})[@res.template ])) - [@res.template ]) -let s = - (((((({js||js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js| after|js})[@res.template ])) - [@res.template ]) -let s = - (((((((((({js||js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js||js})[@res.template ])) - [@res.template ]) ++ bar) - [@res.template ]) ++ (({js||js})[@res.template ])) - [@res.template ]) -let s = - (((((((((((((({js||js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js||js})[@res.template ])) - [@res.template ]) ++ bar) - [@res.template ]) ++ (({js||js})[@res.template ])) - [@res.template ]) ++ baz) - [@res.template ]) ++ (({js||js})[@res.template ])) - [@res.template ]) -let s = - (((((((((({js||js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js| |js})[@res.template ])) - [@res.template ]) ++ bar) - [@res.template ]) ++ (({js||js})[@res.template ])) - [@res.template ]) -let s = - (((((((((((((({js||js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js| |js})[@res.template ])) - [@res.template ]) ++ bar) - [@res.template ]) ++ (({js| |js})[@res.template ])) - [@res.template ]) ++ baz) - [@res.template ]) ++ (({js||js})[@res.template ])) - [@res.template ]) -let s = - (((((((((({js| before |js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js| |js})[@res.template ])) - [@res.template ]) ++ bar) - [@res.template ]) ++ (({js| after |js})[@res.template ])) - [@res.template ]) -let s = - (((((((((((((({js|before |js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js| middle |js})[@res.template ])) - [@res.template ]) ++ bar) - [@res.template ]) ++ (({js| |js})[@res.template ])) - [@res.template ]) ++ baz) - [@res.template ]) ++ (({js| wow |js})[@res.template ])) - [@res.template ]) -let s = - (({js| +` +let s = `${foo}` +let s = `before${foo}` +let s = `before ${foo}` +let s = `before ${foo}` +let s = `${foo}after` +let s = `${foo} after` +let s = `${foo} after` +let s = `${foo}${bar}` +let s = `${foo}${bar}${baz}` +let s = `${foo} ${bar}` +let s = `${foo} ${bar} ${baz}` +let s = ` before ${foo} ${bar} after ` +let s = `before ${foo} middle ${bar} ${baz} wow ` +let s = + ` multiline es6 @@ -87,21 +30,13 @@ let s = so convenient :) -|js}) - [@res.template ]) -let s = (({js|$dollar without $braces $interpolation|js})[@res.template ]) -let s = (({json|null|json})[@res.template ]) -let x = (({js|foo\`bar\$\\foo|js})[@res.template ]) -let x = - (((((((((({js|foo\`bar\$\\foo|js})[@res.template ]) ++ a)[@res.template ]) - ++ (({js| \` |js})[@res.template ])) - [@res.template ]) ++ b) - [@res.template ]) ++ (({js| \` xx|js})[@res.template ])) - [@res.template ]) -let thisIsFine = (({js|$something|js})[@res.template ]) -let thisIsAlsoFine = (({js|fine\$|js})[@res.template ]) -let isThisFine = (({js|shouldBeFine$|js})[@res.template ]) -;;(((((({js|$|js})[@res.template ]) ++ dollarAmountInt)[@res.template ]) ++ - (({js||js})[@res.template ]))[@res.template ]) -;;(((((({js|\$|js})[@res.template ]) ++ dollarAmountInt)[@res.template ]) ++ - (({js||js})[@res.template ]))[@res.template ]) \ No newline at end of file +` +let s = `$dollar without $braces $interpolation` +let s = {json|null|json} +let x = `foo\`bar\$\\foo` +let x = `foo\`bar\$\\foo${a} \` ${b} \` xx` +let thisIsFine = `$something` +let thisIsAlsoFine = `fine\$` +let isThisFine = `shouldBeFine$` +;;`$${dollarAmountInt}` +;;`\$${dollarAmountInt}` \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt index b288bdd2241..a7fbed342b3 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt @@ -231,9 +231,7 @@ let _ =
((ReasonReact.string {js|BugTest|js})[@res.braces ])
let _ =
((let left = limit -> Int.toString in - (((((({js||js})[@res.template ]) ++ left)[@res.template ]) ++ - (({js| characters left|js})[@res.template ])) - [@res.template ]) -> React.string) + (`${left} characters left`) -> React.string) [@res.braces ])
let _ = ((let uri = diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/parenthesized.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/parenthesized.res.txt index 10fb595328b..58624cdfbb2 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/parenthesized.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/parenthesized.res.txt @@ -5,10 +5,7 @@ let truth = false let constructor = None let longidentConstructor = Option.None let txt = {js|a string|js} -let otherTxt = - (((((({js|foo bar |js})[@res.template ]) ++ txt)[@res.template ]) ++ - (({js||js})[@res.template ])) - [@res.template ]) +let otherTxt = `foo bar ${txt}` let ident = myIdent let aList = [1; 2] let anArray = [|1;2|] diff --git a/tests/syntax_tests/data/parsing/grammar/pattern/expected/constant.res.txt b/tests/syntax_tests/data/parsing/grammar/pattern/expected/constant.res.txt index b2b2a4193cf..ee5896002b0 100644 --- a/tests/syntax_tests/data/parsing/grammar/pattern/expected/constant.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/pattern/expected/constant.res.txt @@ -69,29 +69,17 @@ let (-1)..(-1.) = x | exception 19.34 -> true | _ -> false ;;match literal with - | (({js|literal|js})[@res.template ]) -> true - | ((({js|literal1|js})[@res.template ]), - (({js|literal2|js})[@res.template ])) -> true - | [|(({js|literal1|js})[@res.template ]);(({js|literal2|js})[@res.template - ])|] - -> true - | (({js|literal1|js})[@res.template ])::(({js|literal2|js})[@res.template ])::[] - -> true - | { x = (({js|literal1|js})[@res.template ]); - y = (({js|literal2|js})[@res.template ]) } -> true - | Constructor - ((({js|literal1|js})[@res.template ]), - (({js|literal2|js})[@res.template ])) - -> true - | `Constuctor - ((({js|literal1|js})[@res.template ]), - (({js|literal2|js})[@res.template ])) - -> true - | (({js|literal|js})[@res.template ]) as x -> true - | (({js|literal|js})[@res.template ])|(({js|literal|js})[@res.template ]) - -> true - | ((({js|literal|js})[@res.template ]) : string) -> true - | exception (({js|literal|js})[@res.template ]) -> true + | {js|literal|js} -> true + | ({js|literal1|js}, {js|literal2|js}) -> true + | [|{js|literal1|js};{js|literal2|js}|] -> true + | {js|literal1|js}::{js|literal2|js}::[] -> true + | { x = {js|literal1|js}; y = {js|literal2|js} } -> true + | Constructor ({js|literal1|js}, {js|literal2|js}) -> true + | `Constuctor ({js|literal1|js}, {js|literal2|js}) -> true + | {js|literal|js} as x -> true + | {js|literal|js}|{js|literal|js} -> true + | ({js|literal|js} : string) -> true + | exception {js|literal|js} -> true | _ -> false -let (({js|literal constant|js})[@res.template ]) = x -;;for (({js|literal constant|js})[@res.template ]) = 0 to 10 do () done \ No newline at end of file +let {js|literal constant|js} = x +;;for {js|literal constant|js} = 0 to 10 do () done \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/pattern/expected/dict.res.txt b/tests/syntax_tests/data/parsing/grammar/pattern/expected/dict.res.txt index 65e911c9ed5..bd1a60053ce 100644 --- a/tests/syntax_tests/data/parsing/grammar/pattern/expected/dict.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/pattern/expected/dict.res.txt @@ -1,4 +1,4 @@ -let someDict = Primitive_dict.make [|("one", {js|one|js})|] +let someDict = Primitive_dict.make [|({js|one|js}, {js|one|js})|] let (({ one?;_})[@res.dictPattern ]) = someDict let foo [arity:1]() = match someDict with @@ -26,6 +26,4 @@ let decodeUser [arity:1](json : json) = } | _ -> (Console.log {js|Not an object.|js}; None)) [@res.braces ]) : user option) -;;Console.log - (decodeUser - (jsonParse (({js|{"name": "John", "age": 30}|js})[@res.template ]))) \ No newline at end of file +;;Console.log (decodeUser (jsonParse (`{"name": "John", "age": 30}`))) \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/typexpr/expected/polyVariant.res.txt b/tests/syntax_tests/data/parsing/grammar/typexpr/expected/polyVariant.res.txt index 92547ca6c68..76351a9f8d4 100644 --- a/tests/syntax_tests/data/parsing/grammar/typexpr/expected/polyVariant.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/typexpr/expected/polyVariant.res.txt @@ -14,9 +14,10 @@ type nonrec t = [ ListStyleType.t] type nonrec number = [ `1 | `42 | `4244 ] type nonrec complexNumbericPolyVar = [ `1 of string | `2 of (int * string) ] type nonrec withDocComments = - [ `Foo [@res.doc " First variant "] | `Bar [@res.doc " Second variant "] - | `Baz of (int * string) [@res.doc " Third variant with args "]] -type nonrec singleDocComment = [ `Only [@res.doc " Single variant "]] + [ `Foo [@res.doc {js| First variant |js}] + | `Bar [@res.doc {js| Second variant |js}] + | `Baz of (int * string) [@res.doc {js| Third variant with args |js}]] +type nonrec singleDocComment = [ `Only [@res.doc {js| Single variant |js}]] type nonrec mixedDocComments = - [ `NoComment | `WithComment [@res.doc " With comment "] + [ `NoComment | `WithComment [@res.doc {js| With comment |js}] | `AnotherNoComment ] \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/infiniteLoops/expected/nonRecTypes.res.txt b/tests/syntax_tests/data/parsing/infiniteLoops/expected/nonRecTypes.res.txt index fd7bd340e3b..f2578d1058a 100644 --- a/tests/syntax_tests/data/parsing/infiniteLoops/expected/nonRecTypes.res.txt +++ b/tests/syntax_tests/data/parsing/infiniteLoops/expected/nonRecTypes.res.txt @@ -71,7 +71,7 @@ include mutable size: int ; mutable root: 'value node option ; compare: [ [%rescript.typehole ]] Function.fn } - ;;(({js|Arity_2('value, 'value)], int), + ;;`Arity_2('value, 'value)], int), }; }: { @@ -82,8 +82,7 @@ include ( ~size: int, ~root: option(node('value)), - ~compare: Function.fn([ | |js}) - [@res.template ]) + ~compare: Function.fn([ | ` ;;Arity_2 (value, value) ;;int ;;(t value) = {js||js} @@ -109,12 +108,11 @@ include [@ocaml.deprecated ])|] external compare : 'value t -> [ [%rescript.typehole ]] Function.fn (a:1) - ;;(({js|Arity_2('value, 'value)], int) = + ;;`Arity_2('value, 'value)], int) = "" "BS:6.0.1\x84\x95\xa6\xbe\0\0\0\x13\0\0\0\x07\0\0\0\x14\0\0\0\x13\xb0\xa0\xa0A\x91@@A\x98\xa0'compare@"; external compareGet: - t('value) => Function.fn([ | |js}) - [@res.template ]) + t('value) => Function.fn([ | ` ;;Arity_2 (value, value) ;;int ;;{js||js} diff --git a/tests/syntax_tests/data/parsing/infiniteLoops/expected/templateEof.res.txt b/tests/syntax_tests/data/parsing/infiniteLoops/expected/templateEof.res.txt index 0843aef50a0..d9254826214 100644 --- a/tests/syntax_tests/data/parsing/infiniteLoops/expected/templateEof.res.txt +++ b/tests/syntax_tests/data/parsing/infiniteLoops/expected/templateEof.res.txt @@ -19,6 +19,4 @@ String interpolation is not supported in pattern matching. ;;et -;;foo = - (fun [arity:1]x -> - match x with | (("")[@res.template ]) -> [%rescript.exprhole ]) \ No newline at end of file +;;foo = (fun [arity:1]x -> match x with | {js||js} -> [%rescript.exprhole ]) \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/other/expected/docComments.res.txt b/tests/syntax_tests/data/parsing/other/expected/docComments.res.txt index 004126c18d8..0d84968f651 100644 --- a/tests/syntax_tests/data/parsing/other/expected/docComments.res.txt +++ b/tests/syntax_tests/data/parsing/other/expected/docComments.res.txt @@ -1,11 +1,11 @@ -[@@@res.doc " This is a module comment "] -[@@@res.doc " This is another module comment "] -let z = 34[@@res.doc " This is a doc \226\156\133 comment "] +[@@@res.doc {js| This is a module comment |js}] +[@@@res.doc {js| This is another module comment |js}] +let z = 34[@@res.doc {js| This is a doc ✅ comment |js}] [@@@res.doc {js|And this is a res.doc module annotation|js}] let q = 11[@@res.doc {js|And this is a res.doc ✅ annotation|js}] type nonrec h = int[@@res.doc - " This\n * is a multi-line\n multiline doc comment\n "] + {js| This\n * is a multi-line\n multiline doc comment\n |js}] type nonrec pathItem = { } and operation = { - }[@@res.doc " Issue 6844: doc comment before \"and\" "] \ No newline at end of file + }[@@res.doc {js| Issue 6844: doc comment before \"and\" |js}] \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/other/expected/stringLiterals.res.txt b/tests/syntax_tests/data/parsing/other/expected/stringLiterals.res.txt index 99be7cf952e..95962cd2f78 100644 --- a/tests/syntax_tests/data/parsing/other/expected/stringLiterals.res.txt +++ b/tests/syntax_tests/data/parsing/other/expected/stringLiterals.res.txt @@ -1,28 +1,15 @@ let s = {js|some unicode é £ |js} let s = match foo with - | (({js|bar|js})[@res.template ]) -> {js|bar|js} + | {js|bar|js} -> {js|bar|js} | {js|foo|js} -> {js|foo|js} | _ -> {js|baz|js} -let s = (({js|你好， -世界|js})[@res.template ]) -let s = (({js|"|js})[@res.template ]) -let s = (({js|foo|js})[@res.template ]) -let s = - (((((({js|foo |js})[@res.template ]) ++ bar)[@res.template ]) ++ - (({js| baz|js})[@res.template ])) - [@res.template ]) -let s = - (((((({js|some unicode é |js})[@res.template ]) ++ bar)[@res.template ]) - ++ (({js| £ |js})[@res.template ])) - [@res.template ]) -let s = ((x [|(({js|foo|js})[@res.template ])|] [||])[@res.taggedTemplate ]) -let s = - ((x [|(({js|foo |js})[@res.template ]);(({js| baz|js})[@res.template ])|] - [|bar|]) - [@res.taggedTemplate ]) -let s = - ((x - [|(({js|some unicode é |js})[@res.template ]);(({js| £ |js}) - [@res.template ])|] [|bar|]) - [@res.taggedTemplate ]) \ No newline at end of file +let s = `你好， +世界` +let s = `"` +let s = `foo` +let s = `foo ${bar} baz` +let s = `some unicode é ${bar} £ ` +let s = x`foo` +let s = x`foo ${bar} baz` +let s = x`some unicode é ${bar} £ ` \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/recovery/string/expected/es6template.res.txt b/tests/syntax_tests/data/parsing/recovery/string/expected/es6template.res.txt index 7885495f7fc..571b646db14 100644 --- a/tests/syntax_tests/data/parsing/recovery/string/expected/es6template.res.txt +++ b/tests/syntax_tests/data/parsing/recovery/string/expected/es6template.res.txt @@ -7,7 +7,4 @@ Did you forget to close this template expression with a backtick? -let x = - (((((({js|this contains |js})[@res.template ]) ++ foo)[@res.template ]) ++ - (({js|, missing closing|js})[@res.template ])) - [@res.template ]) \ No newline at end of file +let x = `this contains ${foo}, missing closing` \ No newline at end of file diff --git a/tests/syntax_tests/data/ppx/react/expected/fileLevelConfig.res.txt b/tests/syntax_tests/data/ppx/react/expected/fileLevelConfig.res.txt index a3c987f1e98..2cd52b3ac31 100644 --- a/tests/syntax_tests/data/ppx/react/expected/fileLevelConfig.res.txt +++ b/tests/syntax_tests/data/ppx/react/expected/fileLevelConfig.res.txt @@ -6,10 +6,10 @@ module V4A = { msg: 'msg, } - let make = ({msg, _}: props<_>): Pre\x61ct.element => { - Pre\x61ct.Elements.jsx("div", {children: ?Pre\x61ct.Elements.someElement({msg->React.string})}) + let make = ({msg, _}: props<_>): Preact.element => { + Preact.Elements.jsx("div", {children: ?Preact.Elements.someElement({msg->React.string})}) } - let make = Pre\x61ct.component({ + let make = Preact.component({ let \"FileLevelConfig$V4A" = (props: props<_>) => make(props) \"FileLevelConfig$V4A" diff --git a/tests/syntax_tests/data/printer/expr/expected/rawSourceDelimiter.res.txt b/tests/syntax_tests/data/printer/expr/expected/rawSourceDelimiter.res.txt new file mode 100644 index 00000000000..3d7d22ca825 --- /dev/null +++ b/tests/syntax_tests/data/printer/expr/expected/rawSourceDelimiter.res.txt @@ -0,0 +1,2 @@ +let value = %raw("const template = `value`; +template") diff --git a/tests/syntax_tests/data/printer/expr/rawSourceDelimiter.res b/tests/syntax_tests/data/printer/expr/rawSourceDelimiter.res new file mode 100644 index 00000000000..3d7d22ca825 --- /dev/null +++ b/tests/syntax_tests/data/printer/expr/rawSourceDelimiter.res @@ -0,0 +1,2 @@ +let value = %raw("const template = `value`; +template") diff --git a/tests/syntax_tests/data/printer/pattern/expected/constant.res.txt b/tests/syntax_tests/data/printer/pattern/expected/constant.res.txt index bd3f68f3092..4112135deca 100644 --- a/tests/syntax_tests/data/printer/pattern/expected/constant.res.txt +++ b/tests/syntax_tests/data/printer/pattern/expected/constant.res.txt @@ -39,22 +39,22 @@ switch science { switch literal { -| `literal` => true -| (`literal1`, `literal2`) => true -| [`literal1`, `literal2`] => true -| list{`literal1`, `literal2`} => true -| {x: `literal1`, y: `literal2`} => true -| Constructor(`literal1`, `literal2`) => true -| #Constuctor(`literal1`, `literal2`) => true -| `literal` as x => true -| `literal` | `literal` => true -| (`literal`: string) => true -| exception `literal` => true +| "literal" => true +| ("literal1", "literal2") => true +| ["literal1", "literal2"] => true +| list{"literal1", "literal2"} => true +| {x: "literal1", y: "literal2"} => true +| Constructor("literal1", "literal2") => true +| #Constuctor("literal1", "literal2") => true +| "literal" as x => true +| "literal" | "literal" => true +| ("literal": string) => true +| exception "literal" => true | _ => false } -let `literal constant` = x +let "literal constant" = x -for `literal constant` in 0 to 10 { +for "literal constant" in 0 to 10 { () } diff --git a/tests/syntax_tests/res_utf8_test.ml b/tests/syntax_tests/res_utf8_test.ml index da061aa6a71..14240ce9607 100644 --- a/tests/syntax_tests/res_utf8_test.ml +++ b/tests/syntax_tests/res_utf8_test.ml @@ -36,10 +36,12 @@ let utf8_code_point_tests = {codepoint = 0xFFFD; str = "\xef\xbf\xbd"; size = 3}; |] -let surrogate_range = +let invalid_utf8 = [| + {codepoint = 0xFFFD; str = "\xc0\x80"; size = 1}; {codepoint = 0xFFFD; str = "\xed\xa0\x80"; size = 1}; {codepoint = 0xFFFD; str = "\xed\xbf\xbf"; size = 1}; + {codepoint = 0xFFFD; str = "\xf4\x90\x80\x80"; size = 1}; |] let test_decode () = @@ -51,14 +53,14 @@ let test_decode () = assert (size = t.size)) utf8_code_point_tests -let test_decode_surrogate_range () = +let test_decode_invalid_utf8 () = Array.iter (fun t -> let len = String.length t.str in let codepoint, size = Res_utf8.decode_code_point 0 t.str len in assert (codepoint = t.codepoint); assert (size = t.size)) - surrogate_range + invalid_utf8 let test_encode () = Array.iter @@ -88,7 +90,7 @@ let test_is_valid_code_point () = let run () = test_decode (); - test_decode_surrogate_range (); + test_decode_invalid_utf8 (); test_encode (); test_is_valid_code_point (); print_endline "✅ utf8 tests" diff --git a/tests/tests/src/AsInUncurriedExternals.mjs b/tests/tests/src/AsInUncurriedExternals.mjs index 3dc77f67a08..9af4134fcfe 100644 --- a/tests/tests/src/AsInUncurriedExternals.mjs +++ b/tests/tests/src/AsInUncurriedExternals.mjs @@ -21,7 +21,7 @@ function shouldNotFail(objectMode, name) { let x = somescope.somefn({foo:true}); -let y = somescope.stringfn(`\x61\u0062`); +let y = somescope.stringfn("ab"); export { mo, diff --git a/tests/tests/src/ImportAttributes.mjs b/tests/tests/src/ImportAttributes.mjs index 996a8cdafc0..3489b095473 100644 --- a/tests/tests/src/ImportAttributes.mjs +++ b/tests/tests/src/ImportAttributes.mjs @@ -1,7 +1,7 @@ // Generated by ReScript, PLEASE EDIT WITH CARE -import * as MyCssCss from "./myCss.css" with {"type": "c\\x73s", "some-identifier": "y\\x65p"}; -import MyJsonJson from "./myJson.json" with {"type": "j\\x73on", "some-identifier": "y\\x65p"}; +import * as MyCssCss from "./myCss.css" with {"type": "css", "some-identifier": "yep"}; +import MyJsonJson from "./myJson.json" with {"type": "json", "some-identifier": "yep"}; let myJson = MyJsonJson; diff --git a/tests/tests/src/alias_default_value_test.mjs b/tests/tests/src/alias_default_value_test.mjs index e6024d44a48..1541a25702d 100644 --- a/tests/tests/src/alias_default_value_test.mjs +++ b/tests/tests/src/alias_default_value_test.mjs @@ -75,7 +75,7 @@ function Alias_default_value_test$C7(props) { count !== 2 ? count.toString() + " times" : "twice" ) : "once"; let name = username !== undefined && username !== "" ? username : "Anonymous"; - return `Hello ` + name + `, you clicked me ` + times; + return `Hello ${name}, you clicked me ` + times; } let C7 = { diff --git a/tests/tests/src/alias_test.mjs b/tests/tests/src/alias_test.mjs index 6acee1073b6..8fdc9da69c1 100644 --- a/tests/tests/src/alias_test.mjs +++ b/tests/tests/src/alias_test.mjs @@ -3,16 +3,14 @@ let a10 = "hello world"; -let a20 = a10 + "not"; +let a20 = "hello worldnot"; let v = a20[0] === "h" ? 1 : 2; -let a21 = a20 + a20; - -let a22 = "test " + (a21 + "hello"); +let a21 = "hello worldnothello worldnot"; function ff() { - return "cool " + a22; + return "cool test hello worldnothello worldnothello"; } let a23 = ff(); diff --git a/tests/tests/src/big_polyvar_test.mjs b/tests/tests/src/big_polyvar_test.mjs index 7a170c28ed1..1cfdd7542e2 100644 --- a/tests/tests/src/big_polyvar_test.mjs +++ b/tests/tests/src/big_polyvar_test.mjs @@ -23,3606 +23,6 @@ function eq(x, y) { } } -if ("variant0" !== "variant0") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 314, - 0 - ], - Error: new Error() - }; -} - -if ("variant1" !== "variant1") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 315, - 0 - ], - Error: new Error() - }; -} - -if ("variant2" !== "variant2") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 316, - 0 - ], - Error: new Error() - }; -} - -if ("variant3" !== "variant3") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 317, - 0 - ], - Error: new Error() - }; -} - -if ("variant4" !== "variant4") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 318, - 0 - ], - Error: new Error() - }; -} - -if ("variant5" !== "variant5") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 319, - 0 - ], - Error: new Error() - }; -} - -if ("variant6" !== "variant6") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 320, - 0 - ], - Error: new Error() - }; -} - -if ("variant7" !== "variant7") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 321, - 0 - ], - Error: new Error() - }; -} - -if ("variant8" !== "variant8") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 322, - 0 - ], - Error: new Error() - }; -} - -if ("variant9" !== "variant9") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 323, - 0 - ], - Error: new Error() - }; -} - -if ("variant10" !== "variant10") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 324, - 0 - ], - Error: new Error() - }; -} - -if ("variant11" !== "variant11") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 325, - 0 - ], - Error: new Error() - }; -} - -if ("variant12" !== "variant12") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 326, - 0 - ], - Error: new Error() - }; -} - -if ("variant13" !== "variant13") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 327, - 0 - ], - Error: new Error() - }; -} - -if ("variant14" !== "variant14") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 328, - 0 - ], - Error: new Error() - }; -} - -if ("variant15" !== "variant15") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 329, - 0 - ], - Error: new Error() - }; -} - -if ("variant16" !== "variant16") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 330, - 0 - ], - Error: new Error() - }; -} - -if ("variant17" !== "variant17") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 331, - 0 - ], - Error: new Error() - }; -} - -if ("variant18" !== "variant18") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 332, - 0 - ], - Error: new Error() - }; -} - -if ("variant19" !== "variant19") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 333, - 0 - ], - Error: new Error() - }; -} - -if ("variant20" !== "variant20") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 334, - 0 - ], - Error: new Error() - }; -} - -if ("variant21" !== "variant21") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 335, - 0 - ], - Error: new Error() - }; -} - -if ("variant22" !== "variant22") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 336, - 0 - ], - Error: new Error() - }; -} - -if ("variant23" !== "variant23") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 337, - 0 - ], - Error: new Error() - }; -} - -if ("variant24" !== "variant24") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 338, - 0 - ], - Error: new Error() - }; -} - -if ("variant25" !== "variant25") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 339, - 0 - ], - Error: new Error() - }; -} - -if ("variant26" !== "variant26") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 340, - 0 - ], - Error: new Error() - }; -} - -if ("variant27" !== "variant27") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 341, - 0 - ], - Error: new Error() - }; -} - -if ("variant28" !== "variant28") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 342, - 0 - ], - Error: new Error() - }; -} - -if ("variant29" !== "variant29") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 343, - 0 - ], - Error: new Error() - }; -} - -if ("variant30" !== "variant30") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 344, - 0 - ], - Error: new Error() - }; -} - -if ("variant31" !== "variant31") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 345, - 0 - ], - Error: new Error() - }; -} - -if ("variant32" !== "variant32") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 346, - 0 - ], - Error: new Error() - }; -} - -if ("variant33" !== "variant33") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 347, - 0 - ], - Error: new Error() - }; -} - -if ("variant34" !== "variant34") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 348, - 0 - ], - Error: new Error() - }; -} - -if ("variant35" !== "variant35") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 349, - 0 - ], - Error: new Error() - }; -} - -if ("variant36" !== "variant36") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 350, - 0 - ], - Error: new Error() - }; -} - -if ("variant37" !== "variant37") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 351, - 0 - ], - Error: new Error() - }; -} - -if ("variant38" !== "variant38") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 352, - 0 - ], - Error: new Error() - }; -} - -if ("variant39" !== "variant39") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 353, - 0 - ], - Error: new Error() - }; -} - -if ("variant40" !== "variant40") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 354, - 0 - ], - Error: new Error() - }; -} - -if ("variant41" !== "variant41") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 355, - 0 - ], - Error: new Error() - }; -} - -if ("variant42" !== "variant42") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 356, - 0 - ], - Error: new Error() - }; -} - -if ("variant43" !== "variant43") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 357, - 0 - ], - Error: new Error() - }; -} - -if ("variant44" !== "variant44") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 358, - 0 - ], - Error: new Error() - }; -} - -if ("variant45" !== "variant45") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 359, - 0 - ], - Error: new Error() - }; -} - -if ("variant46" !== "variant46") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 360, - 0 - ], - Error: new Error() - }; -} - -if ("variant47" !== "variant47") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 361, - 0 - ], - Error: new Error() - }; -} - -if ("variant48" !== "variant48") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 362, - 0 - ], - Error: new Error() - }; -} - -if ("variant49" !== "variant49") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 363, - 0 - ], - Error: new Error() - }; -} - -if ("variant50" !== "variant50") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 364, - 0 - ], - Error: new Error() - }; -} - -if ("variant51" !== "variant51") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 365, - 0 - ], - Error: new Error() - }; -} - -if ("variant52" !== "variant52") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 366, - 0 - ], - Error: new Error() - }; -} - -if ("variant53" !== "variant53") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 367, - 0 - ], - Error: new Error() - }; -} - -if ("variant54" !== "variant54") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 368, - 0 - ], - Error: new Error() - }; -} - -if ("variant55" !== "variant55") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 369, - 0 - ], - Error: new Error() - }; -} - -if ("variant56" !== "variant56") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 370, - 0 - ], - Error: new Error() - }; -} - -if ("variant57" !== "variant57") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 371, - 0 - ], - Error: new Error() - }; -} - -if ("variant58" !== "variant58") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 372, - 0 - ], - Error: new Error() - }; -} - -if ("variant59" !== "variant59") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 373, - 0 - ], - Error: new Error() - }; -} - -if ("variant60" !== "variant60") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 374, - 0 - ], - Error: new Error() - }; -} - -if ("variant61" !== "variant61") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 375, - 0 - ], - Error: new Error() - }; -} - -if ("variant62" !== "variant62") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 376, - 0 - ], - Error: new Error() - }; -} - -if ("variant63" !== "variant63") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 377, - 0 - ], - Error: new Error() - }; -} - -if ("variant64" !== "variant64") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 378, - 0 - ], - Error: new Error() - }; -} - -if ("variant65" !== "variant65") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 379, - 0 - ], - Error: new Error() - }; -} - -if ("variant66" !== "variant66") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 380, - 0 - ], - Error: new Error() - }; -} - -if ("variant67" !== "variant67") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 381, - 0 - ], - Error: new Error() - }; -} - -if ("variant68" !== "variant68") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 382, - 0 - ], - Error: new Error() - }; -} - -if ("variant69" !== "variant69") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 383, - 0 - ], - Error: new Error() - }; -} - -if ("variant70" !== "variant70") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 384, - 0 - ], - Error: new Error() - }; -} - -if ("variant71" !== "variant71") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 385, - 0 - ], - Error: new Error() - }; -} - -if ("variant72" !== "variant72") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 386, - 0 - ], - Error: new Error() - }; -} - -if ("variant73" !== "variant73") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 387, - 0 - ], - Error: new Error() - }; -} - -if ("variant74" !== "variant74") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 388, - 0 - ], - Error: new Error() - }; -} - -if ("variant75" !== "variant75") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 389, - 0 - ], - Error: new Error() - }; -} - -if ("variant76" !== "variant76") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 390, - 0 - ], - Error: new Error() - }; -} - -if ("variant77" !== "variant77") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 391, - 0 - ], - Error: new Error() - }; -} - -if ("variant78" !== "variant78") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 392, - 0 - ], - Error: new Error() - }; -} - -if ("variant79" !== "variant79") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 393, - 0 - ], - Error: new Error() - }; -} - -if ("variant80" !== "variant80") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 394, - 0 - ], - Error: new Error() - }; -} - -if ("variant81" !== "variant81") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 395, - 0 - ], - Error: new Error() - }; -} - -if ("variant82" !== "variant82") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 396, - 0 - ], - Error: new Error() - }; -} - -if ("variant83" !== "variant83") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 397, - 0 - ], - Error: new Error() - }; -} - -if ("variant84" !== "variant84") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 398, - 0 - ], - Error: new Error() - }; -} - -if ("variant85" !== "variant85") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 399, - 0 - ], - Error: new Error() - }; -} - -if ("variant86" !== "variant86") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 400, - 0 - ], - Error: new Error() - }; -} - -if ("variant87" !== "variant87") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 401, - 0 - ], - Error: new Error() - }; -} - -if ("variant88" !== "variant88") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 402, - 0 - ], - Error: new Error() - }; -} - -if ("variant89" !== "variant89") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 403, - 0 - ], - Error: new Error() - }; -} - -if ("variant90" !== "variant90") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 404, - 0 - ], - Error: new Error() - }; -} - -if ("variant91" !== "variant91") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 405, - 0 - ], - Error: new Error() - }; -} - -if ("variant92" !== "variant92") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 406, - 0 - ], - Error: new Error() - }; -} - -if ("variant93" !== "variant93") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 407, - 0 - ], - Error: new Error() - }; -} - -if ("variant94" !== "variant94") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 408, - 0 - ], - Error: new Error() - }; -} - -if ("variant95" !== "variant95") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 409, - 0 - ], - Error: new Error() - }; -} - -if ("variant96" !== "variant96") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 410, - 0 - ], - Error: new Error() - }; -} - -if ("variant97" !== "variant97") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 411, - 0 - ], - Error: new Error() - }; -} - -if ("variant98" !== "variant98") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 412, - 0 - ], - Error: new Error() - }; -} - -if ("variant99" !== "variant99") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 413, - 0 - ], - Error: new Error() - }; -} - -if ("variant100" !== "variant100") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 414, - 0 - ], - Error: new Error() - }; -} - -if ("variant101" !== "variant101") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 415, - 0 - ], - Error: new Error() - }; -} - -if ("variant102" !== "variant102") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 416, - 0 - ], - Error: new Error() - }; -} - -if ("variant103" !== "variant103") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 417, - 0 - ], - Error: new Error() - }; -} - -if ("variant104" !== "variant104") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 418, - 0 - ], - Error: new Error() - }; -} - -if ("variant105" !== "variant105") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 419, - 0 - ], - Error: new Error() - }; -} - -if ("variant106" !== "variant106") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 420, - 0 - ], - Error: new Error() - }; -} - -if ("variant107" !== "variant107") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 421, - 0 - ], - Error: new Error() - }; -} - -if ("variant108" !== "variant108") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 422, - 0 - ], - Error: new Error() - }; -} - -if ("variant109" !== "variant109") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 423, - 0 - ], - Error: new Error() - }; -} - -if ("variant110" !== "variant110") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 424, - 0 - ], - Error: new Error() - }; -} - -if ("variant111" !== "variant111") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 425, - 0 - ], - Error: new Error() - }; -} - -if ("variant112" !== "variant112") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 426, - 0 - ], - Error: new Error() - }; -} - -if ("variant113" !== "variant113") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 427, - 0 - ], - Error: new Error() - }; -} - -if ("variant114" !== "variant114") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 428, - 0 - ], - Error: new Error() - }; -} - -if ("variant115" !== "variant115") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 429, - 0 - ], - Error: new Error() - }; -} - -if ("variant116" !== "variant116") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 430, - 0 - ], - Error: new Error() - }; -} - -if ("variant117" !== "variant117") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 431, - 0 - ], - Error: new Error() - }; -} - -if ("variant118" !== "variant118") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 432, - 0 - ], - Error: new Error() - }; -} - -if ("variant119" !== "variant119") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 433, - 0 - ], - Error: new Error() - }; -} - -if ("variant120" !== "variant120") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 434, - 0 - ], - Error: new Error() - }; -} - -if ("variant121" !== "variant121") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 435, - 0 - ], - Error: new Error() - }; -} - -if ("variant122" !== "variant122") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 436, - 0 - ], - Error: new Error() - }; -} - -if ("variant123" !== "variant123") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 437, - 0 - ], - Error: new Error() - }; -} - -if ("variant124" !== "variant124") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 438, - 0 - ], - Error: new Error() - }; -} - -if ("variant125" !== "variant125") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 439, - 0 - ], - Error: new Error() - }; -} - -if ("variant126" !== "variant126") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 440, - 0 - ], - Error: new Error() - }; -} - -if ("variant127" !== "variant127") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 441, - 0 - ], - Error: new Error() - }; -} - -if ("variant128" !== "variant128") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 442, - 0 - ], - Error: new Error() - }; -} - -if ("variant129" !== "variant129") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 443, - 0 - ], - Error: new Error() - }; -} - -if ("variant130" !== "variant130") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 444, - 0 - ], - Error: new Error() - }; -} - -if ("variant131" !== "variant131") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 445, - 0 - ], - Error: new Error() - }; -} - -if ("variant132" !== "variant132") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 446, - 0 - ], - Error: new Error() - }; -} - -if ("variant133" !== "variant133") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 447, - 0 - ], - Error: new Error() - }; -} - -if ("variant134" !== "variant134") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 448, - 0 - ], - Error: new Error() - }; -} - -if ("variant135" !== "variant135") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 449, - 0 - ], - Error: new Error() - }; -} - -if ("variant136" !== "variant136") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 450, - 0 - ], - Error: new Error() - }; -} - -if ("variant137" !== "variant137") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 451, - 0 - ], - Error: new Error() - }; -} - -if ("variant138" !== "variant138") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 452, - 0 - ], - Error: new Error() - }; -} - -if ("variant139" !== "variant139") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 453, - 0 - ], - Error: new Error() - }; -} - -if ("variant140" !== "variant140") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 454, - 0 - ], - Error: new Error() - }; -} - -if ("variant141" !== "variant141") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 455, - 0 - ], - Error: new Error() - }; -} - -if ("variant142" !== "variant142") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 456, - 0 - ], - Error: new Error() - }; -} - -if ("variant143" !== "variant143") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 457, - 0 - ], - Error: new Error() - }; -} - -if ("variant144" !== "variant144") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 458, - 0 - ], - Error: new Error() - }; -} - -if ("variant145" !== "variant145") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 459, - 0 - ], - Error: new Error() - }; -} - -if ("variant146" !== "variant146") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 460, - 0 - ], - Error: new Error() - }; -} - -if ("variant147" !== "variant147") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 461, - 0 - ], - Error: new Error() - }; -} - -if ("variant148" !== "variant148") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 462, - 0 - ], - Error: new Error() - }; -} - -if ("variant149" !== "variant149") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 463, - 0 - ], - Error: new Error() - }; -} - -if ("variant150" !== "variant150") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 464, - 0 - ], - Error: new Error() - }; -} - -if ("variant151" !== "variant151") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 465, - 0 - ], - Error: new Error() - }; -} - -if ("variant152" !== "variant152") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 466, - 0 - ], - Error: new Error() - }; -} - -if ("variant153" !== "variant153") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 467, - 0 - ], - Error: new Error() - }; -} - -if ("variant154" !== "variant154") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 468, - 0 - ], - Error: new Error() - }; -} - -if ("variant155" !== "variant155") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 469, - 0 - ], - Error: new Error() - }; -} - -if ("variant156" !== "variant156") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 470, - 0 - ], - Error: new Error() - }; -} - -if ("variant157" !== "variant157") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 471, - 0 - ], - Error: new Error() - }; -} - -if ("variant158" !== "variant158") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 472, - 0 - ], - Error: new Error() - }; -} - -if ("variant159" !== "variant159") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 473, - 0 - ], - Error: new Error() - }; -} - -if ("variant160" !== "variant160") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 474, - 0 - ], - Error: new Error() - }; -} - -if ("variant161" !== "variant161") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 475, - 0 - ], - Error: new Error() - }; -} - -if ("variant162" !== "variant162") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 476, - 0 - ], - Error: new Error() - }; -} - -if ("variant163" !== "variant163") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 477, - 0 - ], - Error: new Error() - }; -} - -if ("variant164" !== "variant164") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 478, - 0 - ], - Error: new Error() - }; -} - -if ("variant165" !== "variant165") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 479, - 0 - ], - Error: new Error() - }; -} - -if ("variant166" !== "variant166") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 480, - 0 - ], - Error: new Error() - }; -} - -if ("variant167" !== "variant167") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 481, - 0 - ], - Error: new Error() - }; -} - -if ("variant168" !== "variant168") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 482, - 0 - ], - Error: new Error() - }; -} - -if ("variant169" !== "variant169") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 483, - 0 - ], - Error: new Error() - }; -} - -if ("variant170" !== "variant170") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 484, - 0 - ], - Error: new Error() - }; -} - -if ("variant171" !== "variant171") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 485, - 0 - ], - Error: new Error() - }; -} - -if ("variant172" !== "variant172") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 486, - 0 - ], - Error: new Error() - }; -} - -if ("variant173" !== "variant173") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 487, - 0 - ], - Error: new Error() - }; -} - -if ("variant174" !== "variant174") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 488, - 0 - ], - Error: new Error() - }; -} - -if ("variant175" !== "variant175") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 489, - 0 - ], - Error: new Error() - }; -} - -if ("variant176" !== "variant176") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 490, - 0 - ], - Error: new Error() - }; -} - -if ("variant177" !== "variant177") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 491, - 0 - ], - Error: new Error() - }; -} - -if ("variant178" !== "variant178") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 492, - 0 - ], - Error: new Error() - }; -} - -if ("variant179" !== "variant179") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 493, - 0 - ], - Error: new Error() - }; -} - -if ("variant180" !== "variant180") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 494, - 0 - ], - Error: new Error() - }; -} - -if ("variant181" !== "variant181") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 495, - 0 - ], - Error: new Error() - }; -} - -if ("variant182" !== "variant182") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 496, - 0 - ], - Error: new Error() - }; -} - -if ("variant183" !== "variant183") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 497, - 0 - ], - Error: new Error() - }; -} - -if ("variant184" !== "variant184") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 498, - 0 - ], - Error: new Error() - }; -} - -if ("variant185" !== "variant185") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 499, - 0 - ], - Error: new Error() - }; -} - -if ("variant186" !== "variant186") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 500, - 0 - ], - Error: new Error() - }; -} - -if ("variant187" !== "variant187") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 501, - 0 - ], - Error: new Error() - }; -} - -if ("variant188" !== "variant188") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 502, - 0 - ], - Error: new Error() - }; -} - -if ("variant189" !== "variant189") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 503, - 0 - ], - Error: new Error() - }; -} - -if ("variant190" !== "variant190") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 504, - 0 - ], - Error: new Error() - }; -} - -if ("variant191" !== "variant191") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 505, - 0 - ], - Error: new Error() - }; -} - -if ("variant192" !== "variant192") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 506, - 0 - ], - Error: new Error() - }; -} - -if ("variant193" !== "variant193") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 507, - 0 - ], - Error: new Error() - }; -} - -if ("variant194" !== "variant194") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 508, - 0 - ], - Error: new Error() - }; -} - -if ("variant195" !== "variant195") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 509, - 0 - ], - Error: new Error() - }; -} - -if ("variant196" !== "variant196") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 510, - 0 - ], - Error: new Error() - }; -} - -if ("variant197" !== "variant197") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 511, - 0 - ], - Error: new Error() - }; -} - -if ("variant198" !== "variant198") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 512, - 0 - ], - Error: new Error() - }; -} - -if ("variant199" !== "variant199") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 513, - 0 - ], - Error: new Error() - }; -} - -if ("variant200" !== "variant200") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 514, - 0 - ], - Error: new Error() - }; -} - -if ("variant201" !== "variant201") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 515, - 0 - ], - Error: new Error() - }; -} - -if ("variant202" !== "variant202") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 516, - 0 - ], - Error: new Error() - }; -} - -if ("variant203" !== "variant203") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 517, - 0 - ], - Error: new Error() - }; -} - -if ("variant204" !== "variant204") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 518, - 0 - ], - Error: new Error() - }; -} - -if ("variant205" !== "variant205") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 519, - 0 - ], - Error: new Error() - }; -} - -if ("variant206" !== "variant206") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 520, - 0 - ], - Error: new Error() - }; -} - -if ("variant207" !== "variant207") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 521, - 0 - ], - Error: new Error() - }; -} - -if ("variant208" !== "variant208") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 522, - 0 - ], - Error: new Error() - }; -} - -if ("variant209" !== "variant209") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 523, - 0 - ], - Error: new Error() - }; -} - -if ("variant210" !== "variant210") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 524, - 0 - ], - Error: new Error() - }; -} - -if ("variant211" !== "variant211") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 525, - 0 - ], - Error: new Error() - }; -} - -if ("variant212" !== "variant212") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 526, - 0 - ], - Error: new Error() - }; -} - -if ("variant213" !== "variant213") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 527, - 0 - ], - Error: new Error() - }; -} - -if ("variant214" !== "variant214") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 528, - 0 - ], - Error: new Error() - }; -} - -if ("variant215" !== "variant215") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 529, - 0 - ], - Error: new Error() - }; -} - -if ("variant216" !== "variant216") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 530, - 0 - ], - Error: new Error() - }; -} - -if ("variant217" !== "variant217") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 531, - 0 - ], - Error: new Error() - }; -} - -if ("variant218" !== "variant218") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 532, - 0 - ], - Error: new Error() - }; -} - -if ("variant219" !== "variant219") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 533, - 0 - ], - Error: new Error() - }; -} - -if ("variant220" !== "variant220") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 534, - 0 - ], - Error: new Error() - }; -} - -if ("variant221" !== "variant221") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 535, - 0 - ], - Error: new Error() - }; -} - -if ("variant222" !== "variant222") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 536, - 0 - ], - Error: new Error() - }; -} - -if ("variant223" !== "variant223") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 537, - 0 - ], - Error: new Error() - }; -} - -if ("variant224" !== "variant224") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 538, - 0 - ], - Error: new Error() - }; -} - -if ("variant225" !== "variant225") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 539, - 0 - ], - Error: new Error() - }; -} - -if ("variant226" !== "variant226") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 540, - 0 - ], - Error: new Error() - }; -} - -if ("variant227" !== "variant227") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 541, - 0 - ], - Error: new Error() - }; -} - -if ("variant228" !== "variant228") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 542, - 0 - ], - Error: new Error() - }; -} - -if ("variant229" !== "variant229") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 543, - 0 - ], - Error: new Error() - }; -} - -if ("variant230" !== "variant230") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 544, - 0 - ], - Error: new Error() - }; -} - -if ("variant231" !== "variant231") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 545, - 0 - ], - Error: new Error() - }; -} - -if ("variant232" !== "variant232") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 546, - 0 - ], - Error: new Error() - }; -} - -if ("variant233" !== "variant233") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 547, - 0 - ], - Error: new Error() - }; -} - -if ("variant234" !== "variant234") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 548, - 0 - ], - Error: new Error() - }; -} - -if ("variant235" !== "variant235") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 549, - 0 - ], - Error: new Error() - }; -} - -if ("variant236" !== "variant236") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 550, - 0 - ], - Error: new Error() - }; -} - -if ("variant237" !== "variant237") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 551, - 0 - ], - Error: new Error() - }; -} - -if ("variant238" !== "variant238") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 552, - 0 - ], - Error: new Error() - }; -} - -if ("variant239" !== "variant239") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 553, - 0 - ], - Error: new Error() - }; -} - -if ("variant240" !== "variant240") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 554, - 0 - ], - Error: new Error() - }; -} - -if ("variant241" !== "variant241") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 555, - 0 - ], - Error: new Error() - }; -} - -if ("variant242" !== "variant242") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 556, - 0 - ], - Error: new Error() - }; -} - -if ("variant243" !== "variant243") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 557, - 0 - ], - Error: new Error() - }; -} - -if ("variant244" !== "variant244") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 558, - 0 - ], - Error: new Error() - }; -} - -if ("variant245" !== "variant245") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 559, - 0 - ], - Error: new Error() - }; -} - -if ("variant246" !== "variant246") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 560, - 0 - ], - Error: new Error() - }; -} - -if ("variant247" !== "variant247") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 561, - 0 - ], - Error: new Error() - }; -} - -if ("variant248" !== "variant248") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 562, - 0 - ], - Error: new Error() - }; -} - -if ("variant249" !== "variant249") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 563, - 0 - ], - Error: new Error() - }; -} - -if ("variant250" !== "variant250") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 564, - 0 - ], - Error: new Error() - }; -} - -if ("variant251" !== "variant251") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 565, - 0 - ], - Error: new Error() - }; -} - -if ("variant252" !== "variant252") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 566, - 0 - ], - Error: new Error() - }; -} - -if ("variant253" !== "variant253") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 567, - 0 - ], - Error: new Error() - }; -} - -if ("variant254" !== "variant254") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 568, - 0 - ], - Error: new Error() - }; -} - -if ("variant255" !== "variant255") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 569, - 0 - ], - Error: new Error() - }; -} - -if ("variant256" !== "variant256") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 570, - 0 - ], - Error: new Error() - }; -} - -if ("variant257" !== "variant257") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 571, - 0 - ], - Error: new Error() - }; -} - -if ("variant258" !== "variant258") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 572, - 0 - ], - Error: new Error() - }; -} - -if ("variant259" !== "variant259") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 573, - 0 - ], - Error: new Error() - }; -} - -if ("variant260" !== "variant260") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 574, - 0 - ], - Error: new Error() - }; -} - -if ("variant261" !== "variant261") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 575, - 0 - ], - Error: new Error() - }; -} - -if ("variant262" !== "variant262") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 576, - 0 - ], - Error: new Error() - }; -} - -if ("variant263" !== "variant263") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 577, - 0 - ], - Error: new Error() - }; -} - -if ("variant264" !== "variant264") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 578, - 0 - ], - Error: new Error() - }; -} - -if ("variant265" !== "variant265") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 579, - 0 - ], - Error: new Error() - }; -} - -if ("variant266" !== "variant266") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 580, - 0 - ], - Error: new Error() - }; -} - -if ("variant267" !== "variant267") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 581, - 0 - ], - Error: new Error() - }; -} - -if ("variant268" !== "variant268") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 582, - 0 - ], - Error: new Error() - }; -} - -if ("variant269" !== "variant269") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 583, - 0 - ], - Error: new Error() - }; -} - -if ("variant270" !== "variant270") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 584, - 0 - ], - Error: new Error() - }; -} - -if ("variant271" !== "variant271") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 585, - 0 - ], - Error: new Error() - }; -} - -if ("variant272" !== "variant272") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 586, - 0 - ], - Error: new Error() - }; -} - -if ("variant273" !== "variant273") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 587, - 0 - ], - Error: new Error() - }; -} - -if ("variant274" !== "variant274") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 588, - 0 - ], - Error: new Error() - }; -} - -if ("variant275" !== "variant275") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 589, - 0 - ], - Error: new Error() - }; -} - -if ("variant276" !== "variant276") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 590, - 0 - ], - Error: new Error() - }; -} - -if ("variant277" !== "variant277") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 591, - 0 - ], - Error: new Error() - }; -} - -if ("variant278" !== "variant278") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 592, - 0 - ], - Error: new Error() - }; -} - -if ("variant279" !== "variant279") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 593, - 0 - ], - Error: new Error() - }; -} - -if ("variant280" !== "variant280") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 594, - 0 - ], - Error: new Error() - }; -} - -if ("variant281" !== "variant281") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 595, - 0 - ], - Error: new Error() - }; -} - -if ("variant282" !== "variant282") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 596, - 0 - ], - Error: new Error() - }; -} - -if ("variant283" !== "variant283") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 597, - 0 - ], - Error: new Error() - }; -} - -if ("variant284" !== "variant284") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 598, - 0 - ], - Error: new Error() - }; -} - -if ("variant285" !== "variant285") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 599, - 0 - ], - Error: new Error() - }; -} - -if ("variant286" !== "variant286") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 600, - 0 - ], - Error: new Error() - }; -} - -if ("variant287" !== "variant287") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 601, - 0 - ], - Error: new Error() - }; -} - -if ("variant288" !== "variant288") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 602, - 0 - ], - Error: new Error() - }; -} - -if ("variant289" !== "variant289") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 603, - 0 - ], - Error: new Error() - }; -} - -if ("variant290" !== "variant290") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 604, - 0 - ], - Error: new Error() - }; -} - -if ("variant291" !== "variant291") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 605, - 0 - ], - Error: new Error() - }; -} - -if ("variant292" !== "variant292") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 606, - 0 - ], - Error: new Error() - }; -} - -if ("variant293" !== "variant293") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 607, - 0 - ], - Error: new Error() - }; -} - -if ("variant294" !== "variant294") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 608, - 0 - ], - Error: new Error() - }; -} - -if ("variant295" !== "variant295") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 609, - 0 - ], - Error: new Error() - }; -} - -if ("variant296" !== "variant296") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 610, - 0 - ], - Error: new Error() - }; -} - -if ("variant297" !== "variant297") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 611, - 0 - ], - Error: new Error() - }; -} - -if ("variant298" !== "variant298") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 612, - 0 - ], - Error: new Error() - }; -} - -if ("variant299" !== "variant299") { - throw { - RE_EXN_ID: "Assert_failure", - _1: [ - "big_polyvar_test.res", - 613, - 0 - ], - Error: new Error() - }; -} - if (!eq(tFromJs("variant0"), "variant0")) { throw { RE_EXN_ID: "Assert_failure", diff --git a/tests/tests/src/external_ppx2.mjs b/tests/tests/src/external_ppx2.mjs index ab97a23df55..2750b0ae0d5 100644 --- a/tests/tests/src/external_ppx2.mjs +++ b/tests/tests/src/external_ppx2.mjs @@ -1,9 +1,9 @@ // Generated by ReScript, PLEASE EDIT WITH CARE -f("\h\e\l\lo", 42); +f("hello", 42); -let x = "\h\e\l\lo"; +let x = "hello"; let y; diff --git a/tests/tests/src/gpr_3142_test.mjs b/tests/tests/src/gpr_3142_test.mjs index 5ebfd7fea98..caf342f862d 100644 --- a/tests/tests/src/gpr_3142_test.mjs +++ b/tests/tests/src/gpr_3142_test.mjs @@ -3,9 +3,9 @@ import * as Mocha from "mocha"; import * as Test_utils from "./test_utils.mjs"; -let _map = {"a":"x","u":"hi","b":"你","c":"我","d":"\x64","e":"\u0065"}; +let _map = {"a":"x","u":"hi","b":"你","c":"我","d":"d","e":"e"}; -let _revMap = {"x":"a","hi":"u","你":"b","我":"c","\x64":"d","\u0065":"e"}; +let _revMap = {"x":"a","hi":"u","你":"b","我":"c","d":"d","e":"e"}; function tToJs(param) { return _map[param]; diff --git a/tests/tests/src/inline_condition_with_pattern_matching.mjs b/tests/tests/src/inline_condition_with_pattern_matching.mjs index a013e290e94..dfc175147fc 100644 --- a/tests/tests/src/inline_condition_with_pattern_matching.mjs +++ b/tests/tests/src/inline_condition_with_pattern_matching.mjs @@ -29,22 +29,22 @@ let person2 = { let message$1; if (person2.TAG === "Teacher") { - message$1 = `Hello ` + "Jane" + `.`; + message$1 = `Hello Jane.`; } else { let name = "Jane"; let match = person2.reportCard; if (match.passing) { - message$1 = `Congrats ` + name + `, nice GPA of ` + match.gpa.toString() + ` you got there!`; + message$1 = `Congrats ${name}, nice GPA of ${match.gpa.toString()} you got there!`; } else { let exit = 0; let tmp$1 = 12345; if (typeof tmp$1 !== "object") { - message$1 = tmp$1 === "Sick" ? `How are you feeling?` : `Good luck next semester ` + name + `!`; + message$1 = tmp$1 === "Sick" ? `How are you feeling?` : `Good luck next semester ${name}!`; } else { exit = 1; } if (exit === 1) { - message$1 = person2.reportCard.gpa !== 0.0 ? `Good luck next semester ` + name + `!` : `Come back in ` + (12345)._0.toString() + ` days!`; + message$1 = person2.reportCard.gpa !== 0.0 ? `Good luck next semester ${name}!` : `Come back in ${(12345)._0.toString()} days!`; } } } diff --git a/tests/tests/src/inline_const.mjs b/tests/tests/src/inline_const.mjs index af9a3b3253f..1fb24a7650f 100644 --- a/tests/tests/src/inline_const.mjs +++ b/tests/tests/src/inline_const.mjs @@ -3,8 +3,6 @@ let N = {}; -let hh = "hellohello"; - console.log([ 3e-6, 3e-6 @@ -18,6 +16,8 @@ function N1(funarg) { let h = "hello"; +let hh = "hellohello"; + export { x, N, diff --git a/tests/tests/src/inline_const_test.mjs b/tests/tests/src/inline_const_test.mjs index fd80acbcce8..53d4234e596 100644 --- a/tests/tests/src/inline_const_test.mjs +++ b/tests/tests/src/inline_const_test.mjs @@ -8,15 +8,15 @@ let H = Inline_const.N1({}); let f = "hello"; -let f1 = `a`; +let f1 = "a"; -let f2 = `中文`; +let f2 = "中文"; -let f3 = `中文`; +let f3 = "中文"; -let f4 = `中文`; +let f4 = "中文"; -let escapedValue = `\x61\n\uD83D\uDE00`; +let escapedValue = "a\n😀"; Mocha.describe("File \"inline_const_test.res\", line 11, characters 9-16", () => { Mocha.test("inline const test", () => { diff --git a/tests/tests/src/mario_game.mjs b/tests/tests/src/mario_game.mjs index 43abdd9c486..21be6627261 100644 --- a/tests/tests/src/mario_game.mjs +++ b/tests/tests/src/mario_game.mjs @@ -3230,7 +3230,7 @@ let loadCount = { function load(param) { let canvas_id = "canvas"; let el = document.getElementById(canvas_id); - let canvas = el !== null ? el : (console.log("cant find canvas " + canvas_id), Pervasives.failwith("fail")); + let canvas = el !== null ? el : (console.log("cant find canvas canvas"), Pervasives.failwith("fail")); let context = canvas.getContext("2d"); document.addEventListener("keydown", keydown, true); document.addEventListener("keyup", keyup, true); diff --git a/tests/tests/src/record_debug_test.mjs b/tests/tests/src/record_debug_test.mjs index e80b01e84a5..c4f186abe42 100644 --- a/tests/tests/src/record_debug_test.mjs +++ b/tests/tests/src/record_debug_test.mjs @@ -71,11 +71,13 @@ let c = [ console.log(a, c); +let a$1 = [ + ``, + `a` +]; + Mocha.describe("record_debug_test.res", () => { - Mocha.test("private attribute test", () => Test_utils.eq("File \"record_debug_test.res\", line 57, characters 7-14", [ - ``, - `a` - ], [ + Mocha.test("private attribute test", () => Test_utils.eq("File \"record_debug_test.res\", line 57, characters 7-14", a$1, [ "", "a" ])); diff --git a/tests/tests/src/semantic_string_constant_test.mjs b/tests/tests/src/semantic_string_constant_test.mjs index 6f1cf4ee799..722258a3042 100644 --- a/tests/tests/src/semantic_string_constant_test.mjs +++ b/tests/tests/src/semantic_string_constant_test.mjs @@ -4,7 +4,7 @@ import * as Mocha from "mocha"; import * as Test_utils from "./test_utils.mjs"; Mocha.describe("Semantic_string_constant_test", () => { - Mocha.test("constant length uses JavaScript string semantics", () => Test_utils.eq("File \"semantic_string_constant_test.res\", line 17, characters 7-14", 4, 4)); + Mocha.test("constant length uses JavaScript string semantics", () => Test_utils.eq("File \"semantic_string_constant_test.res\", line 14, characters 7-14", 2, 2)); }); /* Not a pure module */ diff --git a/tests/tests/src/semantic_string_constant_test.res b/tests/tests/src/semantic_string_constant_test.res index cbf1ff7219e..2dc26889107 100644 --- a/tests/tests/src/semantic_string_constant_test.res +++ b/tests/tests/src/semantic_string_constant_test.res @@ -5,15 +5,12 @@ open Test_utils Lambda constant folding. The primitive below does. Obj.magic exposes the string-backed polymorphic variant as a semantic string constant; this used to fold the emoji's UTF-8 byte length (4) instead of its JavaScript UTF-16 - length (2). - - This characterization intentionally expects the incorrect result, 4; the - JavaScript UTF-16 length is 2. */ + length (2). */ external stringLength: string => int = "%string_length" describe(__MODULE__, () => { test("constant length uses JavaScript string semantics", () => { let semanticEmoji: string = Obj.magic(#"😀") - eq(__LOC__, stringLength(semanticEmoji), 4) + eq(__LOC__, stringLength(semanticEmoji), 2) }) }) diff --git a/tests/tests/src/stdlib/Stdlib_ObjectTests.mjs b/tests/tests/src/stdlib/Stdlib_ObjectTests.mjs index 4f3b1a91007..a314aa75b40 100644 --- a/tests/tests/src/stdlib/Stdlib_ObjectTests.mjs +++ b/tests/tests/src/stdlib/Stdlib_ObjectTests.mjs @@ -428,7 +428,7 @@ function assignOverwritesTarget(title, source) { 22, 39 ], - `assign ` + title + `assign ${title}` ], Object.assign({ a: 1 }, sourceObj), eq, sourceObj); @@ -439,7 +439,7 @@ function assignOverwritesTarget(title, source) { 22, 39 ], - `assign ` + title + `assign ${title}` ], Object.assign({ a: undefined }, sourceObj), eq, sourceObj); @@ -450,7 +450,7 @@ function assignOverwritesTarget(title, source) { 22, 39 ], - `assign ` + title + `assign ${title}` ], Object.assign({ a: null }, sourceObj), eq, sourceObj); @@ -472,7 +472,7 @@ function runGetTest(i) { 22, 46 ], - `Object.get: ` + i.title + `Object.get: ${i.title}` ], i.get(i.source()), eq, i.expected); } diff --git a/tests/tests/src/stdlib/Test.mjs b/tests/tests/src/stdlib/Test.mjs index 05e5a9c0410..bcb1b4e0445 100644 --- a/tests/tests/src/stdlib/Test.mjs +++ b/tests/tests/src/stdlib/Test.mjs @@ -40,10 +40,10 @@ function run(loc, left, comparator, right) { }); let errorMessage = ` \u001b[31mTest Failure! - \u001b[36m` + file + `\u001b[0m:\u001b[2m` + line.toString() + ` -` + codeFrame + ` - \u001b[39mLeft: \u001b[31m` + left$1 + ` - \u001b[39mRight: \u001b[31m` + right$1 + `\u001b[0m + \u001b[36m${file}\u001b[0m:\u001b[2m${line.toString()} +${codeFrame} + \u001b[39mLeft: \u001b[31m${left$1} + \u001b[39mRight: \u001b[31m${right$1}\u001b[0m `; console.log(errorMessage); let obj = {}; diff --git a/tests/tests/src/stdlib/intl/Stdlib_IntlTests.mjs b/tests/tests/src/stdlib/intl/Stdlib_IntlTests.mjs index 40e9501e60f..ad7bbd22b1c 100644 --- a/tests/tests/src/stdlib/intl/Stdlib_IntlTests.mjs +++ b/tests/tests/src/stdlib/intl/Stdlib_IntlTests.mjs @@ -59,14 +59,15 @@ try { if (e$2.RE_EXN_ID === "JsExn") { let e$3 = e$2._1; let message = Stdlib_Option.map(Stdlib_JsExn.message(e$3), prim => prim.toLowerCase()); - let exit = 0; - if (message === "invalid key : someinvalidkey") { - console.log("Caught expected error"); + if (message !== undefined) { + if (message === "invalid key : someinvalidkey") { + console.log("Caught expected error"); + } else { + console.warn(`Unexpected error message: "${message}"`); + throw e$3; + } } else { - exit = 1; - } - if (exit === 1) { - console.warn(`Unexpected error message: "` + message + `"`); + console.warn(`Unexpected error message: "${message}"`); throw e$3; } } else { diff --git a/tests/tests/src/string_constant_compare.mjs b/tests/tests/src/string_constant_compare.mjs index 8fe5706c0c5..a66584bcd1d 100644 --- a/tests/tests/src/string_constant_compare.mjs +++ b/tests/tests/src/string_constant_compare.mjs @@ -5,9 +5,9 @@ let a1 = true; let a2 = false; -let a3 = "'" === "\'"; +let a3 = true; -let a4 = "'" !== "\'"; +let a4 = false; export { a1, diff --git a/tests/tests/src/string_literal_normalization_test.mjs b/tests/tests/src/string_literal_normalization_test.mjs index c6af903889f..6ae30a14b68 100644 --- a/tests/tests/src/string_literal_normalization_test.mjs +++ b/tests/tests/src/string_literal_normalization_test.mjs @@ -1,21 +1,38 @@ // Generated by ReScript, PLEASE EDIT WITH CARE import * as Mocha from "mocha"; +import * as Nodepath from "node:path"; import * as Test_utils from "./test_utils.mjs"; -let escaped = "\x61\u0062\u{63}"; +let escaped = "abc"; -let namedEscapes = "\b\f\n\r\t\v\0"; +let namedEscapes = "\b\f\n\r\t\x0b\0"; -let continued = "a\ -b"; +let continued = "ab"; -let concatenated = "\x61\u0062"; +let surrogatePair = "😀"; -let interpolated = `\x61` + "b" + `\u0063`; +let concatenated = "ab"; + +let interpolated = `\x61b\u0063`; + +function polymorphicTemplatePair_0(value) { + return value; +} + +let polymorphicTemplatePair = [ + polymorphicTemplatePair_0, + `literal` +]; + +let polymorphicTemplateIdentity = polymorphicTemplatePair_0; + +let polymorphicTemplateInt = polymorphicTemplateIdentity(1); + +let polymorphicTemplateString = polymorphicTemplateIdentity("value"); function constantSwitch() { - return 4; + return 1; } const rawBridgeProgramValue = '\\n'; @@ -28,21 +45,31 @@ let rawBridgeFunction = (() => '\\n'); let rawBridgeRegex = /\\n/; Mocha.describe("String_literal_normalization_test", () => { - Mocha.test("ordinary escapes have one semantic representation", () => Test_utils.eq("File \"string_literal_normalization_test.res\", line 30, characters 69-76", escaped, "abc")); + Mocha.test("attribute payloads use semantic strings", () => Test_utils.eq("File \"string_literal_normalization_test.res\", line 44, characters 59-66", Math.max(1, 2), 2)); + Mocha.test("scope and module payloads use semantic strings", () => { + Test_utils.eq("File \"string_literal_normalization_test.res\", line 47, characters 7-14", Math.max(1, 2), 2); + Test_utils.eq("File \"string_literal_normalization_test.res\", line 48, characters 7-14", Nodepath.basename("/a/b"), "b"); + }); + Mocha.test("ordinary escapes have one semantic representation", () => Test_utils.eq("File \"string_literal_normalization_test.res\", line 51, characters 69-76", escaped, "abc")); Mocha.test("named escapes and line continuations have JavaScript semantics", () => { - Test_utils.eq("File \"string_literal_normalization_test.res\", line 33, characters 7-14", namedEscapes, "\b\f\n\r\t\v\0"); - Test_utils.eq("File \"string_literal_normalization_test.res\", line 34, characters 7-14", continued, "ab"); + Test_utils.eq("File \"string_literal_normalization_test.res\", line 54, characters 7-14", namedEscapes, "\b\f\n\r\t\x0b\0"); + Test_utils.eq("File \"string_literal_normalization_test.res\", line 55, characters 7-14", continued, "ab"); }); + Mocha.test("surrogate-pair escapes have one semantic representation", () => Test_utils.eq("File \"string_literal_normalization_test.res\", line 59, characters 7-14", surrogatePair, "😀")); Mocha.test("ordinary literals participate in constant folding", () => { - Test_utils.eq("File \"string_literal_normalization_test.res\", line 38, characters 7-14", concatenated, "ab"); - Test_utils.eq("File \"string_literal_normalization_test.res\", line 41, characters 7-14", constantSwitch(), 4); + Test_utils.eq("File \"string_literal_normalization_test.res\", line 63, characters 7-14", concatenated, "ab"); + Test_utils.eq("File \"string_literal_normalization_test.res\", line 64, characters 7-14", 1, 1); + }); + Mocha.test("template segments survive the ast0 bridge", () => Test_utils.eq("File \"string_literal_normalization_test.res\", line 67, characters 61-68", interpolated, "abc")); + Mocha.test("constant templates preserve value generalization", () => { + Test_utils.eq("File \"string_literal_normalization_test.res\", line 70, characters 7-14", polymorphicTemplateInt, 1); + Test_utils.eq("File \"string_literal_normalization_test.res\", line 71, characters 7-14", polymorphicTemplateString, "value"); }); - Mocha.test("template segments survive the ast0 bridge", () => Test_utils.eq("File \"string_literal_normalization_test.res\", line 44, characters 61-68", interpolated, "abc")); Mocha.test("raw extension payloads preserve source spelling through ast0", () => { - Test_utils.eq("File \"string_literal_normalization_test.res\", line 47, characters 7-14", rawBridgeExpression, "\\n"); - Test_utils.eq("File \"string_literal_normalization_test.res\", line 48, characters 7-14", rawBridgeFunction(), "\\n"); - Test_utils.eq("File \"string_literal_normalization_test.res\", line 49, characters 7-14", rawBridgeProgramValue, "\\n"); - Test_utils.eq("File \"string_literal_normalization_test.res\", line 50, characters 7-14", rawBridgeRegex.test("\\n"), true); + Test_utils.eq("File \"string_literal_normalization_test.res\", line 75, characters 7-14", rawBridgeExpression, "\\n"); + Test_utils.eq("File \"string_literal_normalization_test.res\", line 76, characters 7-14", rawBridgeFunction(), "\\n"); + Test_utils.eq("File \"string_literal_normalization_test.res\", line 77, characters 7-14", rawBridgeProgramValue, "\\n"); + Test_utils.eq("File \"string_literal_normalization_test.res\", line 78, characters 7-14", rawBridgeRegex.test("\\n"), true); }); }); @@ -50,11 +77,16 @@ export { escaped, namedEscapes, continued, + surrogatePair, concatenated, interpolated, + polymorphicTemplatePair, + polymorphicTemplateIdentity, + polymorphicTemplateInt, + polymorphicTemplateString, constantSwitch, rawBridgeExpression, rawBridgeFunction, rawBridgeRegex, } -/* Not a pure module */ +/* polymorphicTemplateInt Not a pure module */ diff --git a/tests/tests/src/string_literal_normalization_test.res b/tests/tests/src/string_literal_normalization_test.res index 408a8917747..4760e723c68 100644 --- a/tests/tests/src/string_literal_normalization_test.res +++ b/tests/tests/src/string_literal_normalization_test.res @@ -3,12 +3,26 @@ open Mocha open Test_utils +@val(`Math\x2Emax`) +external escapedAttributeName: (int, int) => int = "" + +@scope(`Ma\x74h`) @val +external escapedScopeName: (int, int) => int = "max" + +@module(`node\x3Apath`) +external escapedModuleName: string => string = "basename" + let escaped = "\x61\u0062\u{63}" let namedEscapes = "\b\f\n\r\t\v\0" let continued = "a\ b" +let surrogatePair = "\uD83D\uDE00" let concatenated = "\x61" ++ "\u0062" let interpolated = `\x61${"b"}\u0063` +let polymorphicTemplatePair = (value => value, `literal`) +let (polymorphicTemplateIdentity, _) = polymorphicTemplatePair +let polymorphicTemplateInt = polymorphicTemplateIdentity(1) +let polymorphicTemplateString = polymorphicTemplateIdentity("value") let constantSwitch = () => switch "a" { @@ -27,6 +41,13 @@ let rawBridgeFunction: unit => string = %ffi("() => '\\n'") let rawBridgeRegex = /\\n/ describe(__MODULE__, () => { + test("attribute payloads use semantic strings", () => eq(__LOC__, escapedAttributeName(1, 2), 2)) + + test("scope and module payloads use semantic strings", () => { + eq(__LOC__, escapedScopeName(1, 2), 2) + eq(__LOC__, escapedModuleName("/a/b"), "b") + }) + test("ordinary escapes have one semantic representation", () => eq(__LOC__, escaped, "abc")) test("named escapes and line continuations have JavaScript semantics", () => { @@ -34,15 +55,22 @@ describe(__MODULE__, () => { eq(__LOC__, continued, "ab") }) + test("surrogate-pair escapes have one semantic representation", () => + eq(__LOC__, surrogatePair, "😀") + ) + test("ordinary literals participate in constant folding", () => { eq(__LOC__, concatenated, "ab") - /* Known bug: constant folding compares the encoded spelling instead of the - decoded string value, so the semantically matching first case is missed. */ - eq(__LOC__, constantSwitch(), 4) + eq(__LOC__, constantSwitch(), 1) }) test("template segments survive the ast0 bridge", () => eq(__LOC__, interpolated, "abc")) + test("constant templates preserve value generalization", () => { + eq(__LOC__, polymorphicTemplateInt, 1) + eq(__LOC__, polymorphicTemplateString, "value") + }) + test("raw extension payloads preserve source spelling through ast0", () => { eq(__LOC__, rawBridgeExpression, "\\n") eq(__LOC__, rawBridgeFunction(), "\\n") diff --git a/tests/tests/src/string_switch_test.mjs b/tests/tests/src/string_switch_test.mjs index c4251ce92a4..42d28e6576b 100644 --- a/tests/tests/src/string_switch_test.mjs +++ b/tests/tests/src/string_switch_test.mjs @@ -5,7 +5,29 @@ import * as Test_string_switch from "./test_string_switch.mjs"; Mocha.describe("String_switch_test", () => { Mocha.test("equivalent string escape spellings in switch cases", () => { - if (Test_string_switch.classifyEquivalentEscape("a", 0) !== 5) { + if (Test_string_switch.classifyEquivalentEscape("a", 0) !== 0) { + throw { + RE_EXN_ID: "Assert_failure", + _1: [ + "string_switch_test.res", + 5, + 4 + ], + Error: new Error() + }; + } + if (Test_string_switch.classifyEquivalentEscape("a", 1) !== 1) { + throw { + RE_EXN_ID: "Assert_failure", + _1: [ + "string_switch_test.res", + 6, + 4 + ], + Error: new Error() + }; + } + if (Test_string_switch.classifyEquivalentEscape("a", 2) !== 2) { throw { RE_EXN_ID: "Assert_failure", _1: [ @@ -16,7 +38,7 @@ Mocha.describe("String_switch_test", () => { Error: new Error() }; } - if (Test_string_switch.classifyEquivalentEscape("a", 1) !== 5) { + if (Test_string_switch.classifyEquivalentEscape("a", 3) !== 3) { throw { RE_EXN_ID: "Assert_failure", _1: [ @@ -27,36 +49,50 @@ Mocha.describe("String_switch_test", () => { Error: new Error() }; } - if (Test_string_switch.classifyEquivalentEscape("a", 2) !== 2) { + if (Test_string_switch.classifyEquivalentEscape("a", 4) === 4) { + return; + } + throw { + RE_EXN_ID: "Assert_failure", + _1: [ + "string_switch_test.res", + 9, + 4 + ], + Error: new Error() + }; + }); + Mocha.test("equivalent surrogate-pair escape spellings in switch cases", () => { + if (Test_string_switch.classifyEquivalentSurrogateEscape("😀", 0) !== 0) { throw { RE_EXN_ID: "Assert_failure", _1: [ "string_switch_test.res", - 9, + 13, 4 ], Error: new Error() }; } - if (Test_string_switch.classifyEquivalentEscape("a", 3) !== 5) { + if (Test_string_switch.classifyEquivalentSurrogateEscape("😀", 1) !== 1) { throw { RE_EXN_ID: "Assert_failure", _1: [ "string_switch_test.res", - 10, + 14, 4 ], Error: new Error() }; } - if (Test_string_switch.classifyEquivalentEscape("a", 4) === 5) { + if (Test_string_switch.classifyEquivalentSurrogateEscape("😀", 2) === 2) { return; } throw { RE_EXN_ID: "Assert_failure", _1: [ "string_switch_test.res", - 11, + 15, 4 ], Error: new Error() diff --git a/tests/tests/src/string_switch_test.res b/tests/tests/src/string_switch_test.res index e2406bdb82a..318b71ed70d 100644 --- a/tests/tests/src/string_switch_test.res +++ b/tests/tests/src/string_switch_test.res @@ -2,12 +2,16 @@ open Mocha describe(__MODULE__, () => { test("equivalent string escape spellings in switch cases", () => { - // Equivalent spellings become duplicate JavaScript cases. Only the first - // emitted case can match, so guards on the other cases are skipped. - assert(Test_string_switch.classifyEquivalentEscape("a", 0) == 5) - assert(Test_string_switch.classifyEquivalentEscape("a", 1) == 5) + assert(Test_string_switch.classifyEquivalentEscape("a", 0) == 0) + assert(Test_string_switch.classifyEquivalentEscape("a", 1) == 1) assert(Test_string_switch.classifyEquivalentEscape("a", 2) == 2) - assert(Test_string_switch.classifyEquivalentEscape("a", 3) == 5) - assert(Test_string_switch.classifyEquivalentEscape("a", 4) == 5) + assert(Test_string_switch.classifyEquivalentEscape("a", 3) == 3) + assert(Test_string_switch.classifyEquivalentEscape("a", 4) == 4) + }) + + test("equivalent surrogate-pair escape spellings in switch cases", () => { + assert(Test_string_switch.classifyEquivalentSurrogateEscape("😀", 0) == 0) + assert(Test_string_switch.classifyEquivalentSurrogateEscape("😀", 1) == 1) + assert(Test_string_switch.classifyEquivalentSurrogateEscape("😀", 2) == 2) }) }) diff --git a/tests/tests/src/string_unicode_test.mjs b/tests/tests/src/string_unicode_test.mjs index dba769379e4..c0fc6c432dc 100644 --- a/tests/tests/src/string_unicode_test.mjs +++ b/tests/tests/src/string_unicode_test.mjs @@ -21,15 +21,26 @@ function f(x) { } } +function spanningSurrogateBlock(x) { + if (x > 57345 || x < 55294) { + return 0; + } else { + return 1; + } +} + Mocha.describe("String_unicode_test", () => { Mocha.test("switch", () => { - Test_utils.eq("File \"string_unicode_test.res\", line 19, characters 7-14", f(/* '{' */123), 0); - Test_utils.eq("File \"string_unicode_test.res\", line 20, characters 7-14", f(/* 'ō' */333), 2); - Test_utils.eq("File \"string_unicode_test.res\", line 21, characters 7-14", f(/* 'Ƽ' */444), 3); + Test_utils.eq("File \"string_unicode_test.res\", line 25, characters 7-14", f(/* '{' */123), 0); + Test_utils.eq("File \"string_unicode_test.res\", line 26, characters 7-14", f(/* 'ō' */333), 2); + Test_utils.eq("File \"string_unicode_test.res\", line 27, characters 7-14", f(/* 'Ƽ' */444), 3); + Test_utils.eq("File \"string_unicode_test.res\", line 28, characters 7-14", spanningSurrogateBlock(/* '퟾' */55294), 1); + Test_utils.eq("File \"string_unicode_test.res\", line 29, characters 7-14", spanningSurrogateBlock(/* '' */57345), 1); }); }); export { f, + spanningSurrogateBlock, } /* Not a pure module */ diff --git a/tests/tests/src/string_unicode_test.res b/tests/tests/src/string_unicode_test.res index 85759a22b74..f72118a7e71 100644 Binary files a/tests/tests/src/string_unicode_test.res and b/tests/tests/src/string_unicode_test.res differ diff --git a/tests/tests/src/stringmatch_test.mjs b/tests/tests/src/stringmatch_test.mjs index a6df5db225b..53fe5a3951d 100644 --- a/tests/tests/src/stringmatch_test.mjs +++ b/tests/tests/src/stringmatch_test.mjs @@ -21,7 +21,7 @@ if (tst01("") !== 0) { }; } -if (tst01("\x00\x00\x00\x03") !== 1) { +if (tst01("\0\0\0\x03") !== 1) { throw { RE_EXN_ID: "Assert_failure", _1: [ @@ -33,7 +33,7 @@ if (tst01("\x00\x00\x00\x03") !== 1) { }; } -if (tst01("\x00\x00\x00\x00\x00\x00\x00\x07") !== 1) { +if (tst01("\0\0\0\0\0\0\0\x07") !== 1) { throw { RE_EXN_ID: "Assert_failure", _1: [ @@ -115,7 +115,7 @@ if (tst02("B") !== 3) { }; } -if (tst02("\x00\x00\x00\x00\x00\x00\x00\x07") !== 3) { +if (tst02("\0\0\0\0\0\0\0\x07") !== 3) { throw { RE_EXN_ID: "Assert_failure", _1: [ @@ -127,7 +127,7 @@ if (tst02("\x00\x00\x00\x00\x00\x00\x00\x07") !== 3) { }; } -if (tst02("\x00\x00\x00\x03") !== 3) { +if (tst02("\0\0\0\x03") !== 3) { throw { RE_EXN_ID: "Assert_failure", _1: [ diff --git a/tests/tests/src/switch_case_test.mjs b/tests/tests/src/switch_case_test.mjs index a704bdbf603..9dcf8695e67 100644 --- a/tests/tests/src/switch_case_test.mjs +++ b/tests/tests/src/switch_case_test.mjs @@ -5,10 +5,10 @@ import * as Test_utils from "./test_utils.mjs"; function f(x) { switch (x) { - case "xx'''" : - return 0; case "xx\"" : return 1; + case "xx'''" : + return 0; case "xx\\\"" : return 2; case "xx\\\"\"" : diff --git a/tests/tests/src/tagged_template_test.mjs b/tests/tests/src/tagged_template_test.mjs index 53a1a4fd052..839c31017fe 100644 --- a/tests/tests/src/tagged_template_test.mjs +++ b/tests/tests/src/tagged_template_test.mjs @@ -43,7 +43,7 @@ function runQuery(tag) { return tag`SELECT id = ${id}`; } -let paramQuery = runQuery(sql); +let paramQuery = sql`SELECT id = ${id}`; let s = Stdlib_TaggedTemplate.make((strings, parameters) => Stdlib_Array.reduceWithIndex(parameters, strings[0], (acc, param, i) => { let suffix = strings[i + 1 | 0]; @@ -93,24 +93,23 @@ Mocha.describe("tagged templates", () => { ]); }); Mocha.test("with a ReScript tag lifted via TaggedTemplate.make, it should return the correct interpolation", () => Test_utils.eq("File \"tagged_template_test.res\", line 133, characters 13-20", greeting, "hello Ada you're 36 years old!")); - Mocha.test("json interpolation is treated as ordinary string interpolation", () => Test_utils.eq("File \"tagged_template_test.res\", line 139, characters 7-14", "some random " + "string", "some random string")); - Mocha.test("a regular string interpolation should continue working", () => Test_utils.eq("File \"tagged_template_test.res\", line 143, characters 7-14", `some random ` + "string" + ` interpolation`, "some random string interpolation")); + Mocha.test("a regular string interpolation should continue working", () => Test_utils.eq("File \"tagged_template_test.res\", line 137, characters 7-14", `some random string interpolation`, "some random string interpolation")); Mocha.test("ordinary interpolation evaluates values once from left to right", () => { let calls = []; let record = value => { calls.push(value); return value; }; - let result = `start ` + record("first") + ` middle ` + record("second") + ` end`; - Test_utils.eq("File \"tagged_template_test.res\", line 153, characters 7-14", result, "start first middle second end"); - Test_utils.eq("File \"tagged_template_test.res\", line 154, characters 7-14", calls, [ + let result = `start ${record("first")} middle ${record("second")} end`; + Test_utils.eq("File \"tagged_template_test.res\", line 147, characters 7-14", result, "start first middle second end"); + Test_utils.eq("File \"tagged_template_test.res\", line 148, characters 7-14", calls, [ "first", "second" ]); }); Mocha.test("invalid escapes remain valid in tagged-template segments", () => { let result = rawTag`\unicode`; - Test_utils.eq("File \"tagged_template_test.res\", line 159, characters 7-14", result.raw, ["\\unicode"]); + Test_utils.eq("File \"tagged_template_test.res\", line 153, characters 7-14", result.raw, ["\\unicode"]); }); }); diff --git a/tests/tests/src/tagged_template_test.res b/tests/tests/src/tagged_template_test.res index cf8b93a30f6..aa61e166607 100644 --- a/tests/tests/src/tagged_template_test.res +++ b/tests/tests/src/tagged_template_test.res @@ -133,12 +133,6 @@ describe("tagged templates", () => { () => eq(__LOC__, greeting, "hello Ada you're 36 years old!"), ) - /* Known bug: json literals represent fixed raw source, but interpolation is - accepted and treated as ordinary string interpolation. */ - test("json interpolation is treated as ordinary string interpolation", () => - eq(__LOC__, json`some random ${"string"}`, "some random string") - ) - test("a regular string interpolation should continue working", () => eq(__LOC__, `some random ${"string"} interpolation`, "some random string interpolation") ) diff --git a/tests/tests/src/template.mjs b/tests/tests/src/template.mjs index 84d606a3eee..a1907f63909 100644 --- a/tests/tests/src/template.mjs +++ b/tests/tests/src/template.mjs @@ -6,7 +6,7 @@ let bla2 = ``; function concat() { return ` display:\r flex; - ` + bla2; + ${bla2}`; } export { diff --git a/tests/tests/src/test_string_switch.mjs b/tests/tests/src/test_string_switch.mjs index c5a16ff06f1..98f4569227c 100644 --- a/tests/tests/src/test_string_switch.mjs +++ b/tests/tests/src/test_string_switch.mjs @@ -18,38 +18,40 @@ switch (match) { } function classifyEquivalentEscape(value, selectedCase) { - switch (value) { - case "\u0061" : - if (selectedCase === 2) { - return 2; - } else { - return 5; - } - case "\u{61}" : - if (selectedCase === 3) { - return 3; - } else { - return 5; - } - case "\x61" : - if (selectedCase === 1) { - return 1; - } else { - return 4; - } - case "a" : - if (selectedCase === 0) { - return 0; - } else { - return 5; - } - default: - return 5; + if (value === "a") { + if (selectedCase === 0) { + return 0; + } else if (selectedCase === 1) { + return 1; + } else if (selectedCase === 2) { + return 2; + } else if (selectedCase === 3) { + return 3; + } else { + return 4; + } + } else { + return 5; + } +} + +function classifyEquivalentSurrogateEscape(value, selectedCase) { + if (value === "😀") { + if (selectedCase === 0) { + return 0; + } else if (selectedCase === 1) { + return 1; + } else { + return 2; + } + } else { + return 3; } } export { version, classifyEquivalentEscape, + classifyEquivalentSurrogateEscape, } /* match Not a pure module */ diff --git a/tests/tests/src/test_string_switch.res b/tests/tests/src/test_string_switch.res index 633741f3915..f2f10164d40 100644 --- a/tests/tests/src/test_string_switch.res +++ b/tests/tests/src/test_string_switch.res @@ -16,3 +16,11 @@ let classifyEquivalentEscape = (value, selectedCase) => | "\x61" => 4 | _ => 5 } + +let classifyEquivalentSurrogateEscape = (value, selectedCase) => + switch value { + | "😀" if selectedCase == 0 => 0 + | "\uD83D\uDE00" if selectedCase == 1 => 1 + | "\u{1f600}" => 2 + | _ => 3 + } diff --git a/tests/tests/src/unified_ops_test.mjs b/tests/tests/src/unified_ops_test.mjs index ed61a586c93..192719fe60b 100644 --- a/tests/tests/src/unified_ops_test.mjs +++ b/tests/tests/src/unified_ops_test.mjs @@ -3,8 +3,6 @@ let float = 1 + 2; -let string = "12"; - let bigint = 1n + 2n; function unknown(a, b) { @@ -105,6 +103,8 @@ let bigintShiftRight = (8n >> 2n); let int = 3; +let string = "12"; + let intShiftLeft = 4; let intShiftRight = 2; diff --git a/tests/tools_tests/src/expected/TestPpx.res.jsout b/tests/tools_tests/src/expected/TestPpx.res.jsout index 951349b0e55..11b63e864c8 100644 --- a/tests/tools_tests/src/expected/TestPpx.res.jsout +++ b/tests/tools_tests/src/expected/TestPpx.res.jsout @@ -66,8 +66,6 @@ let Pipe = { z: 3 }; -let concat = "ab"; - async function test() { return 12; } @@ -82,6 +80,8 @@ let b = "B"; let vv = 10; +let concat = "ab"; + let neq = false; let neq2 = false; diff --git a/tools/src/migrate.ml b/tools/src/migrate.ml index db6e8f42fc9..bbb88c286b6 100644 --- a/tools/src/migrate.ml +++ b/tools/src/migrate.ml @@ -26,18 +26,15 @@ module Insert_ext = struct let placeholder_of_expr = function | { Parsetree.pexp_desc = - Pexp_extension - ( {txt}, - PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_constant c}, _)}] - ); + Pexp_extension ({txt}, PStr [{pstr_desc = Pstr_eval (expression, _)}]); } -> if txt = ext_labelled then - match c with - | Pconst_string (name, _) -> Some (Labelled name) - | _ -> None + Option.map + (fun name -> Labelled name) + (Ast_payload.semantic_string_of_expression expression) else if txt = ext_unlabelled then - match c with - | Pconst_integer (s, _) -> ( + match expression.pexp_desc with + | Pexp_constant (Pconst_integer (s, _)) -> ( match int_of_string_opt s with | Some i -> Some (Unlabelled i) | None -> None) @@ -83,11 +80,7 @@ module Mapper_utils = struct [ {pstr_desc = Parsetree.Pstr_eval ({pexp_desc = Pexp_array elems}, _)}; ] -> - elems - |> List.filter_map (fun (e : Parsetree.expression) -> - match e.pexp_desc with - | Pexp_constant (Pconst_string (s, _)) -> Some s - | _ -> None) + elems |> List.filter_map Ast_payload.semantic_string_of_expression | _ -> [] let apply_names (names : string list) (e : Parsetree.expression) : diff --git a/tools/src/tools.ml b/tools/src/tools.ml index b585908f6ad..3ae00bff140 100644 --- a/tools/src/tools.ml +++ b/tools/src/tools.ml @@ -629,21 +629,11 @@ let extract_embedded ~extension_points ~filename = let append item = content := item :: !content in let extension (iterator : Ast_iterator.iterator) (ext : Parsetree.extension) = (match ext with - | ( {txt}, - PStr - [ - { - pstr_desc = - Pstr_eval - ( { - pexp_loc; - pexp_desc = Pexp_constant (Pconst_string (contents, _)); - }, - _ ); - }; - ] ) + | {txt}, PStr [{pstr_desc = Pstr_eval (({pexp_loc; _} as expression), _)}] when extension_points |> List.exists (fun v -> v = txt) -> - append (pexp_loc, txt, contents) + Option.iter + (fun contents -> append (pexp_loc, txt, contents)) + (Ast_payload.semantic_string_of_expression expression) | _ -> ()); Ast_iterator.default_iterator.extension iterator ext in @@ -871,25 +861,28 @@ module Format_codeblocks = struct Ast_mapper.default_mapper with attribute = (fun mapper ((name, payload) as attr) -> - match (name, Ast_payload.is_single_string payload, payload) with - | ( {txt = "res.doc"}, - Some (contents, None), - PStr [{pstr_desc = Pstr_eval ({pexp_loc}, _)}] ) -> - let formatted_contents, had_code_blocks = - format_rescript_code_blocks ~transform_assert_equal ~add_error - ~display_filename - ~markdown_block_start_line:pexp_loc.loc_start.pos_lnum - contents - in - if had_code_blocks && formatted_contents <> contents then - ( name, - PStr - [ - Ast_helper.Str.eval - (Ast_helper.Exp.constant - (Pconst_string (formatted_contents, None))); - ] ) - else attr + match (name, payload) with + | {txt = "res.doc"}, PStr [{pstr_desc = Pstr_eval ({pexp_loc}, _)}] + -> ( + Ast_payload.reject_json_literal_payload payload; + match Ast_payload.semantic_string_of_payload payload with + | Some contents -> + let formatted_contents, had_code_blocks = + format_rescript_code_blocks ~transform_assert_equal ~add_error + ~display_filename + ~markdown_block_start_line:pexp_loc.loc_start.pos_lnum + contents + in + if had_code_blocks && formatted_contents <> contents then + ( name, + PStr + [ + Ast_helper.Str.eval + (Ast_helper.Exp.constant + (Ast_helper.Const.string formatted_contents)); + ] ) + else attr + | None -> Ast_mapper.default_mapper.attribute mapper attr) | _ -> Ast_mapper.default_mapper.attribute mapper attr); } in