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 => 693 }; |
6 | BEGIN { plan tests => 745 }; |
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 | |
17 | $coder->incr_parse ($a); |
20 | $coder->incr_parse ($a); |
18 | $coder->incr_parse ($b); |
21 | $coder->incr_parse ($b); |
19 | |
22 | |
20 | my $data = $coder->incr_parse; |
23 | my $data = $coder->incr_parse; |
21 | ok ($data); |
24 | #ok (defined $data, "split<$a><$b>"); |
22 | ok ($coder->encode ($data) eq $coder->encode ($coder->decode ($text)), "data"); |
25 | ok (defined $data, "split"); |
|
|
26 | my $e1 = $coder->encode ($data); |
|
|
27 | my $e2 = $coder->encode ($coder->decode ($text)); |
|
|
28 | #ok ($e1 eq $e2, "data<$a><$b><$e1><$e2>"); |
|
|
29 | #ok ($coder->incr_text =~ /^\s*$/, "tailws<$a><$b>"); |
|
|
30 | ok ($e1 eq $e2, "data"); |
23 | ok ($coder->incr_text =~ /^\s*$/, "tailws"); |
31 | ok ($coder->incr_text =~ /^\s*$/, "tailws"); |
24 | } |
32 | } |
25 | } |
33 | } |
26 | |
34 | |
27 | splitter +JSON::XS->new , ' ["x\\"","\\u1000\\\\n\\nx",1,{"\\\\" :5 , "": "x"}]'; |
35 | splitter +JSON::XS->new->allow_nonref (0), ' ["x\\"","\\u1000\\\\n\\nx",1,{"\\\\" :5 , "": "x"}]'; |
28 | splitter +JSON::XS->new , '[ "x\\"","\\u1000\\\\n\\nx" , 1,{"\\\\ " :5 , "": " x"} ] '; |
36 | splitter +JSON::XS->new->allow_nonref (0), '[ "x\\"","\\u1000\\\\n\\nx" , 1,{"\\\\ " :5 , "": " x"} ] '; |
29 | splitter +JSON::XS->new->allow_nonref, '"test"'; |
37 | splitter +JSON::XS->new , '"test"'; |
30 | splitter +JSON::XS->new->allow_nonref, ' "5" '; |
38 | splitter +JSON::XS->new , ' "5" '; |
|
|
39 | splitter +JSON::XS->new , '-1e5'; |
|
|
40 | splitter +JSON::XS->new , ' 0.00E+00 '; |
31 | |
41 | |
32 | { |
42 | { |
33 | my $text = '[5],{"":1} , [ 1,2, 3], {"3":null}'; |
43 | my $text = '[5],{"":1} , [ 1,2, 3], {"3":null}'; |
34 | my $coder = new JSON::XS; |
44 | my $coder = new JSON::XS; |
35 | for (0 .. length $text) { |
45 | for (0 .. length $text) { |
… | |
… | |
73 | my $coder = JSON::XS->new->max_depth (3); |
83 | my $coder = JSON::XS->new->max_depth (3); |
74 | ok (!$coder->incr_parse ("[[["), "incdepth1"); |
84 | ok (!$coder->incr_parse ("[[["), "incdepth1"); |
75 | eval { !$coder->incr_parse (" [] ") }; ok ($@ =~ /maximum nesting/, "incdepth2 $@"); |
85 | eval { !$coder->incr_parse (" [] ") }; ok ($@ =~ /maximum nesting/, "incdepth2 $@"); |
76 | } |
86 | } |
77 | |
87 | |
|
|
88 | # contributed by yuval kogman, reformatted to fit style |
|
|
89 | { |
|
|
90 | my $coder = JSON::XS->new; |
|
|
91 | |
|
|
92 | my $res = eval { $coder->incr_parse("]") }; |
|
|
93 | my $e = $@; # test more clobbers $@, we need it twice |
|
|
94 | |
|
|
95 | ok (!$res, "unbalanced bracket"); |
|
|
96 | ok ($e, "got error"); |
|
|
97 | like ($e, qr/malformed/, "malformed json string error"); |
|
|
98 | |
|
|
99 | $coder->incr_skip; |
|
|
100 | |
|
|
101 | is_deeply (eval { $coder->incr_parse("[42]") }, [42], "valid data after incr_skip"); |
|
|
102 | } |
78 | |
103 | |
|
|
104 | |