1 2 # copied over from JSON::XS and modified to use JSON 3 4 use strict; 5 6 use Test::More; 7 BEGIN { plan tests => 697 }; 8 BEGIN { $ENV{PERL_JSON_BACKEND} = "JSON::backportPP"; } 9 10 11 use JSON; 12 13 if ( $] >= 5.006 ) { 14 15 eval <<'TEST' or die "Failed to eval test code for version $]: $@"; 16 17 sub splitter { 18 my ($coder, $text) = @_; 19 20 $coder->canonical(1) if $] >= 5.017009; 21 22 for (0 .. length $text) { 23 my $a = substr $text, 0, $_; 24 my $b = substr $text, $_; 25 26 $coder->incr_parse ($a); 27 $coder->incr_parse ($b); 28 29 my $data = $coder->incr_parse; 30 ok ($data); 31 is ($coder->encode ($data), $coder->encode ($coder->decode ($text)), "data"); 32 ok ($coder->incr_text =~ /^\s*$/, "tailws"); 33 } 34 } 35 36 37 38 splitter +JSON->new , ' ["x\\"","\\u1000\\\\n\\nx",1,{"\\\\" :5 , "": "x"}]'; 39 splitter +JSON->new , '[ "x\\"","\\u1000\\\\n\\nx" , 1,{"\\\\ " :5 , "": " x"} ] '; 40 splitter +JSON->new->allow_nonref, '"test"'; 41 splitter +JSON->new->allow_nonref, ' "5" '; 42 43 44 45 { 46 my $text = '[5],{"":1} , [ 1,2, 3], {"3":null}'; 47 my $coder = new JSON; 48 for (0 .. length $text) { 49 my $a = substr $text, 0, $_; 50 my $b = substr $text, $_; 51 52 $coder->incr_parse ($a); 53 $coder->incr_parse ($b); 54 55 my $j1 = $coder->incr_parse; ok ($coder->incr_text =~ s/^\s*,//, "cskip1"); 56 my $j2 = $coder->incr_parse; ok ($coder->incr_text =~ s/^\s*,//, "cskip2"); 57 my $j3 = $coder->incr_parse; ok ($coder->incr_text =~ s/^\s*,//, "cskip3"); 58 my $j4 = $coder->incr_parse; ok ($coder->incr_text !~ s/^\s*,//, "cskip4"); 59 my $j5 = $coder->incr_parse; ok ($coder->incr_text !~ s/^\s*,//, "cskip5"); 60 61 ok ('[5]' eq encode_json $j1, "cjson1"); 62 ok ('{"":1}' eq encode_json $j2, "cjson2"); 63 ok ('[1,2,3]' eq encode_json $j3, "cjson3"); 64 ok ('{"3":null}' eq encode_json $j4, "cjson4"); 65 ok (!defined $j5, "cjson5"); 66 } 67 } 68 69 { 70 my $text = '[x][5]'; 71 my $coder = new JSON; 72 $coder->incr_parse ($text); 73 ok (!eval { $coder->incr_parse }, "sparse1"); 74 ok (!eval { $coder->incr_parse }, "sparse2"); 75 $coder->incr_skip; 76 ok ('[5]' eq $coder->encode (scalar $coder->incr_parse), "sparse3"); 77 } 78 79 80 TEST 81 82 83 } 84 else { 85 86 87 eval <<'TEST' or die "Failed to eval test code for version $]: $@"; 88 89 my $incr_text; 90 91 sub splitter { 92 my ($coder, $text) = @_; 93 94 for (0 .. length $text) { 95 my $a = substr $text, 0, $_; 96 my $b = substr $text, $_; 97 98 $coder->incr_parse ($a); 99 $coder->incr_parse ($b); 100 101 my $data = $coder->incr_parse; 102 ok ($data); 103 ok ($coder->encode ($data) eq $coder->encode ($coder->decode ($text)), "data"); 104 ok (($incr_text = $coder->incr_text) =~ /^\s*$/, "tailws"); 105 } 106 } 107 108 splitter +JSON->new , ' ["x\\"","\\u1000\\\\n\\nx",1,{"\\\\" :5 , "": "x"}]'; 109 splitter +JSON->new , '[ "x\\"","\\u1000\\\\n\\nx" , 1,{"\\\\ " :5 , "": " x"} ] '; 110 splitter +JSON->new->allow_nonref, '"test"'; 111 splitter +JSON->new->allow_nonref, ' "5" '; 112 113 114 { 115 my $text = '[5],{"":1} , [ 1,2, 3], {"3":null}'; 116 my $coder = new JSON; 117 for (0 .. length $text) { 118 my $a = substr $text, 0, $_; 119 my $b = substr $text, $_; 120 121 $coder->incr_parse ($a); 122 $coder->incr_parse ($b); 123 124 my $j1 = $coder->incr_parse; ok ( $coder->incr_text( ($incr_text = $coder->incr_text) =~ s/^\s*,// and $incr_text ), "cskip1"); 125 my $j2 = $coder->incr_parse; ok ( $coder->incr_text( ($incr_text = $coder->incr_text) =~ s/^\s*,// and $incr_text ), "cskip2"); 126 my $j3 = $coder->incr_parse; ok ( $coder->incr_text( ($incr_text = $coder->incr_text) =~ s/^\s*,// and $incr_text ), "cskip3"); 127 my $j4 = $coder->incr_parse; ok (($incr_text = $coder->incr_text) !~ s/^\s*,//, "cskip4"); 128 my $j5 = $coder->incr_parse; ok (($incr_text = $coder->incr_text) !~ s/^\s*,//, "cskip5"); 129 130 ok ('[5]' eq encode_json $j1, "cjson1"); 131 ok ('{"":1}' eq encode_json $j2, "cjson2"); 132 ok ('[1,2,3]' eq encode_json $j3, "cjson3"); 133 ok ('{"3":null}' eq encode_json $j4, "cjson4"); 134 ok (!defined $j5, "cjson5"); 135 } 136 } 137 138 { 139 my $text = '[x][5]'; 140 my $coder = new JSON; 141 $coder->incr_parse ($text); 142 ok (!eval { $coder->incr_parse }, "sparse1"); 143 ok (!eval { $coder->incr_parse }, "sparse2"); 144 $coder->incr_skip; 145 ok ('[5]' eq $coder->encode (scalar $coder->incr_parse), "sparse3"); 146 } 147 148 149 TEST 150 151 } # for 5.005 152 153 154 155 156 { 157 my $coder = JSON->new->max_size (5); 158 ok (!$coder->incr_parse ("[ "), "incsize1"); 159 eval q{ !$coder->incr_parse ("] ") }; ok ($@ =~ /6 bytes/, "incsize2 $@"); 160 } 161 162 { 163 my $coder = JSON->new->max_depth (3); 164 ok (!$coder->incr_parse ("[[["), "incdepth1"); 165 eval q{ !$coder->incr_parse (" [] ") }; ok ($@ =~ /maximum nesting/, "incdepth2 $@"); 166 } 167 168 { 169 my $coder = JSON->new; 170 171 my $res = eval { $coder->incr_parse("]") }; 172 my $e = $@; # test more clobbers $@, we need it twice 173 174 ok(!$res, "unbalanced bracket" ); 175 ok($e, "got error"); 176 like( $e, qr/malformed/, "malformed json string error" ); 177 178 $coder->incr_skip; 179 180 is_deeply(eval { $coder->incr_parse("[42]") }, [42], "valid data after incr_skip"); 181 } 182 183