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