| 1 | #! perl |
1 | #! perl |
| 2 | |
2 | |
| 3 | use strict; |
3 | use strict; |
| 4 | no warnings; |
4 | no warnings; |
| 5 | use Test::More; |
5 | use Test::More; |
| 6 | BEGIN { plan tests => 686 }; |
6 | BEGIN { plan tests => 697 }; |
| 7 | |
7 | |
| 8 | use JSON::XS; |
8 | use JSON::XS; |
| 9 | |
9 | |
| 10 | sub splitter { |
10 | sub splitter { |
| 11 | my ($coder, $text) = @_; |
11 | my ($coder, $text) = @_; |
|
|
12 | |
|
|
13 | # work around hash randomisation bug introduced in 5.18 |
|
|
14 | $coder->canonical; |
| 12 | |
15 | |
| 13 | for (0 .. length $text) { |
16 | for (0 .. length $text) { |
| 14 | my $a = substr $text, 0, $_; |
17 | my $a = substr $text, 0, $_; |
| 15 | my $b = substr $text, $_; |
18 | my $b = substr $text, $_; |
| 16 | |
19 | |
| … | |
… | |
| 27 | splitter +JSON::XS->new , ' ["x\\"","\\u1000\\\\n\\nx",1,{"\\\\" :5 , "": "x"}]'; |
30 | splitter +JSON::XS->new , ' ["x\\"","\\u1000\\\\n\\nx",1,{"\\\\" :5 , "": "x"}]'; |
| 28 | splitter +JSON::XS->new , '[ "x\\"","\\u1000\\\\n\\nx" , 1,{"\\\\ " :5 , "": " x"} ] '; |
31 | splitter +JSON::XS->new , '[ "x\\"","\\u1000\\\\n\\nx" , 1,{"\\\\ " :5 , "": " x"} ] '; |
| 29 | splitter +JSON::XS->new->allow_nonref, '"test"'; |
32 | splitter +JSON::XS->new->allow_nonref, '"test"'; |
| 30 | splitter +JSON::XS->new->allow_nonref, ' "5" '; |
33 | splitter +JSON::XS->new->allow_nonref, ' "5" '; |
| 31 | |
34 | |
|
|
35 | { |
| 32 | my $text = '[5],{"":1} , [ 1,2, 3], {"3":null}'; |
36 | my $text = '[5],{"":1} , [ 1,2, 3], {"3":null}'; |
| 33 | my $coder = new JSON::XS; |
37 | my $coder = new JSON::XS; |
| 34 | for (0 .. length $text) { |
38 | for (0 .. length $text) { |
| 35 | my $a = substr $text, 0, $_; |
39 | my $a = substr $text, 0, $_; |
| 36 | my $b = substr $text, $_; |
40 | my $b = substr $text, $_; |
| 37 | |
41 | |
| 38 | $coder->incr_parse ($a); |
42 | $coder->incr_parse ($a); |
| 39 | $coder->incr_parse ($b); |
43 | $coder->incr_parse ($b); |
| 40 | |
44 | |
| 41 | my $j1 = $coder->incr_parse; ok ($coder->incr_text =~ s/^\s*,//, "cskip1"); |
45 | my $j1 = $coder->incr_parse; ok ($coder->incr_text =~ s/^\s*,//, "cskip1"); |
| 42 | my $j2 = $coder->incr_parse; ok ($coder->incr_text =~ s/^\s*,//, "cskip2"); |
46 | my $j2 = $coder->incr_parse; ok ($coder->incr_text =~ s/^\s*,//, "cskip2"); |
| 43 | my $j3 = $coder->incr_parse; ok ($coder->incr_text =~ s/^\s*,//, "cskip3"); |
47 | my $j3 = $coder->incr_parse; ok ($coder->incr_text =~ s/^\s*,//, "cskip3"); |
| 44 | my $j4 = $coder->incr_parse; ok ($coder->incr_text !~ s/^\s*,//, "cskip4"); |
48 | my $j4 = $coder->incr_parse; ok ($coder->incr_text !~ s/^\s*,//, "cskip4"); |
| 45 | my $j5 = $coder->incr_parse; ok ($coder->incr_text !~ s/^\s*,//, "cskip5"); |
49 | my $j5 = $coder->incr_parse; ok ($coder->incr_text !~ s/^\s*,//, "cskip5"); |
| 46 | |
50 | |
| 47 | ok ('[5]' eq encode_json $j1, "cjson1"); |
51 | ok ('[5]' eq encode_json $j1, "cjson1"); |
| 48 | ok ('{"":1}' eq encode_json $j2, "cjson2"); |
52 | ok ('{"":1}' eq encode_json $j2, "cjson2"); |
| 49 | ok ('[1,2,3]' eq encode_json $j3, "cjson3"); |
53 | ok ('[1,2,3]' eq encode_json $j3, "cjson3"); |
| 50 | ok ('{"3":null}' eq encode_json $j4, "cjson4"); |
54 | ok ('{"3":null}' eq encode_json $j4, "cjson4"); |
| 51 | ok (!defined $j5, "cjson5"); |
55 | ok (!defined $j5, "cjson5"); |
|
|
56 | } |
| 52 | } |
57 | } |
| 53 | |
58 | |
|
|
59 | { |
|
|
60 | my $text = '[x][5]'; |
|
|
61 | my $coder = new JSON::XS; |
|
|
62 | $coder->incr_parse ($text); |
|
|
63 | ok (!eval { $coder->incr_parse }, "sparse1"); |
|
|
64 | ok (!eval { $coder->incr_parse }, "sparse2"); |
|
|
65 | $coder->incr_skip; |
|
|
66 | ok ('[5]' eq $coder->encode (scalar $coder->incr_parse), "sparse3"); |
|
|
67 | } |
|
|
68 | |
|
|
69 | { |
|
|
70 | my $coder = JSON::XS->new->max_size (5); |
|
|
71 | ok (!$coder->incr_parse ("[ "), "incsize1"); |
|
|
72 | eval { !$coder->incr_parse ("] ") }; ok ($@ =~ /6 bytes/, "incsize2 $@"); |
|
|
73 | } |
|
|
74 | |
|
|
75 | { |
|
|
76 | my $coder = JSON::XS->new->max_depth (3); |
|
|
77 | ok (!$coder->incr_parse ("[[["), "incdepth1"); |
|
|
78 | eval { !$coder->incr_parse (" [] ") }; ok ($@ =~ /maximum nesting/, "incdepth2 $@"); |
|
|
79 | } |
|
|
80 | |
|
|
81 | # contributed by yuval kogman, reformatted to fit style |
|
|
82 | { |
|
|
83 | my $coder = JSON::XS->new; |
|
|
84 | |
|
|
85 | my $res = eval { $coder->incr_parse("]") }; |
|
|
86 | my $e = $@; # test more clobbers $@, we need it twice |
|
|
87 | |
|
|
88 | ok (!$res, "unbalanced bracket"); |
|
|
89 | ok ($e, "got error"); |
|
|
90 | like ($e, qr/malformed/, "malformed json string error"); |
|
|
91 | |
|
|
92 | $coder->incr_skip; |
|
|
93 | |
|
|
94 | is_deeply (eval { $coder->incr_parse("[42]") }, [42], "valid data after incr_skip"); |
|
|
95 | } |
|
|
96 | |
|
|
97 | |
