Skip to content

Commit 90d5daf

Browse files
mediremimediremi
authored
Handle non-printable control characters when escaping JSON (#7435)
* Rename ounit_json_tests to ounit_ext_json_tests * Handle non-printable control characters when escaping JSON * bsb watcher serialiser: handle non-printable control characters when escaping JSON * Added CHANGELOG
1 parent 362a1da commit 90d5daf

File tree

7 files changed

+189
-191
lines changed

7 files changed

+189
-191
lines changed

‎CHANGELOG.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@
3030
- Fix broken `bstracing` CLI location. https://github.com/rescript-lang/rescript/pull/7398
3131
- Fix field flattening optimization to avoid creating unnecessary copies of allocating constants. https://github.com/rescript-lang/rescript-compiler/pull/7421
3232
- Fix leading comments removed when braces inside JSX contains `let` assignment. https://github.com/rescript-lang/rescript/pull/7424
33+
- Fix JSON escaping in code editor analysis: JSON was not always escaped properly, which prevented code actions from being available in certain situations https://github.com/rescript-lang/rescript/pull/7435
3334

3435
#### :house: Internal
3536

‎analysis/vendor/json/Json.ml

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -141,7 +141,10 @@ let escape text =
141141
| '\b' -> Buffer.add_string buf "\\b"
142142
| '\r' -> Buffer.add_string buf "\\r"
143143
| '\t' -> Buffer.add_string buf "\\t"
144-
| c -> Buffer.add_char buf c);
144+
| c ->
145+
let code = Char.code c in
146+
if code < 0x20 then Printf.bprintf buf "\\u%04x" code
147+
else Buffer.add_char buf c);
145148
loop (i + 1))
146149
in
147150
loop 0;

‎compiler/ext/ext_json_noloc.ml

Lines changed: 21 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -33,48 +33,27 @@ type t =
3333
| Obj of t Map_string.t
3434

3535
(** poor man's serialization *)
36-
let naive_escaped (unmodified_input : string) : string =
37-
let n = ref 0 in
38-
let len = String.length unmodified_input in
39-
for i = 0 to len - 1 do
40-
n :=
41-
!n
42-
+
43-
match String.unsafe_get unmodified_input i with
44-
| '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
45-
| _ -> 1
46-
done;
47-
if !n = len then unmodified_input
48-
else
49-
let result = Bytes.create !n in
50-
n := 0;
51-
for i = 0 to len - 1 do
52-
let open Bytes in
53-
(match String.unsafe_get unmodified_input i with
54-
| ('\"' | '\\') as c ->
55-
unsafe_set result !n '\\';
56-
incr n;
57-
unsafe_set result !n c
58-
| '\n' ->
59-
unsafe_set result !n '\\';
60-
incr n;
61-
unsafe_set result !n 'n'
62-
| '\t' ->
63-
unsafe_set result !n '\\';
64-
incr n;
65-
unsafe_set result !n 't'
66-
| '\r' ->
67-
unsafe_set result !n '\\';
68-
incr n;
69-
unsafe_set result !n 'r'
70-
| '\b' ->
71-
unsafe_set result !n '\\';
72-
incr n;
73-
unsafe_set result !n 'b'
74-
| c -> unsafe_set result !n c);
75-
incr n
76-
done;
77-
Bytes.unsafe_to_string result
36+
let naive_escaped (text : string) : string =
37+
let ln = String.length text in
38+
let buf = Buffer.create ln in
39+
let rec loop i =
40+
if i < ln then (
41+
(match text.[i] with
42+
| '\012' -> Buffer.add_string buf "\\f"
43+
| '\\' -> Buffer.add_string buf "\\\\"
44+
| '"' -> Buffer.add_string buf "\\\""
45+
| '\n' -> Buffer.add_string buf "\\n"
46+
| '\b' -> Buffer.add_string buf "\\b"
47+
| '\r' -> Buffer.add_string buf "\\r"
48+
| '\t' -> Buffer.add_string buf "\\t"
49+
| c ->
50+
let code = Char.code c in
51+
if code < 0x20 then Printf.bprintf buf "\\u%04x" code
52+
else Buffer.add_char buf c);
53+
loop (i + 1))
54+
in
55+
loop 0;
56+
Buffer.contents buf
7857

7958
let quot x = "\"" ^ naive_escaped x ^ "\""
8059

‎tests/ounit_tests/dune

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,4 +11,4 @@
1111
(<> %{profile} browser))
1212
(flags
1313
(:standard -w +a-4-9-30-40-41-42-48-70))
14-
(libraries bsb bsb_helper core ounit2))
14+
(libraries bsb bsb_helper core ounit2 analysis))

‎tests/ounit_tests/ounit_ext_json_tests.ml

