Codebase list libjson-pp-perl / 74dc641
New upstream version 4.09000 gregor herrmann 1 year, 11 months ago
8 changed file(s) with 237 addition(s) and 112 deletion(s). Raw diff Collapse all Expand all
+5
-0
Changes less more
00 Revision history for Perl extension JSON::PP.
1
2 4.09 2022-05-22
3 - reverted core boolean support for now (GH#72)
4 - incr_parse() Hangs on Certain Inputs (GH#67, DabeDotCom++)
5 - silence warnings about non-characters on older perls (GH#68, haarg++)
16
27 4.08 2022-04-10
38 - remove unneeded utf8::upgrade and downgrade (GH#59, FGasper++)
+1
-1
MANIFEST less more
4646 t/117_numbers.t
4747 t/118_boolean_values.t
4848 t/119_incr_parse_utf8.t
49 t/core_bools.t
49 t/120_incr_parse_truncated.t
5050 t/gh_28_json_test_suite.t
5151 t/gh_29_trailing_false_value.t
5252 t/rt_116998_wrong_character_offset.t
+2
-2
META.json less more
4545 "url" : "https://github.com/makamaka/JSON-PP"
4646 }
4747 },
48 "version" : "4.08",
49 "x_serialization_backend" : "JSON::PP version 4.08"
48 "version" : "4.09",
49 "x_serialization_backend" : "JSON::PP version 4.09"
5050 }
+1
-1
META.yml less more
2222 resources:
2323 bugtracker: https://github.com/makamaka/JSON-PP/issues
2424 repository: https://github.com/makamaka/JSON-PP
25 version: '4.08'
25 version: '4.09'
2626 x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
+1
-1
lib/JSON/PP/Boolean.pm less more
99 fallback => 1,
1010 );
1111
12 $JSON::PP::Boolean::VERSION = '4.08';
12 $JSON::PP::Boolean::VERSION = '4.09';
1313
1414 1;
1515
+9
-46
lib/JSON/PP.pm less more
1313 use Carp ();
1414 #use Devel::Peek;
1515
16 $JSON::PP::VERSION = '4.08';
16 $JSON::PP::VERSION = '4.09';
1717
1818 @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
1919
4545
4646 use constant OLD_PERL => $] < 5.008 ? 1 : 0;
4747 use constant USE_B => $ENV{PERL_JSON_PP_USE_B} || 0;
48 use constant CORE_BOOL => defined &builtin::is_bool;
4948
5049 my $invalid_char_re;
5150
217216 delete $self->{true};
218217 }
219218 return $self;
220 }
221
222 sub core_bools {
223 my $self = shift;
224 my $core_bools = defined $_[0] ? $_[0] : 1;
225 if ($core_bools) {
226 $self->{true} = !!1;
227 $self->{false} = !!0;
228 }
229 else {
230 $self->{true} = $JSON::PP::true;
231 $self->{false} = $JSON::PP::false;
232 }
233 return $self;
234 }
235
236 sub get_core_bools {
237 return !!0
238 if !CORE_BOOL;
239
240 my $self = shift;
241 my ($true, $false) = @{$self}{qw(true false)};
242 BEGIN { CORE_BOOL and warnings->unimport(qw(experimental::builtin)) }
243 return builtin::is_bool($true) && builtin::is_bool($false) && $true && !$false;
244219 }
245220
246221 sub get_boolean_values {
503478 my $type = ref($value);
504479
505480 if (!$type) {
506 BEGIN { CORE_BOOL and warnings->unimport('experimental::builtin') }
507 if (CORE_BOOL && builtin::is_bool($value)) {
508 return $value ? 'true' : 'false';
509 }
510 elsif (_looks_like_number($value)) {
481 if (_looks_like_number($value)) {
511482 return $value;
512483 }
513484 return $self->string_to_json($value);
12721243
12731244 # Compute how many bytes are in the longest legal official Unicode
12741245 # character
1275 my $max_unicode_length = chr 0x10FFFF;
1246 my $max_unicode_length = do {
1247 BEGIN { $] >= 5.006 and require warnings and warnings->unimport('utf8') }
1248 chr 0x10FFFF;
1249 };
12761250 utf8::encode($max_unicode_length);
12771251 $max_unicode_length = length $max_unicode_length;
12781252
15491523 $JSON::PP::true = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
15501524 $JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
15511525
1552 sub is_bool {
1553 if (blessed $_[0]) {
1554 return (
1555 $_[0]->isa("JSON::PP::Boolean")
1556 or $_[0]->isa("Types::Serialiser::BooleanBase")
1557 or $_[0]->isa("JSON::XS::Boolean")
1558 );
1559 }
1560 elsif (CORE_BOOL) {
1561 BEGIN { CORE_BOOL and warnings->unimport('experimental::builtin') }
1562 return builtin::is_bool($_[0]);
1563 }
1564 return !!0;
1565 }
1526 sub is_bool { blessed $_[0] and ( $_[0]->isa("JSON::PP::Boolean") or $_[0]->isa("Types::Serialiser::BooleanBase") or $_[0]->isa("JSON::XS::Boolean") ); }
15661527
15671528 sub true { $JSON::PP::true }
15681529 sub false { $JSON::PP::false }
16961657 }
16971658 next;
16981659 } elsif ( $mode == INCR_M_TFN ) {
1660 last INCR_PARSE if $p >= $len && $self->{incr_nest};
16991661 while ( $len > $p ) {
17001662 $s = substr( $text, $p++, 1 );
17011663 next if defined $s and $s =~ /[rueals]/;
17071669 last INCR_PARSE unless $self->{incr_nest};
17081670 redo INCR_PARSE;
17091671 } elsif ( $mode == INCR_M_NUM ) {
1672 last INCR_PARSE if $p >= $len && $self->{incr_nest};
17101673 while ( $len > $p ) {
17111674 $s = substr( $text, $p++, 1 );
17121675 next if defined $s and $s =~ /[0-9eE.+\-]/;
+218
-0
t/120_incr_parse_truncated.t less more
0 use strict;
1 use warnings;
2 use Test::More;
3 use JSON::PP;
4
5 plan tests => 19 * 3 + 1 * 6;
6
7 sub run_test {
8 my ($input, $sub) = @_;
9 $sub->($input);
10 }
11
12 run_test('{"one": 1}', sub {
13 my $input = shift;
14 my $coder = JSON::PP->new;
15 my $res = eval { $coder->incr_parse($input) };
16 my $e = $@; # test more clobbers $@, we need it twice
17 ok ($res, "curly braces okay -- '$input'");
18 ok (!$e, "no error -- '$input'");
19 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error");
20 });
21
22 run_test('{"one": 1]', sub {
23 my $input = shift;
24 my $coder = JSON::PP->new;
25 my $res = eval { $coder->incr_parse($input) };
26 my $e = $@; # test more clobbers $@, we need it twice
27 ok (!$res, "unbalanced curly braces -- '$input'");
28 ok ($e, "got error -- '$input'");
29 like ($e, qr/, or \} expected while parsing object\/hash/, "'} expected' json string error");
30 });
31
32 run_test('"', sub {
33 my $input = shift;
34 my $coder = JSON::PP->new;
35 my $res = eval { $coder->incr_parse($input) };
36 my $e = $@; # test more clobbers $@, we need it twice
37 ok (!$res, "truncated input='$input'");
38 ok (!$e, "no error for input='$input'");
39 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
40 });
41
42 run_test('{', sub {
43 my $input = shift;
44 my $coder = JSON::PP->new;
45 my $res = eval { $coder->incr_parse($input) };
46 my $e = $@; # test more clobbers $@, we need it twice
47 ok (!$res, "truncated input='$input'");
48 ok (!$e, "no error for input='$input'");
49 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
50 });
51
52 run_test('[', sub {
53 my $input = shift;
54 my $coder = JSON::PP->new;
55 my $res = eval { $coder->incr_parse($input) };
56 my $e = $@; # test more clobbers $@, we need it twice
57 ok (!$res, "truncated input='$input'");
58 ok (!$e, "no error for input='$input'");
59 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
60 });
61
62 run_test('}', sub {
63 my $input = shift;
64 my $coder = JSON::PP->new;
65 my $res = eval { $coder->incr_parse($input) };
66 my $e = $@; # test more clobbers $@, we need it twice
67 ok (!$res, "truncated input='$input'");
68 ok ($e, "no error for input='$input'");
69 like ($e, qr/malformed JSON string/, "'malformed JSON string' json string error for input='$input'");
70 });
71
72 run_test(']', sub {
73 my $input = shift;
74 my $coder = JSON::PP->new;
75 my $res = eval { $coder->incr_parse($input) };
76 my $e = $@; # test more clobbers $@, we need it twice
77 ok (!$res, "truncated input='$input'");
78 ok ($e, "no error for input='$input'");
79 like ($e, qr/malformed JSON string/, "'malformed JSON string' json string error for input='$input'");
80 });
81
82 run_test('1', sub {
83 my $input = shift;
84 my $coder = JSON::PP->new;
85 my $res = eval { $coder->incr_parse($input) };
86 my $e = $@; # test more clobbers $@, we need it twice
87 ok ($res, "truncated input='$input'");
88 ok (!$e, "no error for input='$input'");
89 unlike ($e, qr/malformed JSON string/, "'malformed JSON string' json string error for input='$input'");
90 });
91
92 run_test('1', sub {
93 my $input = shift;
94 my $coder = JSON::PP->new->allow_nonref(0);
95 my $res = eval { $coder->incr_parse($input) };
96 my $e = $@; # test more clobbers $@, we need it twice
97 ok (!$res, "truncated input='$input'");
98 ok ($e, "no error for input='$input'");
99 like ($e, qr/JSON text must be an object or array/, "'JSON text must be an object or array' json string error for input='$input'");
100 });
101
102 run_test('"1', sub {
103 my $input = shift;
104 my $coder = JSON::PP->new;
105 my $res = eval { $coder->incr_parse($input) };
106 my $e = $@; # test more clobbers $@, we need it twice
107 ok (!$res, "truncated input='$input'");
108 ok (!$e, "no error for input='$input'");
109 unlike ($e, qr/malformed JSON string/, "'malformed JSON string' json string error for input='$input'");
110 });
111
112 run_test('\\', sub {
113 my $input = shift;
114 my $coder = JSON::PP->new;
115 my $res = eval { $coder->incr_parse($input) };
116 my $e = $@; # test more clobbers $@, we need it twice
117 ok (!$res, "truncated input='$input'");
118 ok ($e, "no error for input='$input'");
119 like ($e, qr/malformed JSON string/, "'malformed JSON string' json string error for input='$input'");
120 });
121
122 run_test('{"one": "', sub {
123 my $input = shift;
124 my $coder = JSON::PP->new;
125 my $res = eval { $coder->incr_parse($input) };
126 my $e = $@; # test more clobbers $@, we need it twice
127 ok (!$res, "truncated input='$input'");
128 ok (!$e, "no error for input='$input'");
129 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
130 });
131
132 run_test('{"one": {', sub {
133 my $input = shift;
134 my $coder = JSON::PP->new;
135 my $res = eval { $coder->incr_parse($input) };
136 my $e = $@; # test more clobbers $@, we need it twice
137 ok (!$res, "truncated input='$input'");
138 ok (!$e, "no error for input='$input'");
139 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
140 });
141
142 run_test('{"one": [', sub {
143 my $input = shift;
144 my $coder = JSON::PP->new;
145 my $res = eval { $coder->incr_parse($input) };
146 my $e = $@; # test more clobbers $@, we need it twice
147 ok (!$res, "truncated input='$input'");
148 ok (!$e, "no error for input='$input'");
149 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
150 });
151
152 run_test('{"one": t', sub {
153 my $input = shift;
154 my $coder = JSON::PP->new;
155 my $res = eval { $coder->incr_parse($input) };
156 my $e = $@; # test more clobbers $@, we need it twice
157 ok (!$res, "truncated input='$input'");
158 ok (!$e, "no error for input='$input'");
159 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
160 });
161
162 run_test('{"one": \\', sub {
163 my $input = shift;
164 my $coder = JSON::PP->new;
165 my $res = eval { $coder->incr_parse($input) };
166 my $e = $@; # test more clobbers $@, we need it twice
167 ok (!$res, "truncated input='$input'");
168 ok (!$e, "no error for input='$input'");
169 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
170 });
171
172 run_test('{"one": ', sub {
173 my $input = shift;
174 my $coder = JSON::PP->new;
175 my $res = eval { $coder->incr_parse($input) };
176 my $e = $@; # test more clobbers $@, we need it twice
177 ok (!$res, "truncated input='$input'");
178 ok (!$e, "no error for input='$input'");
179 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
180 });
181
182 run_test('{"one": 1', sub {
183 my $input = shift;
184 my $coder = JSON::PP->new;
185 my $res = eval { $coder->incr_parse($input) };
186 my $e = $@; # test more clobbers $@, we need it twice
187 ok (!$res, "truncated input='$input'");
188 ok (!$e, "no error for input='$input'");
189 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
190 });
191
192 run_test('{"one": {"two": 2', sub {
193 my $input = shift;
194 my $coder = JSON::PP->new;
195 my $res = eval { $coder->incr_parse($input) };
196 my $e = $@; # test more clobbers $@, we need it twice
197 ok (!$res, "truncated '$input'");
198 ok (!$e, "no error -- '$input'");
199 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error -- $input");
200 });
201
202 # Test Appending Closing '}' Curly Bracket
203 run_test('{"one": 1', sub {
204 my $input = shift;
205 my $coder = JSON::PP->new;
206 my $res = eval { $coder->incr_parse($input) };
207 my $e = $@; # test more clobbers $@, we need it twice
208 ok (!$res, "truncated input='$input'");
209 ok (!$e, "no error for input='$input'");
210 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
211
212 $res = eval { $coder->incr_parse('}') };
213 $e = $@; # test more clobbers $@, we need it twice
214 ok ($res, "truncated input='$input' . '}'");
215 ok (!$e, "no error for input='$input' . '}'");
216 unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input' . '}'");
217 });
+0
-61
t/core_bools.t less more
0 use strict;
1 use warnings;
2 use Test::More tests => 18;
3 use JSON::PP;
4
5 my $json = JSON::PP->new;
6
7 is $json->get_core_bools, !!0, 'core_bools initially false';
8
9 my $ret = $json->core_bools;
10 is $ret => $json, "returns the same object";
11
12 SKIP: {
13 skip "core_bools option doesn't register as true without core boolean support", 1
14 unless JSON::PP::CORE_BOOL;
15 is $json->get_core_bools, !!1, 'core_bools option enabled';
16 }
17
18 my ($new_false, $new_true) = $json->get_boolean_values;
19
20 ok defined $new_true, "core true value is defined";
21 ok defined $new_false, "core false value is defined";
22
23 ok !ref $new_true, "core true value is not blessed";
24 ok !ref $new_false, "core falase value is not blessed";
25
26 {
27 my @warnings;
28 local $SIG{__WARN__} = sub {
29 push @warnings, @_;
30 warn @_;
31 };
32
33 cmp_ok $new_true, 'eq', '1', 'core true value is "1"';
34 cmp_ok $new_true, '==', 1, 'core true value is 1';
35
36 cmp_ok $new_false, 'eq', '', 'core false value is ""';
37 cmp_ok $new_false, '==', 0, 'core false value is 0';
38
39 is scalar @warnings, 0, 'no warnings';
40 }
41
42 SKIP: {
43 skip "core boolean support needed to detect core booleans", 2
44 unless JSON::PP::CORE_BOOL;
45 ok JSON::PP::is_bool($new_true), 'core true is a boolean';
46 ok JSON::PP::is_bool($new_false), 'core false is a boolean';
47 }
48
49 my $should_true = $json->allow_nonref(1)->decode('true');
50 my $should_false = $json->allow_nonref(1)->decode('false');
51
52 ok !ref $should_true && $should_true, "JSON true turns into an unblessed true value";
53 ok !ref $should_false && !$should_false, "JSON false turns into an unblessed false value";
54
55 SKIP: {
56 skip "core boolean support needed to detect core booleans", 2
57 unless JSON::PP::CORE_BOOL;
58 ok JSON::PP::is_bool($should_true), 'decoded true is a boolean';
59 ok JSON::PP::is_bool($should_false), 'decoded false is a boolean';
60 }