Lines changed: 153 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,153 @@
1+
let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: ))
2+
type t = Ext_json_noloc.t
3+
let rec equal (x : t) (y : t) =
4+
match x with
5+
| Null -> (
6+
(* [%p? Null _ ] *)
7+
match y with
8+
| Null -> true
9+
| _ -> false)
10+
| Str str -> (
11+
match y with
12+
| Str str2 -> str = str2
13+
| _ -> false)
14+
| Flo flo -> (
15+
match y with
16+
| Flo flo2 -> flo = flo2
17+
| _ -> false)
18+
| True -> (
19+
match y with
20+
| True -> true
21+
| _ -> false)
22+
| False -> (
23+
match y with
24+
| False -> true
25+
| _ -> false)
26+
| Arr content -> (
27+
match y with
28+
| Arr content2 -> Ext_array.for_all2_no_exn content content2 equal
29+
| _ -> false)
30+
| Obj map -> (
31+
match y with
32+
| Obj map2 ->
33+
let xs =
34+
Map_string.bindings map |> List.sort (fun (a, _) (b, _) -> compare a b)
35+
in
36+
let ys =
37+
Map_string.bindings map2 |> List.sort (fun (a, _) (b, _) -> compare a b)
38+
in
39+
Ext_list.for_all2_no_exn xs ys (fun (k0, v0) (k1, v1) ->
40+
k0 = k1 && equal v0 v1)
41+
| _ -> false)
42+
43+
open Ext_json_parse
44+
let ( |? ) m (key, cb) = m |> Ext_json.test key cb
45+
46+
let rec strip (x : Ext_json_types.t) : Ext_json_noloc.t =
47+
let open Ext_json_noloc in
48+
match x with
49+
| True _ -> true_
50+
| False _ -> false_
51+
| Null _ -> null
52+
| Flo {flo = s} -> flo s
53+
| Str {str = s} -> str s
54+
| Arr {content} -> arr (Array.map strip content)
55+
| Obj {map} -> obj (Map_string.map map strip)
56+
57+
let id_parsing_serializing x =
58+
let normal_s =
59+
Ext_json_noloc.to_string @@ strip @@ Ext_json_parse.parse_json_from_string x
60+
in
61+
let normal_ss =
62+
Ext_json_noloc.to_string @@ strip
63+
@@ Ext_json_parse.parse_json_from_string normal_s
64+
in
65+
if normal_s <> normal_ss then (
66+
prerr_endline "ERROR";
67+
prerr_endline normal_s;
68+
prerr_endline normal_ss);
69+
OUnit.assert_equal ~cmp:(fun (x : string) y -> x = y) normal_s normal_ss
70+
71+
let id_parsing_x2 x =
72+
let stru = Ext_json_parse.parse_json_from_string x |> strip in
73+
let normal_s = Ext_json_noloc.to_string stru in
74+
let normal_ss = strip (Ext_json_parse.parse_json_from_string normal_s) in
75+
if equal stru normal_ss then true
76+
else (
77+
prerr_endline "ERROR";
78+
prerr_endline normal_s;
79+
Format.fprintf Format.err_formatter "%a@.%a@." Ext_obj.pp_any stru
80+
Ext_obj.pp_any normal_ss;
81+
82+
prerr_endline (Ext_json_noloc.to_string normal_ss);
83+
false)
84+
85+
let test_data =
86+
[
87+
{|
88+
{}
89+
|};
90+
{| [] |};
91+
{| [1,2,3]|};
92+
{| ["x", "y", 1,2,3 ]|};
93+
{| { "x" : 3, "y" : "x", "z" : [1,2,3, "x"] }|};
94+
{| {"x " : true , "y" : false , "z\"" : 1} |};
95+
]
96+
exception Parse_error
97+
let suites =
98+
__FILE__
99+
>::: [
100+
(__LOC__ >:: fun _ -> List.iter id_parsing_serializing test_data);
101+
( __LOC__ >:: fun _ ->
102+
List.iteri
103+
(fun i x ->
104+
OUnit.assert_bool (__LOC__ ^ string_of_int i) (id_parsing_x2 x))
105+
test_data );
106+
( "empty_json" >:: fun _ ->
107+
let v = parse_json_from_string "{}" in
108+
match v with
109+
| Obj {map = v} -> OUnit.assert_equal (Map_string.is_empty v) true
110+
| _ -> OUnit.assert_failure "should be empty" );
111+
( "empty_arr" >:: fun _ ->
112+
let v = parse_json_from_string "[]" in
113+
match v with
114+
| Arr {content = [||]} -> ()
115+
| _ -> OUnit.assert_failure "should be empty" );
116+
( "empty trails" >:: fun _ ->
117+
( OUnit.assert_raises Parse_error @@ fun _ ->
118+
try parse_json_from_string {| [,]|} with _ -> raise Parse_error );
119+
OUnit.assert_raises Parse_error @@ fun _ ->
120+
try parse_json_from_string {| {,}|} with _ -> raise Parse_error );
121+
( "two trails" >:: fun _ ->
122+
( OUnit.assert_raises Parse_error @@ fun _ ->
123+
try parse_json_from_string {| [1,2,,]|}
124+
with _ -> raise Parse_error );
125+
OUnit.assert_raises Parse_error @@ fun _ ->
126+
try parse_json_from_string {| { "x": 3, ,}|}
127+
with _ -> raise Parse_error );
128+
( "two trails fail" >:: fun _ ->
129+
OUnit.assert_raises Parse_error @@ fun _ ->
130+
try parse_json_from_string {| { "x": 3, 2 ,}|}
131+
with _ -> raise Parse_error );
132+
( "trail comma obj" >:: fun _ ->
133+
let v = parse_json_from_string {| { "x" : 3 , }|} in
134+
let v1 = parse_json_from_string {| { "x" : 3 , }|} in
135+
let test (v : Ext_json_types.t) =
136+
match v with
137+
| Obj {map = v} ->
138+
v |? ("x", `Flo (fun x -> OUnit.assert_equal x "3")) |> ignore
139+
| _ -> OUnit.assert_failure "trail comma"
140+
in
141+
test v;
142+
test v1 );
143+
( "trail comma arr" >:: fun _ ->
144+
let v = parse_json_from_string {| [ 1, 3, ]|} in
145+
let v1 = parse_json_from_string {| [ 1, 3 ]|} in
146+
let test (v : Ext_json_types.t) =
147+
match v with
148+
| Arr {content = [|Flo {flo = "1"}; Flo {flo = "3"}|]} -> ()
149+
| _ -> OUnit.assert_failure "trailing comma array"
150+
in
151+
test v;
152+
test v1 );
153+
]

0 commit comments

Comments
 (0)