In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/5eabe05513a5c4b2372fe96af04305ab920fa86a?hp=673bd1ed6f78d45de6dea7b10523c70eb32afe4e>
- Log -----------------------------------------------------------------
commit 5eabe05513a5c4b2372fe96af04305ab920fa86a
Author: Nicolas R <atoo...@cpan.org>
Date: Thu Feb 14 10:30:34 2019 -0600
Update JSON-PP to CPAN version 4.00
[DELTA]
4.00 2018-12-07
- production release
3.99_01 2018-12-03
- BACKWARD INCOMPATIBILITY:
As JSON::XS 4.0 changed its policy and enabled allow_nonref
by default, JSON::PP also enabled allow_nonref by default
- implement allow_tags that was introduced by JSON::XS 3.0
- add boolean_values that was introduced by JSON::XS 4.0
- allow literal tags in strings in relaxed mode, as JSON::XS 3.02 does
- allow PERL_JSON_PP_USE_B environmental variable to restore
old number detection behavior for compatibility
- various doc updates
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 8 +-
META.json | 2 +-
Porting/Maintainers.pl | 2 +-
cpan/JSON-PP/bin/json_pp | 1 +
cpan/JSON-PP/lib/JSON/PP.pm | 412 +++++++++++++++++++++++++++++-----
cpan/JSON-PP/lib/JSON/PP/Boolean.pm | 11 +-
cpan/JSON-PP/t/000_load.t | 3 +-
cpan/JSON-PP/t/001_utf8.t | 11 -
cpan/JSON-PP/t/002_error.t | 18 +-
cpan/JSON-PP/t/003_types.t | 5 +-
cpan/JSON-PP/t/004_dwiw_encode.t | 71 ++++++
cpan/JSON-PP/t/005_dwiw_decode.t | 93 ++++++++
cpan/JSON-PP/t/006_pc_pretty.t | 2 +-
cpan/JSON-PP/t/007_pc_esc.t | 18 +-
cpan/JSON-PP/t/008_pc_base.t | 3 +-
cpan/JSON-PP/t/009_pc_extra_number.t | 3 +-
cpan/JSON-PP/t/010_pc_keysort.t | 1 -
cpan/JSON-PP/t/011_pc_expo.t | 15 +-
cpan/JSON-PP/t/012_blessed.t | 5 +-
cpan/JSON-PP/t/013_limit.t | 8 +-
cpan/JSON-PP/t/014_latin1.t | 21 +-
cpan/JSON-PP/t/015_prefix.t | 19 +-
cpan/JSON-PP/t/016_tied.t | 1 +
cpan/JSON-PP/t/017_relaxed.t | 8 +-
cpan/JSON-PP/t/018_json_checker.t | 25 +--
cpan/JSON-PP/t/019_incr.t | 137 +++--------
cpan/JSON-PP/t/020_faihu.t | 32 +++
cpan/JSON-PP/t/021_evans.t | 25 +++
cpan/JSON-PP/t/021_evans_bugrep.t | 49 ----
cpan/JSON-PP/t/022_comment_at_eof.t | 9 +-
cpan/JSON-PP/t/052_object.t | 58 +++++
cpan/JSON-PP/t/099_binary.t | 31 +--
cpan/JSON-PP/t/108_decode.t | 5 -
cpan/JSON-PP/t/109_encode.t | 5 -
cpan/JSON-PP/t/112_upgrade.t | 10 +-
cpan/JSON-PP/t/114_decode_prefix.t | 4 +-
cpan/JSON-PP/t/116_incr_parse_fixed.t | 4 +-
cpan/JSON-PP/t/117_numbers.t | 1 +
cpan/JSON-PP/t/118_boolean_values.t | 80 +++++++
cpan/JSON-PP/t/_unicode_handling.pm | 28 ---
40 files changed, 848 insertions(+), 396 deletions(-)
create mode 100644 cpan/JSON-PP/t/004_dwiw_encode.t
create mode 100644 cpan/JSON-PP/t/005_dwiw_decode.t
create mode 100644 cpan/JSON-PP/t/020_faihu.t
create mode 100644 cpan/JSON-PP/t/021_evans.t
delete mode 100644 cpan/JSON-PP/t/021_evans_bugrep.t
create mode 100644 cpan/JSON-PP/t/052_object.t
create mode 100644 cpan/JSON-PP/t/118_boolean_values.t
delete mode 100644 cpan/JSON-PP/t/_unicode_handling.pm
diff --git a/MANIFEST b/MANIFEST
index 08d7df6109..9e58fbefa1 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1202,6 +1202,8 @@ cpan/JSON-PP/t/000_load.t
cpan/JSON-PP/t/001_utf8.t
cpan/JSON-PP/t/002_error.t
cpan/JSON-PP/t/003_types.t
+cpan/JSON-PP/t/004_dwiw_encode.t
+cpan/JSON-PP/t/005_dwiw_decode.t
cpan/JSON-PP/t/006_pc_pretty.t
cpan/JSON-PP/t/007_pc_esc.t
cpan/JSON-PP/t/008_pc_base.t
@@ -1216,9 +1218,11 @@ cpan/JSON-PP/t/016_tied.t
cpan/JSON-PP/t/017_relaxed.t
cpan/JSON-PP/t/018_json_checker.t
cpan/JSON-PP/t/019_incr.t
+cpan/JSON-PP/t/020_faihu.t
cpan/JSON-PP/t/020_unknown.t
-cpan/JSON-PP/t/021_evans_bugrep.t
+cpan/JSON-PP/t/021_evans.t
cpan/JSON-PP/t/022_comment_at_eof.t
+cpan/JSON-PP/t/052_object.t
cpan/JSON-PP/t/099_binary.t
cpan/JSON-PP/t/104_sortby.t
cpan/JSON-PP/t/105_esc_slash.t
@@ -1233,7 +1237,7 @@ cpan/JSON-PP/t/114_decode_prefix.t
cpan/JSON-PP/t/115_tie_ixhash.t
cpan/JSON-PP/t/116_incr_parse_fixed.t
cpan/JSON-PP/t/117_numbers.t
-cpan/JSON-PP/t/_unicode_handling.pm
+cpan/JSON-PP/t/118_boolean_values.t
cpan/JSON-PP/t/gh_28_json_test_suite.t
cpan/JSON-PP/t/gh_29_trailing_false_value.t
cpan/JSON-PP/t/rt_116998_wrong_character_offset.t
diff --git a/META.json b/META.json
index 72d9c83e4e..307028656e 100644
--- a/META.json
+++ b/META.json
@@ -128,5 +128,5 @@
}
},
"version" : "5.029008",
- "x_serialization_backend" : "JSON::PP version 2.97001"
+ "x_serialization_backend" : "JSON::PP version 4.00"
}
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index e07e222dbb..48797ae9f4 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -651,7 +651,7 @@ use File::Glob qw(:case);
},
'JSON::PP' => {
- 'DISTRIBUTION' => 'ISHIGAKI/JSON-PP-2.97001.tar.gz',
+ 'DISTRIBUTION' => 'ISHIGAKI/JSON-PP-4.00.tar.gz',
'FILES' => q[cpan/JSON-PP],
},
diff --git a/cpan/JSON-PP/bin/json_pp b/cpan/JSON-PP/bin/json_pp
index e1d1c5fff8..6221315399 100644
--- a/cpan/JSON-PP/bin/json_pp
+++ b/cpan/JSON-PP/bin/json_pp
@@ -52,6 +52,7 @@ my %T = (
'json' => sub {
my $json = JSON::PP->new->utf8;
$json->$_() for @json_opt;
+ $json->canonical if grep {$_ eq 'pretty'} @json_opt;
$json->encode( $_ );
},
'dumper' => sub {
diff --git a/cpan/JSON-PP/lib/JSON/PP.pm b/cpan/JSON-PP/lib/JSON/PP.pm
index 714c848d9b..6adb57f5bd 100644
--- a/cpan/JSON-PP/lib/JSON/PP.pm
+++ b/cpan/JSON-PP/lib/JSON/PP.pm
@@ -14,7 +14,7 @@ use JSON::PP::Boolean;
use Carp ();
#use Devel::Peek;
-$JSON::PP::VERSION = '2.97001';
+$JSON::PP::VERSION = '4.00';
@JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
@@ -42,20 +42,22 @@ use constant P_ESCAPE_SLASH => 16;
use constant P_AS_NONBLESSED => 17;
use constant P_ALLOW_UNKNOWN => 18;
+use constant P_ALLOW_TAGS => 19;
use constant OLD_PERL => $] < 5.008 ? 1 : 0;
-use constant USE_B => 0;
+use constant USE_B => $ENV{PERL_JSON_PP_USE_B} || 0;
BEGIN {
-if (USE_B) {
- require B;
-}
+ if (USE_B) {
+ require B;
+ }
}
BEGIN {
my @xs_compati_bit_properties = qw(
latin1 ascii utf8 indent canonical space_before space_after
allow_nonref shrink
allow_blessed convert_blessed relaxed allow_unknown
+ allow_tags
);
my @pp_bit_properties = qw(
allow_singlequote allow_bignum loose
@@ -132,6 +134,8 @@ sub new {
indent_length => 3,
};
+ $self->{PROPS}[P_ALLOW_NONREF] = 1;
+
bless $self, $class;
}
@@ -191,6 +195,27 @@ sub max_size {
sub get_max_size { $_[0]->{max_size}; }
+sub boolean_values {
+ my $self = shift;
+ if (@_) {
+ my ($false, $true) = @_;
+ $self->{false} = $false;
+ $self->{true} = $true;
+ return ($false, $true);
+ } else {
+ delete $self->{false};
+ delete $self->{true};
+ return;
+ }
+}
+
+sub get_boolean_values {
+ my $self = shift;
+ if (exists $self->{true} and exists $self->{false}) {
+ return @$self{qw/false true/};
+ }
+ return;
+}
sub filter_json_object {
if (defined $_[1] and ref $_[1] eq 'CODE') {
@@ -264,6 +289,7 @@ sub allow_bigint {
my $escape_slash;
my $bignum;
my $as_nonblessed;
+ my $allow_tags;
my $depth;
my $indent_count;
@@ -280,9 +306,9 @@ sub allow_bigint {
my $props = $self->{PROPS};
($ascii, $latin1, $utf8, $indent, $canonical, $space_before,
$space_after, $allow_blessed,
- $convert_blessed, $escape_slash, $bignum, $as_nonblessed)
+ $convert_blessed, $escape_slash, $bignum, $as_nonblessed,
$allow_tags)
= @{$props}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED,
P_CONVERT_BLESSED,
- P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED];
+ P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED,
P_ALLOW_TAGS];
($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};
@@ -328,6 +354,21 @@ sub allow_bigint {
return $self->value_to_json($obj) if (
$obj->isa('JSON::PP::Boolean') );
+ if ( $allow_tags and $obj->can('FREEZE') ) {
+ my $obj_class = ref $obj || $obj;
+ $obj = bless $obj, $obj_class;
+ my @results = $obj->FREEZE('JSON');
+ if ( @results and ref $results[0] ) {
+ if ( refaddr( $obj ) eq refaddr( $results[0] ) ) {
+ encode_error( sprintf(
+ "%s::FREEZE method returned same object as was
passed instead of a new one",
+ ref $obj
+ ) );
+ }
+ }
+ return '("'.$obj_class.'")['.join(',', @results).']';
+ }
+
if ( $convert_blessed and $obj->can('TO_JSON') ) {
my $result = $obj->TO_JSON();
if ( defined $result and ref( $result ) ) {
@@ -348,8 +389,7 @@ sub allow_bigint {
return $self->blessed_to_json($obj) if ($as_nonblessed); #
will be removed.
return 'null';
}
- encode_error( sprintf("encountered object '%s', but neither
allow_blessed "
- . "nor convert_blessed settings are enabled", $obj)
+ encode_error( sprintf("encountered object '%s', but neither
allow_blessed, convert_blessed nor allow_tags settings are enabled (or
TO_JSON/FREEZE method missing)", $obj)
);
}
else {
@@ -652,6 +692,10 @@ BEGIN {
my $singlequote; # loosely quoting
my $loose; #
my $allow_barekey; # bareKey
+ my $allow_tags;
+
+ my $alt_true;
+ my $alt_false;
sub _detect_utf_encoding {
my $text = shift;
@@ -678,8 +722,10 @@ BEGIN {
my $props = $self->{PROPS};
- ($utf8, $relaxed, $loose, $allow_bignum, $allow_barekey, $singlequote)
- = @{$props}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE];
+ ($utf8, $relaxed, $loose, $allow_bignum, $allow_barekey, $singlequote,
$allow_tags)
+ = @{$props}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE,
P_ALLOW_TAGS];
+
+ ($alt_true, $alt_false) = @$self{qw/true false/};
if ( $utf8 ) {
$encoding = _detect_utf_encoding($text);
@@ -746,6 +792,7 @@ BEGIN {
return if(!defined $ch);
return object() if($ch eq '{');
return array() if($ch eq '[');
+ return tag() if($ch eq '(');
return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
return number() if($ch =~ /[0-9]/ or $ch eq '-');
return word();
@@ -841,8 +888,10 @@ BEGIN {
if (!$loose) {
if ($ch =~ /[\x00-\x1f\x22\x5c]/) { # '/' ok
- $at--;
- decode_error('invalid character encountered while
parsing JSON string');
+ if (!$relaxed or $ch ne "\t") {
+ $at--;
+ decode_error('invalid character encountered
while parsing JSON string');
+ }
}
}
@@ -955,6 +1004,35 @@ BEGIN {
decode_error(", or ] expected while parsing array");
}
+ sub tag {
+ decode_error('malformed JSON string, neither array, object, number,
string or atom') unless $allow_tags;
+
+ next_chr();
+ white();
+
+ my $tag = value();
+ return unless defined $tag;
+ decode_error('malformed JSON string, (tag) must be a string') if ref
$tag;
+
+ white();
+
+ if (!defined $ch or $ch ne ')') {
+ decode_error(') expected after tag');
+ }
+
+ next_chr();
+ white();
+
+ my $val = value();
+ return unless defined $val;
+ decode_error('malformed JSON string, tag value must be an array')
unless ref $val eq 'ARRAY';
+
+ if (!eval { $tag->can('THAW') }) {
+ decode_error('cannot decode perl-object (package does not
exist)') if $@;
+ decode_error('cannot decode perl-object (package does not have a
THAW method)');
+ }
+ $tag->THAW('JSON', @$val);
+ }
sub object {
my $o = $_[0] || {}; # you can use this code to use another hash ref
object.
@@ -1039,7 +1117,7 @@ BEGIN {
if($word eq 'true'){
$at += 3;
next_chr;
- return $JSON::PP::true;
+ return defined $alt_true ? $alt_true : $JSON::PP::true;
}
elsif($word eq 'null'){
$at += 3;
@@ -1051,7 +1129,7 @@ BEGIN {
if(substr($text,$at,1) eq 'e'){
$at++;
next_chr;
- return $JSON::PP::false;
+ return defined $alt_false ? $alt_false : $JSON::PP::false;
}
}
@@ -1234,18 +1312,27 @@ BEGIN {
if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] }
and ref $cb_sk_object->{ $ks[0] } ) {
my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
- if (@val == 1) {
+ if (@val == 0) {
+ return $o;
+ }
+ elsif (@val == 1) {
return $val[0];
}
+ else {
+ Carp::croak("filter_json_single_key_object callbacks must not
return more than one scalar");
+ }
}
my @val = $cb_object->($o) if ($cb_object);
- if (@val == 0 or @val > 1) {
+ if (@val == 0) {
return $o;
}
- else {
+ elsif (@val == 1) {
return $val[0];
}
+ else {
+ Carp::croak("filter_json_object callbacks must not return more
than one scalar");
+ }
}
@@ -1407,7 +1494,7 @@ BEGIN {
$JSON::PP::true = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
$JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
-sub is_bool { blessed $_[0] and $_[0]->isa("JSON::PP::Boolean"); }
+sub is_bool { blessed $_[0] and ( $_[0]->isa("JSON::PP::Boolean") or
$_[0]->isa("Types::Serialiser::BooleanBase") or $_[0]->isa("JSON::XS::Boolean")
); }
sub true { $JSON::PP::true }
sub false { $JSON::PP::false }
@@ -1425,6 +1512,8 @@ use constant INCR_M_BS => 2; # inside backslash
use constant INCR_M_JSON => 3; # outside anything, count nesting
use constant INCR_M_C0 => 4;
use constant INCR_M_C1 => 5;
+use constant INCR_M_TFN => 6;
+use constant INCR_M_NUM => 7;
$JSON::PP::IncrParser::VERSION = '1.01';
@@ -1490,7 +1579,7 @@ sub incr_parse {
return @ret;
}
else { # in scalar context
- return $ret[0] ? $ret[0] : undef;
+ return defined $ret[0] ? $ret[0] : undef;
}
}
}
@@ -1538,6 +1627,28 @@ INCR_PARSE:
$p++;
}
next;
+ } elsif ( $mode == INCR_M_TFN ) {
+ while ( $len > $p ) {
+ $s = substr( $text, $p++, 1 );
+ next if defined $s and $s =~ /[rueals]/;
+ last;
+ }
+ $p--;
+ $self->{incr_mode} = INCR_M_JSON;
+
+ last INCR_PARSE unless $self->{incr_nest};
+ redo INCR_PARSE;
+ } elsif ( $mode == INCR_M_NUM ) {
+ while ( $len > $p ) {
+ $s = substr( $text, $p++, 1 );
+ next if defined $s and $s =~ /[0-9eE.+\-]/;
+ last;
+ }
+ $p--;
+ $self->{incr_mode} = INCR_M_JSON;
+
+ last INCR_PARSE unless $self->{incr_nest};
+ redo INCR_PARSE;
} elsif ( $mode == INCR_M_STR ) {
while ( $len > $p ) {
$s = substr( $text, $p, 1 );
@@ -1570,6 +1681,12 @@ INCR_PARSE:
last INCR_PARSE;
}
next;
+ } elsif ( $s eq 't' or $s eq 'f' or $s eq 'n' ) {
+ $self->{incr_mode} = INCR_M_TFN;
+ redo INCR_PARSE;
+ } elsif ( $s =~ /^[0-9\-]$/ ) {
+ $self->{incr_mode} = INCR_M_NUM;
+ redo INCR_PARSE;
} elsif ( $s eq '"' ) {
$self->{incr_mode} = INCR_M_STR;
redo INCR_PARSE;
@@ -1656,20 +1773,18 @@ JSON::PP - JSON::XS compatible pure-Perl module.
=head1 VERSION
- 2.97001
+ 4.00
=head1 DESCRIPTION
-JSON::PP is a pure perl JSON decoder/encoder (as of RFC4627, which
-we know is obsolete but we still stick to; see below for an option
-to support part of RFC7159), and (almost) compatible to much
+JSON::PP is a pure perl JSON decoder/encoder, and (almost) compatible to much
faster L<JSON::XS> written by Marc Lehmann in C. JSON::PP works as
a fallback module when you use L<JSON> module without having
installed JSON::XS.
Because of this fallback feature of JSON.pm, JSON::PP tries not to
be more JavaScript-friendly than JSON::XS (i.e. not to escape extra
-characters such as U+2028 and U+2029 nor support RFC7159/ECMA-404),
+characters such as U+2028 and U+2029, etc),
in order for you not to lose such JavaScript-friendliness silently
when you use JSON.pm and install JSON::XS for speed or by accident.
If you need JavaScript-friendly RFC7159-compliant pure perl module,
@@ -1734,7 +1849,9 @@ decoding style, within the limits of supported formats.
$json = JSON::PP->new
Creates a new JSON::PP object that can be used to de/encode JSON
-strings. All boolean flags described below are by default I<disabled>.
+strings. All boolean flags described below are by default I<disabled>
+(with the exception of C<allow_nonref>, which defaults to I<enabled> since
+version C<4.0>).
The mutators for flags all return the JSON::PP object again and thus calls can
be chained:
@@ -1963,6 +2080,16 @@ character, after which more white-space and comments are
allowed.
// neither this one...
]
+=item * literal ASCII TAB characters in strings
+
+Literal ASCII TAB characters are now allowed in strings (and treated as
+C<\t>).
+
+ [
+ "Hello\tWorld",
+ "Hello<TAB>World", # literal <TAB> would not normally be allowed
+ ]
+
=back
=head2 canonical
@@ -1994,6 +2121,9 @@ This setting has currently no effect on tied hashes.
$enabled = $json->get_allow_nonref
+Unlike other boolean options, this opotion is enabled by default beginning
+with version C<4.0>.
+
If C<$enable> is true (or missing), then the C<encode> method can convert a
non-reference into its corresponding string, number or null JSON value,
which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
@@ -2004,15 +2134,15 @@ passed an arrayref or hashref, as JSON texts must
either be an object
or array. Likewise, C<decode> will croak if given something that is not a
JSON object or array.
-Example, encode a Perl scalar as JSON value with enabled C<allow_nonref>,
-resulting in an invalid JSON text:
+Example, encode a Perl scalar as JSON value without enabled C<allow_nonref>,
+resulting in an error:
- JSON::PP->new->allow_nonref->encode ("Hello, World!")
- => "Hello, World!"
+ JSON::PP->new->allow_nonref(0)->encode ("Hello, World!")
+ => hash- or arrayref expected...
=head2 allow_unknown
- $json = $json->allow_unknown ([$enable])
+ $json = $json->allow_unknown([$enable])
$enabled = $json->get_allow_unknown
@@ -2072,18 +2202,66 @@ this type of conversion.
This setting has no effect on C<decode>.
+=head2 allow_tags
+
+ $json = $json->allow_tags([$enable])
+
+ $enabled = $json->get_allow_tags
+
+See L<OBJECT SERIALISATION> for details.
+
+If C<$enable> is true (or missing), then C<encode>, upon encountering a
+blessed object, will check for the availability of the C<FREEZE> method on
+the object's class. If found, it will be used to serialise the object into
+a nonstandard tagged JSON value (that JSON decoders cannot decode).
+
+It also causes C<decode> to parse such tagged JSON values and deserialise
+them via a call to the C<THAW> method.
+
+If C<$enable> is false (the default), then C<encode> will not consider
+this type of conversion, and tagged JSON values will cause a parse error
+in C<decode>, as if tags were not part of the grammar.
+
+=head2 boolean_values
+
+ $json->boolean_values([$false, $true])
+
+ ($false, $true) = $json->get_boolean_values
+
+By default, JSON booleans will be decoded as overloaded
+C<$JSON::PP::false> and C<$JSON::PP::true> objects.
+
+With this method you can specify your own boolean values for decoding -
+on decode, JSON C<false> will be decoded as a copy of C<$false>, and JSON
+C<true> will be decoded as C<$true> ("copy" here is the same thing as
+assigning a value to another variable, i.e. C<$copy = $false>).
+
+This is useful when you want to pass a decoded data structure directly
+to other serialisers like YAML, Data::MessagePack and so on.
+
+Note that this works only when you C<decode>. You can set incompatible
+boolean objects (like L<boolean>), but when you C<encode> a data structure
+with such boolean objects, you still need to enable C<convert_blessed>
+(and add a C<TO_JSON> method if necessary).
+
+Calling this method without any arguments will reset the booleans
+to their default values.
+
+C<get_boolean_values> will return both C<$false> and C<$true> values, or
+the empty list when they are set to the default.
+
=head2 filter_json_object
$json = $json->filter_json_object([$coderef])
When C<$coderef> is specified, it will be called from C<decode> each
-time it decodes a JSON object. The only argument is a reference to the
-newly-created hash. If the code references returns a single scalar (which
-need not be a reference), this value (i.e. a copy of that scalar to avoid
-aliasing) is inserted into the deserialised data structure. If it returns
-an empty list (NOTE: I<not> C<undef>, which is a valid scalar), the
-original deserialised hash will be inserted. This setting can slow down
-decoding considerably.
+time it decodes a JSON object. The only argument is a reference to
+the newly-created hash. If the code references returns a single scalar
+(which need not be a reference), this value (or rather a copy of it) is
+inserted into the deserialised data structure. If it returns an empty
+list (NOTE: I<not> C<undef>, which is a valid scalar), the original
+deserialised hash will be inserted. This setting can slow down decoding
+considerably.
When C<$coderef> is omitted or undefined, any existing callback will
be removed and C<decode> will not change the deserialised hash in any
@@ -2091,12 +2269,11 @@ way.
Example, convert all JSON objects into the integer 5:
- my $js = JSON::PP->new->filter_json_object (sub { 5 });
+ my $js = JSON::PP->new->filter_json_object(sub { 5 });
# returns [5]
- $js->decode ('[{}]'); # the given subroutine takes a hash reference.
- # throw an exception because allow_nonref is not enabled
- # so a lone 5 is not allowed.
- $js->decode ('{"a":1, "b":2}');
+ $js->decode('[{}]');
+ # returns 5
+ $js->decode('{"a":1, "b":2}');
=head2 filter_json_single_key_object
@@ -2241,8 +2418,10 @@ and you need to know where the JSON text ends.
The following flags and properties are for JSON::PP only. If you use
any of these, you can't make your application run faster by replacing
JSON::PP with JSON::XS. If you need these and also speed boost,
-try L<Cpanel::JSON::XS>, a fork of JSON::XS by Reini Urban, which
-supports some of these.
+you might want to try L<Cpanel::JSON::XS>, a fork of JSON::XS by
+Reini Urban, which supports some of these (with a different set of
+incompatibilities). Most of these historical flags are only kept
+for backward compatibility, and should not be used in a new application.
=head2 allow_singlequote
@@ -2251,7 +2430,7 @@ supports some of these.
If C<$enable> is true (or missing), then C<decode> will accept
invalid JSON texts that contain strings that begin and end with
-single quotation marks. C<encode> will not be affected in anyway.
+single quotation marks. C<encode> will not be affected in any way.
I<Be aware that this option makes you accept invalid JSON texts
as if they were valid!>. I suggest only to use this option to
parse application-specific files written by humans (configuration
@@ -2272,7 +2451,7 @@ valid JSON texts.
If C<$enable> is true (or missing), then C<decode> will accept
invalid JSON texts that contain JSON objects whose names don't
begin and end with quotation marks. C<encode> will not be affected
-in anyway. I<Be aware that this option makes you accept invalid JSON
+in any way. I<Be aware that this option makes you accept invalid JSON
texts as if they were valid!>. I suggest only to use this option to
parse application-specific files written by humans (configuration
files, resource files etc.)
@@ -2307,7 +2486,7 @@ See also L<MAPPING>.
If C<$enable> is true (or missing), then C<decode> will accept
invalid JSON texts that contain unescaped [\x00-\x1f\x22\x5c]
-characters. C<encode> will not be affected in anyway.
+characters. C<encode> will not be affected in any way.
I<Be aware that this option makes you accept invalid JSON texts
as if they were valid!>. I suggest only to use this option to
parse application-specific files written by humans (configuration
@@ -2334,7 +2513,7 @@ arbitrary JSON in HTML (by some HTML template toolkit or
by string
interpolation) is risky in general. You must escape necessary
characters in correct order, depending on the context.
-C<decode> will not be affected in anyway.
+C<decode> will not be affected in any way.
=head2 indent_length
@@ -2577,6 +2756,15 @@ As a nonstandard extension to the JSON syntax that is
enabled by the
C<relaxed> setting, shell-style comments are allowed. They can start
anywhere outside strings and go till the end of the line.
+=item tagged values (C<< (I<tag>)I<value> >>).
+
+Another nonstandard extension to the JSON syntax, enabled with the
+C<allow_tags> setting, are tagged values. In this implementation, the
+I<tag> must be a perl package/class name encoded as a JSON string, and the
+I<value> must be a JSON array encoding optional constructor arguments.
+
+See L<OBJECT SERIALISATION>, below, for details.
+
=back
@@ -2647,7 +2835,7 @@ before encoding as JSON strings, and anything else as
number value:
# undef becomes null
encode_json [undef] # yields [null]
-You can force the type to be a string by stringifying it:
+You can force the type to be a JSON string by stringifying it:
my $x = 3.1; # some variable containing a number
"$x"; # stringified
@@ -2655,13 +2843,23 @@ You can force the type to be a string by stringifying
it:
print $x; # perl does it for you, too, quite often
# (but for older perls)
-You can force the type to be a number by numifying it:
+You can force the type to be a JSON number by numifying it:
my $x = "3"; # some variable containing a string
$x += 0; # numify it, ensuring it will be dumped as a number
$x *= 1; # same thing, the choice is yours.
-You cannot currently force the type in other, less obscure, ways.
+You can not currently force the type in other, less obscure, ways.
+
+Since version 2.91_01, JSON::PP uses a different number detection logic
+that converts a scalar that is possible to turn into a number safely.
+The new logic is slightly faster, and tends to help people who use older
+perl or who want to encode complicated data structure. However, this may
+results in a different JSON text from the one JSON::XS encodes (and
+thus may break tests that compare entire JSON texts). If you do
+need the previous behavior for compatibility or for finer control,
+set PERL_JSON_PP_USE_B environmental variable to true before you
+C<use> JSON::PP (or JSON.pm).
Note that numerical precision has the same meaning as under Perl (so
binary to decimal conversion follows the same rules as in Perl, which
@@ -2688,17 +2886,50 @@ to numify values that may start with values that look
like a number
=head2 OBJECT SERIALISATION
-As for Perl objects, JSON::PP only supports a pure JSON representation
(without the ability to deserialise the object automatically again).
+As JSON cannot directly represent Perl objects, you have to choose between
+a pure JSON representation (without the ability to deserialise the object
+automatically again), and a nonstandard extension to the JSON syntax,
+tagged values.
=head3 SERIALISATION
What happens when C<JSON::PP> encounters a Perl object depends on the
-C<allow_blessed>, C<convert_blessed> and C<allow_bignum> settings, which are
-used in this order:
+C<allow_blessed>, C<convert_blessed>, C<allow_tags> and C<allow_bignum>
+settings, which are used in this order:
=over 4
-=item 1. C<convert_blessed> is enabled and the object has a C<TO_JSON> method.
+=item 1. C<allow_tags> is enabled and the object has a C<FREEZE> method.
+
+In this case, C<JSON::PP> creates a tagged JSON value, using a nonstandard
+extension to the JSON syntax.
+
+This works by invoking the C<FREEZE> method on the object, with the first
+argument being the object to serialise, and the second argument being the
+constant string C<JSON> to distinguish it from other serialisers.
+
+The C<FREEZE> method can return any number of values (i.e. zero or
+more). These values and the paclkage/classname of the object will then be
+encoded as a tagged JSON value in the following format:
+
+ ("classname")[FREEZE return values...]
+
+e.g.:
+
+ ("URI")["http://www.google.com/";]
+ ("MyDate")[2013,10,29]
+ ("ImageData::JPEG")["Z3...VlCg=="]
+
+For example, the hypothetical C<My::Object> C<FREEZE> method might use the
+objects C<type> and C<id> members to encode the object:
+
+ sub My::Object::FREEZE {
+ my ($self, $serialiser) = @_;
+
+ ($self->{type}, $self->{id})
+ }
+
+=item 2. C<convert_blessed> is enabled and the object has a C<TO_JSON> method.
In this case, the C<TO_JSON> method of the object is invoked in scalar
context. It must return a single scalar that can be directly encoded into
@@ -2713,21 +2944,58 @@ originally were L<URI> objects is lost.
$uri->as_string
}
-=item 2. C<allow_bignum> is enabled and the object is a C<Math::BigInt> or
C<Math::BigFloat>.
+=item 3. C<allow_bignum> is enabled and the object is a C<Math::BigInt> or
C<Math::BigFloat>.
The object will be serialised as a JSON number value.
-=item 3. C<allow_blessed> is enabled.
+=item 4. C<allow_blessed> is enabled.
The object will be serialised as a JSON null value.
-=item 4. none of the above
+=item 5. none of the above
If none of the settings are enabled or the respective methods are missing,
C<JSON::PP> throws an exception.
=back
+=head3 DESERIALISATION
+
+For deserialisation there are only two cases to consider: either
+nonstandard tagging was used, in which case C<allow_tags> decides,
+or objects cannot be automatically be deserialised, in which
+case you can use postprocessing or the C<filter_json_object> or
+C<filter_json_single_key_object> callbacks to get some real objects our of
+your JSON.
+
+This section only considers the tagged value case: a tagged JSON object
+is encountered during decoding and C<allow_tags> is disabled, a parse
+error will result (as if tagged values were not part of the grammar).
+
+If C<allow_tags> is enabled, C<JSON::PP> will look up the C<THAW> method
+of the package/classname used during serialisation (it will not attempt
+to load the package as a Perl module). If there is no such method, the
+decoding will fail with an error.
+
+Otherwise, the C<THAW> method is invoked with the classname as first
+argument, the constant string C<JSON> as second argument, and all the
+values from the JSON array (the values originally returned by the
+C<FREEZE> method) as remaining arguments.
+
+The method must then return the object. While technically you can return
+any Perl scalar, you might have to enable the C<allow_nonref> setting to
+make that work in all cases, so better return an actual blessed reference.
+
+As an example, let's implement a C<THAW> function that regenerates the
+C<My::Object> from the C<FREEZE> example earlier:
+
+ sub My::Object::THAW {
+ my ($class, $serialiser, $type, $id) = @_;
+
+ $class->new (type => $type, id => $id)
+ }
+
+
=head1 ENCODING/CODESET FLAG NOTES
This section is taken from JSON::XS.
@@ -2827,6 +3095,23 @@ proper subset of most 8-bit and multibyte encodings in
use in the world.
=back
+=head1 BUGS
+
+Please report bugs on a specific behavior of this module to RT or GitHub
+issues (preferred):
+
+L<https://github.com/makamaka/JSON-PP/issues>
+
+L<https://rt.cpan.org/Public/Dist/Display.html?Queue=JSON-PP>
+
+As for new features and requests to change common behaviors, please
+ask the author of JSON::XS (Marc Lehmann, E<lt>schmorp[at]schmorp.deE<gt>)
+first, by email (important!), to keep compatibility among JSON.pm backends.
+
+Generally speaking, if you need something special for you, you are advised
+to create a new module, maybe based on L<JSON::Tiny>, which is smaller and
+written in a much cleaner way than this module.
+
=head1 SEE ALSO
The F<json_pp> command line utility for quick experiments.
@@ -2838,15 +3123,24 @@ L<JSON::PP::Compat5005> and L<JSON::PP::Compat5006> for
older perl users.
RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)
+RFC7159 (L<http://www.ietf.org/rfc/rfc7159.txt>)
+
+RFC8259 (L<http://www.ietf.org/rfc/rfc8259.txt>)
+
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
+=head1 CURRENT MAINTAINER
+
+Kenichi Ishigaki, E<lt>ishigaki[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2016 by Makamaka Hannyaharamitu
+Most of the documentation is taken from JSON::XS by Marc Lehmann
+
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff --git a/cpan/JSON-PP/lib/JSON/PP/Boolean.pm
b/cpan/JSON-PP/lib/JSON/PP/Boolean.pm
index 1d1c5c485c..5e65f2fd3e 100644
--- a/cpan/JSON-PP/lib/JSON/PP/Boolean.pm
+++ b/cpan/JSON-PP/lib/JSON/PP/Boolean.pm
@@ -1,14 +1,16 @@
package JSON::PP::Boolean;
use strict;
-use overload (
+require overload;
+local $^W;
+overload::import('overload',
"0+" => sub { ${$_[0]} },
"++" => sub { $_[0] = ${$_[0]} + 1 },
"--" => sub { $_[0] = ${$_[0]} - 1 },
fallback => 1,
);
-$JSON::PP::Boolean::VERSION = '2.97001';
+$JSON::PP::Boolean::VERSION = '4.00';
1;
@@ -31,5 +33,10 @@ L<JSON::PP> for more info about this class.
This idea is from L<JSON::XS::Boolean> written by Marc Lehmann
<schmorp[at]schmorp.de>
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
=cut
diff --git a/cpan/JSON-PP/t/000_load.t b/cpan/JSON-PP/t/000_load.t
index 09e854c1bb..aa238dcf5d 100644
--- a/cpan/JSON-PP/t/000_load.t
+++ b/cpan/JSON-PP/t/000_load.t
@@ -1,6 +1,7 @@
+# copied over from JSON::XS and modified to use JSON::PP
+
BEGIN { $| = 1; print "1..1\n"; }
END {print "not ok 1\n" unless $loaded;}
-
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
use JSON::PP;
diff --git a/cpan/JSON-PP/t/001_utf8.t b/cpan/JSON-PP/t/001_utf8.t
index e78fdcb11f..95dff597c0 100644
--- a/cpan/JSON-PP/t/001_utf8.t
+++ b/cpan/JSON-PP/t/001_utf8.t
@@ -6,22 +6,12 @@ BEGIN { plan tests => 9 };
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
-BEGIN {
- use lib qw(t);
- use _unicode_handling;
-}
-
-
use utf8;
use JSON::PP;
ok (JSON::PP->new->allow_nonref (1)->utf8 (1)->encode ("ü") eq "\"\xc3\xbc\"");
ok (JSON::PP->new->allow_nonref (1)->encode ("ü") eq "\"ü\"");
-
-SKIP: {
- skip "UNICODE handling is disabale.", 7 unless
$JSON::PP::can_handle_UTF16_and_utf8;
-
ok (JSON::PP->new->allow_nonref (1)->ascii (1)->utf8 (1)->encode (chr 0x8000)
eq '"\u8000"');
ok (JSON::PP->new->allow_nonref (1)->ascii (1)->utf8 (1)->pretty (1)->encode
(chr 0x10402) eq "\"\\ud801\\udc02\"\n");
@@ -33,4 +23,3 @@ ok (JSON::PP->new->allow_nonref (1)->decode ('"\u00fc"') eq
"ü");
ok (JSON::PP->new->allow_nonref (1)->decode ('"\ud801\udc02' . "\x{10204}\"")
eq "\x{10402}\x{10204}");
ok (JSON::PP->new->allow_nonref (1)->decode ('"\"\n\\\\\r\t\f\b"') eq
"\"\012\\\015\011\014\010");
-}
diff --git a/cpan/JSON-PP/t/002_error.t b/cpan/JSON-PP/t/002_error.t
index 166bafc367..8d0765d181 100644
--- a/cpan/JSON-PP/t/002_error.t
+++ b/cpan/JSON-PP/t/002_error.t
@@ -2,17 +2,13 @@
use strict;
use Test::More;
-BEGIN { plan tests => 31 };
+BEGIN { plan tests => 35 };
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
-BEGIN {
- use lib qw(t);
- use _unicode_handling;
-}
-
use utf8;
use JSON::PP;
+no warnings;
eval { JSON::PP->new->encode ([\-1]) }; ok $@ =~ /cannot encode reference/;
@@ -21,10 +17,12 @@ eval { JSON::PP->new->encode ([\2]) }; ok $@ =~ /cannot
encode reference/;
eval { JSON::PP->new->encode ([\{}]) }; ok $@ =~ /cannot encode reference/;
eval { JSON::PP->new->encode ([\[]]) }; ok $@ =~ /cannot encode reference/;
eval { JSON::PP->new->encode ([\\1]) }; ok $@ =~ /cannot encode reference/;
+
eval { JSON::PP->new->allow_nonref (1)->decode ('"\u1234\udc00"') }; ok $@ =~
/missing high /;
eval { JSON::PP->new->allow_nonref->decode ('"\ud800"') }; ok $@ =~ /missing
low /;
eval { JSON::PP->new->allow_nonref (1)->decode ('"\ud800\u1234"') }; ok $@ =~
/surrogate pair /;
-eval { JSON::PP->new->decode ('null') }; ok $@ =~ /allow_nonref/;
+
+eval { JSON::PP->new->allow_nonref (0)->decode ('null') }; ok $@ =~
/allow_nonref/;
eval { JSON::PP->new->allow_nonref (1)->decode ('+0') }; ok $@ =~ /malformed/;
eval { JSON::PP->new->allow_nonref->decode ('.2') }; ok $@ =~ /malformed/;
eval { JSON::PP->new->allow_nonref (1)->decode ('bare') }; ok $@ =~
/malformed/;
@@ -48,4 +46,10 @@ eval { JSON::PP->new->decode (*STDERR) }; ok !!$@; # cannot
coerce GLOB
eval { decode_json ("\"\xa0") }; ok $@ =~ /malformed.*character/;
eval { decode_json ("\"\xa0\"") }; ok $@ =~ /malformed.*character/;
+{ #SKIP_UNLESS_XS4_COMPAT 4
+eval { decode_json ("1\x01") }; ok $@ =~ /garbage after/;
+eval { decode_json ("1\x00") }; ok $@ =~ /garbage after/;
+eval { decode_json ("\"\"\x00") }; ok $@ =~ /garbage after/;
+eval { decode_json ("[]\x00") }; ok $@ =~ /garbage after/;
+}
diff --git a/cpan/JSON-PP/t/003_types.t b/cpan/JSON-PP/t/003_types.t
index 22e0f7ec2e..edf2990c84 100644
--- a/cpan/JSON-PP/t/003_types.t
+++ b/cpan/JSON-PP/t/003_types.t
@@ -1,11 +1,12 @@
# copied over from JSON::XS and modified to use JSON::PP
+
use strict;
use Test::More;
-
-BEGIN { plan tests => 78 };
+BEGIN { plan tests => 76 + 2 };
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
+use utf8;
use JSON::PP;
diff --git a/cpan/JSON-PP/t/004_dwiw_encode.t b/cpan/JSON-PP/t/004_dwiw_encode.t
new file mode 100644
index 0000000000..a3329470fc
--- /dev/null
+++ b/cpan/JSON-PP/t/004_dwiw_encode.t
@@ -0,0 +1,71 @@
+# copied over from JSON::XS and modified to use JSON::PP
+
+# copied over from JSON::DWIW and modified to use JSON::PP
+
+# Creation date: 2007-02-20 19:51:06
+# Authors: don
+
+use strict;
+use Test;
+
+# main
+{
+ BEGIN { plan tests => 5 }
+
+ BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
+
+use JSON::PP;
+
+ my $data;
+
+ # my $expected_str =
'{"var1":"val1","var2":["first_element",{"sub_element":"sub_val","sub_element2":"sub_val2"}],"var3":"val3"}';
+
+ my $expected_str1 =
'{"var1":"val1","var2":["first_element",{"sub_element":"sub_val","sub_element2":"sub_val2"}]}';
+ my $expected_str2 =
'{"var2":["first_element",{"sub_element":"sub_val","sub_element2":"sub_val2"}],"var1":"val1"}';
+ my $expected_str3 =
'{"var2":["first_element",{"sub_element2":"sub_val2","sub_element":"sub_val"}],"var1":"val1"}';
+ my $expected_str4 =
'{"var1":"val1","var2":["first_element",{"sub_element2":"sub_val2","sub_element":"sub_val"}]}';
+
+ my $json_obj = JSON::PP->new->allow_nonref (1);
+ my $json_str;
+ # print STDERR "\n" . $json_str . "\n\n";
+
+ my $expected_str;
+
+ $data = 'stuff';
+ $json_str = $json_obj->encode($data);
+ ok($json_str eq '"stuff"');
+
+ $data = "stu\nff";
+ $json_str = $json_obj->encode($data);
+ ok($json_str eq '"stu\nff"');
+
+ $data = [ 1, 2, 3 ];
+ $expected_str = '[1,2,3]';
+ $json_str = $json_obj->encode($data);
+
+ ok($json_str eq $expected_str);
+
+ $data = { var1 => 'val1', var2 => 'val2' };
+ $json_str = $json_obj->encode($data);
+
+ ok($json_str eq '{"var1":"val1","var2":"val2"}'
+ or $json_str eq '{"var2":"val2","var1":"val1"}');
+
+ $data = { var1 => 'val1',
+ var2 => [ 'first_element',
+ { sub_element => 'sub_val', sub_element2 => 'sub_val2'
},
+ ],
+ # var3 => 'val3',
+ };
+
+ $json_str = $json_obj->encode($data);
+
+ ok($json_str eq $expected_str1 or $json_str eq $expected_str2
+ or $json_str eq $expected_str3 or $json_str eq $expected_str4);
+}
+
+exit 0;
+
+###############################################################################
+# Subroutines
+
diff --git a/cpan/JSON-PP/t/005_dwiw_decode.t b/cpan/JSON-PP/t/005_dwiw_decode.t
new file mode 100644
index 0000000000..9bfe2fd07e
--- /dev/null
+++ b/cpan/JSON-PP/t/005_dwiw_decode.t
@@ -0,0 +1,93 @@
+# copied over from JSON::XS and modified to use JSON::PP
+
+# copied over from JSON::DWIW and modified to use JSON::PP
+
+# Creation date: 2007-02-20 21:54:09
+# Authors: don
+
+use strict;
+use warnings;
+use Test;
+
+# main
+{
+ BEGIN { plan tests => 7 }
+
+ BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
+
+use JSON::PP;
+
+ my $json_str =
'{"var1":"val1","var2":["first_element",{"sub_element":"sub_val","sub_element2":"sub_val2"}],"var3":"val3"}';
+
+ my $json_obj = JSON::PP->new->allow_nonref(1);
+ my $data = $json_obj->decode($json_str);
+
+ my $pass = 1;
+ if ($data->{var1} eq 'val1' and $data->{var3} eq 'val3') {
+ if ($data->{var2}) {
+ my $array = $data->{var2};
+ if (ref($array) eq 'ARRAY') {
+ if ($array->[0] eq 'first_element') {
+ my $hash = $array->[1];
+ if (ref($hash) eq 'HASH') {
+ unless ($hash->{sub_element} eq 'sub_val'
+ and $hash->{sub_element2} eq 'sub_val2') {
+ $pass = 0;
+ }
+ }
+ else {
+ $pass = 0;
+ }
+ }
+ else {
+ $pass = 0;
+ }
+ }
+ else {
+ $pass = 0;
+ }
+ }
+ else {
+ $pass = 0;
+ }
+ }
+
+ ok($pass);
+
+ $json_str = '"val1"';
+ $data = $json_obj->decode($json_str);
+ ok($data eq 'val1');
+
+ $json_str = '567';
+ $data = $json_obj->decode($json_str);
+ ok($data == 567);
+
+ $json_str = "5e1";
+ $data = $json_obj->decode($json_str);
+ ok($data == 50);
+
+ $json_str = "5e3";
+ $data = $json_obj->decode($json_str);
+ ok($data == 5000);
+
+ $json_str = "5e+1";
+ $data = $json_obj->decode($json_str);
+ ok($data == 50);
+
+ $json_str = "5e-1";
+ $data = $json_obj->decode($json_str);
+ ok($data == 0.5);
+
+
+
+
+# use Data::Dumper;
+# print STDERR Dumper($test_data) . "\n\n";
+
+}
+
+exit 0;
+
+###############################################################################
+# Subroutines
+
diff --git a/cpan/JSON-PP/t/006_pc_pretty.t b/cpan/JSON-PP/t/006_pc_pretty.t
index 2de5c5d37c..582f882dd6 100644
--- a/cpan/JSON-PP/t/006_pc_pretty.t
+++ b/cpan/JSON-PP/t/006_pc_pretty.t
@@ -56,7 +56,7 @@ is($js,q|{"foo":[{"a":"b"},0,1,2]}|);
$obj = {foo => "bar"};
-$pc->indent(3); # original -- $pc->indent(1);
+$pc->indent(1);
is($pc->encode($obj), qq|{\n "foo":"bar"\n}\n|, "nospace");
$pc->space_after(1);
is($pc->encode($obj), qq|{\n "foo": "bar"\n}\n|, "after");
diff --git a/cpan/JSON-PP/t/007_pc_esc.t b/cpan/JSON-PP/t/007_pc_esc.t
index a5efc8bece..cbe6cd674f 100644
--- a/cpan/JSON-PP/t/007_pc_esc.t
+++ b/cpan/JSON-PP/t/007_pc_esc.t
@@ -7,18 +7,10 @@
use Test::More;
use strict;
-
-BEGIN { plan tests => 18 };
-
+use utf8;
+BEGIN { plan tests => 17 };
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
-BEGIN {
- use lib qw(t);
- use _unicode_handling;
-}
-
-
-use utf8;
use JSON::PP;
#########################
@@ -72,7 +64,6 @@ $obj = {test => "abc\\def"};
$str = $pc->encode($obj);
is($str,q|{"test":"abc\\\\def"}|);
-
$obj = {test => "あいうえお"};
$str = $pc->encode($obj);
is($str,q|{"test":"あいうえお"}|);
@@ -81,7 +72,6 @@ $obj = {"あいうえお" => "かきくけこ"};
$str = $pc->encode($obj);
is($str,q|{"あいうえお":"かきくけこ"}|);
-
$obj = $pc->decode(q|{"id":"abc\ndef"}|);
is($obj->{id},"abc\ndef",q|{"id":"abc\ndef"}|);
@@ -91,7 +81,3 @@ is($obj->{id},"abc\\ndef",q|{"id":"abc\\\ndef"}|);
$obj = $pc->decode(q|{"id":"abc\\\\\ndef"}|);
is($obj->{id},"abc\\\ndef",q|{"id":"abc\\\\\ndef"}|);
-$obj = {test => "\'I said\', \"She said\""};
-$str = $pc->encode($obj);
-is($str,q|{"test":"'I said', \"She said\""}|);
-
diff --git a/cpan/JSON-PP/t/008_pc_base.t b/cpan/JSON-PP/t/008_pc_base.t
index bcc9d8e7bd..d8dc46d779 100644
--- a/cpan/JSON-PP/t/008_pc_base.t
+++ b/cpan/JSON-PP/t/008_pc_base.t
@@ -5,7 +5,6 @@ use Test::More;
use strict;
BEGIN { plan tests => 20 };
-
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
use JSON::PP;
@@ -91,7 +90,7 @@ like($@, qr/JSON can only/i, 'invalid value (coderef)');
#$obj = { foo => bless {}, "Hoge" };
#eval q{ $js = $pc->encode($obj) };
-#like($@, qr/JSON::PP can only/i, 'invalid value (blessd object)');
+#like($@, qr/JSON can only/i, 'invalid value (blessd object)');
$obj = { foo => \$js };
eval q{ $js = $pc->encode($obj) };
diff --git a/cpan/JSON-PP/t/009_pc_extra_number.t
b/cpan/JSON-PP/t/009_pc_extra_number.t
index 25497a6ff8..1712064cb8 100644
--- a/cpan/JSON-PP/t/009_pc_extra_number.t
+++ b/cpan/JSON-PP/t/009_pc_extra_number.t
@@ -4,11 +4,10 @@
use Test::More;
use strict;
BEGIN { plan tests => 6 };
-
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
use JSON::PP;
-
+use utf8;
#########################
my ($js,$obj);
diff --git a/cpan/JSON-PP/t/010_pc_keysort.t b/cpan/JSON-PP/t/010_pc_keysort.t
index c5e5c099a4..cec6fe1936 100644
--- a/cpan/JSON-PP/t/010_pc_keysort.t
+++ b/cpan/JSON-PP/t/010_pc_keysort.t
@@ -4,7 +4,6 @@
use Test::More;
use strict;
BEGIN { plan tests => 1 };
-
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
use JSON::PP;
diff --git a/cpan/JSON-PP/t/011_pc_expo.t b/cpan/JSON-PP/t/011_pc_expo.t
index 154a8256ef..42fe328ede 100644
--- a/cpan/JSON-PP/t/011_pc_expo.t
+++ b/cpan/JSON-PP/t/011_pc_expo.t
@@ -3,8 +3,7 @@
use Test::More;
use strict;
-BEGIN { plan tests => 8 };
-
+BEGIN { plan tests => 8 + 2 };
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
use JSON::PP;
@@ -31,14 +30,14 @@ $js = q|[1.23E-4]|;
$obj = $pc->decode($js);
is($obj->[0], 0.000123, 'digit 1.23E-4');
$js = $pc->encode($obj);
+is($js,'[0.000123]', 'digit 1.23E-4');
-if ( $js =~ /\[1/ ) { # for 5.6.2 on Darwin 8.10.0
- like($js, qr/[1.23[eE]-04]/, 'digit 1.23E-4');
-}
-else {
- is($js,'[0.000123]', 'digit 1.23E-4');
-}
+$js = q|[1.01e+30]|;
+$obj = $pc->decode($js);
+is($obj->[0], 1.01e+30, 'digit 1.01e+30');
+$js = $pc->encode($obj);
+like($js,qr/\[1.01[Ee]\+0?30\]/, 'digit 1.01e+30');
my $vax_float = (pack("d",1) =~ /^[\x80\x10]\x40/);
diff --git a/cpan/JSON-PP/t/012_blessed.t b/cpan/JSON-PP/t/012_blessed.t
index 7f0b41025c..9329eb8b66 100644
--- a/cpan/JSON-PP/t/012_blessed.t
+++ b/cpan/JSON-PP/t/012_blessed.t
@@ -25,7 +25,6 @@ ok ($js->encode ($o1) eq "null");
ok ($js->encode ($o2) eq "null");
$js->convert_blessed;
ok ($js->encode ($o1) eq '{"__":""}');
-
ok ($js->encode ($o2) eq "null");
$js->filter_json_object (sub { 5 });
@@ -48,6 +47,6 @@ ok (9 eq join ":", @{ $js->decode ('[{"a":9}]') });
$js->filter_json_single_key_object ("a");
ok (4 == $js->decode ('[{"a":4}]')->[0]{a});
-#$js->filter_json_single_key_object (a => sub {});
-$js->filter_json_single_key_object (a => sub { return; }); # sub {} is not
suitable for Perl 5.6
+$js->filter_json_single_key_object (a => sub { return; }); # sub {} is not
suitable for Perl 5.6
ok (4 == $js->decode ('[{"a":4}]')->[0]{a});
+
diff --git a/cpan/JSON-PP/t/013_limit.t b/cpan/JSON-PP/t/013_limit.t
index 47bbff9cc1..178a12618a 100644
--- a/cpan/JSON-PP/t/013_limit.t
+++ b/cpan/JSON-PP/t/013_limit.t
@@ -1,6 +1,7 @@
+# copied over from JSON::XS and modified to use JSON::PP
+
use strict;
use Test::More;
-
BEGIN { plan tests => 11 };
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
@@ -11,9 +12,7 @@ use JSON::PP;
my $def = 512;
my $js = JSON::PP->new;
-
-{
- local $^W = undef; # avoid for warning 'Deep recursion on subroutin'
+local $^W; # to silence Deep recursion warnings
ok (!eval { $js->decode (("[" x ($def + 1)) . ("]" x ($def + 1))) });
ok (ref $js->decode (("[" x $def) . ("]" x $def)));
@@ -31,4 +30,3 @@ ok (!eval { $js->encode ([[{}]]), 1 });
ok (eval { ref $js->max_size (8)->decode ("[ ]") });
eval { $js->max_size (8)->decode ("[ ]") }; ok ($@ =~ /max_size/);
-}
diff --git a/cpan/JSON-PP/t/014_latin1.t b/cpan/JSON-PP/t/014_latin1.t
index 6c02d62770..30692193f0 100644
--- a/cpan/JSON-PP/t/014_latin1.t
+++ b/cpan/JSON-PP/t/014_latin1.t
@@ -1,27 +1,18 @@
# copied over from JSON::XS and modified to use JSON::PP
-use Test::More;
use strict;
+use Test::More;
BEGIN { plan tests => 4 };
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
-BEGIN {
- use lib qw(t);
- use _unicode_handling;
-}
-
use JSON::PP;
-SKIP: {
- skip "UNICODE handling is disabale.", 4 unless
$JSON::PP::can_handle_UTF16_and_utf8;
-
-my $xs = JSON::PP->new->latin1->allow_nonref;
+my $pp = JSON::PP->new->latin1->allow_nonref;
-ok $xs->encode ("\x{12}\x{89} ") eq "\"\\u0012\x{89} \"";
-ok $xs->encode ("\x{12}\x{89}\x{abc}") eq "\"\\u0012\x{89}\\u0abc\"";
+ok ($pp->encode ("\x{12}\x{89} ") eq "\"\\u0012\x{89} \"");
+ok ($pp->encode ("\x{12}\x{89}\x{abc}") eq "\"\\u0012\x{89}\\u0abc\"");
-ok $xs->decode ("\"\\u0012\x{89}\"" ) eq "\x{12}\x{89}";
-ok $xs->decode ("\"\\u0012\x{89}\\u0abc\"") eq "\x{12}\x{89}\x{abc}";
+ok ($pp->decode ("\"\\u0012\x{89}\"" ) eq "\x{12}\x{89}");
+ok ($pp->decode ("\"\\u0012\x{89}\\u0abc\"") eq "\x{12}\x{89}\x{abc}");
-}
diff --git a/cpan/JSON-PP/t/015_prefix.t b/cpan/JSON-PP/t/015_prefix.t
index b6474fede6..d4e8b37859 100644
--- a/cpan/JSON-PP/t/015_prefix.t
+++ b/cpan/JSON-PP/t/015_prefix.t
@@ -1,16 +1,19 @@
# copied over from JSON::XS and modified to use JSON::PP
-BEGIN { $| = 1; print "1..4\n"; }
+use strict;
+use Test::More;
+BEGIN { plan tests => 4 };
+
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
use JSON::PP;
-my $xs = JSON::PP->new->allow_nonref;
+my $pp = JSON::PP->new->latin1->allow_nonref;
-eval { $xs->decode ("[] ") };
-print $@ ? "not " : "", "ok 1\n";
-eval { $xs->decode ("[] x") };
-print $@ ? "" : "not ", "ok 2\n";
-print 2 == ($xs->decode_prefix ("[][]"))[1] ? "" : "not ", "ok 3\n";
-print 3 == ($xs->decode_prefix ("[1] t"))[1] ? "" : "not ", "ok 4\n";
+eval { $pp->decode ("[] ") };
+ok (!$@);
+eval { $pp->decode ("[] x") };
+ok ($@);
+ok (2 == ($pp->decode_prefix ("[][]"))[1]);
+ok (3 == ($pp->decode_prefix ("[1] t"))[1]);
diff --git a/cpan/JSON-PP/t/016_tied.t b/cpan/JSON-PP/t/016_tied.t
index 96035fea6c..63d912e662 100644
--- a/cpan/JSON-PP/t/016_tied.t
+++ b/cpan/JSON-PP/t/016_tied.t
@@ -10,6 +10,7 @@ use JSON::PP;
use Tie::Hash;
use Tie::Array;
+
my $js = JSON::PP->new;
tie my %h, 'Tie::StdHash';
diff --git a/cpan/JSON-PP/t/017_relaxed.t b/cpan/JSON-PP/t/017_relaxed.t
index 243f9973e4..34fb60ead5 100644
--- a/cpan/JSON-PP/t/017_relaxed.t
+++ b/cpan/JSON-PP/t/017_relaxed.t
@@ -1,17 +1,11 @@
# copied over from JSON::XS and modified to use JSON::PP
-use Test::More;
use strict;
-
+use Test::More;
BEGIN { plan tests => 8 };
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
-BEGIN {
- use lib qw(t);
- use _unicode_handling;
-}
-
use utf8;
use JSON::PP;
diff --git a/cpan/JSON-PP/t/018_json_checker.t
b/cpan/JSON-PP/t/018_json_checker.t
index 1e84987e6e..558861e04b 100644
--- a/cpan/JSON-PP/t/018_json_checker.t
+++ b/cpan/JSON-PP/t/018_json_checker.t
@@ -1,25 +1,25 @@
+# copied over from JSON::XS and modified to use JSON::PP
+
# use the testsuite from http://www.json.org/JSON_checker/
# except for fail18.json, as we do not support a depth of 20 (but 16 and 32).
-# copied over from JSON::XS and modified to use JSON::PP
-
use strict;
-#no warnings;
-local $^W = undef;
+no warnings;
use Test::More;
-BEGIN { plan tests => 39 };
+BEGIN { plan tests => 38 };
+
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
use JSON::PP;
+# emulate JSON_checker default config
my $json = JSON::PP->new->utf8->max_depth(32)->canonical;
my $vax_float = (pack("d",1) =~ /^[\x80\x10]\x40/);
binmode DATA;
-my $num = 1;
-for (;;) {
+for (;;) {
$/ = "\n# ";
chomp (my $test = <DATA>)
or last;
@@ -28,19 +28,16 @@ for (;;) {
if ($vax_float && $name =~ /pass1.json/) {
$test =~ s/\b23456789012E66\b/23456789012E20/;
}
+
if (my $perl = eval { $json->decode ($test) }) {
ok ($name =~ /^pass/, $name);
-#print $json->encode ($perl), "\n";
is ($json->encode ($json->decode ($json->encode ($perl))), $json->encode
($perl));
} else {
ok ($name =~ /^fail/, "$name ($@)");
}
-
}
__DATA__
-"A JSON::PP payload should be an object or array, not a string."
-# fail1.json
{"Extra value after close": true} "misplaced quoted value"
# fail10.json
{"Illegal expression": 1 + 2}
@@ -108,7 +105,7 @@ break"]
{"Extra comma": true,}
# fail9.json
[
- "JSON::PP Test Pattern pass1",
+ "JSON Test Pattern pass1",
{"object with 1 member":["array with 1 element"]},
{},
[],
@@ -141,7 +138,7 @@ break"]
"array":[ ],
"object":{ },
"address": "50 St. James Street",
- "url": "http://www.JSON::PP.org/";,
+ "url": "http://www.JSON.org/";,
"comment": "// /* <!-- --",
"# -- --> */": " ",
" s p a c e d " :[1,2 , 3
@@ -169,7 +166,7 @@ break"]
[[[[[[[[[[[[[[[[[[["Not too deep"]]]]]]]]]]]]]]]]]]]
# pass2.json
{
- "JSON::PP Test Pattern pass3": {
+ "JSON Test Pattern pass3": {
"The outermost value": "must be an object or array.",
"In this test": "It is an object."
}
diff --git a/cpan/JSON-PP/t/019_incr.t b/cpan/JSON-PP/t/019_incr.t
index 9d4710bbd9..4e339823d1 100644
--- a/cpan/JSON-PP/t/019_incr.t
+++ b/cpan/JSON-PP/t/019_incr.t
@@ -1,22 +1,19 @@
# copied over from JSON::XS and modified to use JSON::PP
use strict;
-
+no warnings;
use Test::More;
-BEGIN { plan tests => 697 };
-BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
+BEGIN { plan tests => 745 };
+BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
use JSON::PP;
-if ( $] >= 5.006 ) {
-
-eval <<'TEST' or die "Failed to eval test code for version $]: $@";
-
sub splitter {
my ($coder, $text) = @_;
- $coder->canonical(1) if $] >= 5.017009;
+ # work around hash randomisation bug introduced in 5.18
+ $coder->canonical;
for (0 .. length $text) {
my $a = substr $text, 0, $_;
@@ -26,20 +23,25 @@ sub splitter {
$coder->incr_parse ($b);
my $data = $coder->incr_parse;
- ok ($data);
- is ($coder->encode ($data), $coder->encode ($coder->decode ($text)),
"data");
+ #ok (defined $data, "split<$a><$b>");
+ ok (defined $data, "split");
+ my $e1 = $coder->encode ($data);
+ my $e2 = $coder->encode ($coder->decode ($text));
+ #ok ($e1 eq $e2, "data<$a><$b><$e1><$e2>");
+ #ok ($coder->incr_text =~ /^\s*$/, "tailws<$a><$b>");
+ ok ($e1 eq $e2, "data");
ok ($coder->incr_text =~ /^\s*$/, "tailws");
}
}
-
-
-splitter +JSON::PP->new , ' ["x\\"","\\u1000\\\\n\\nx",1,{"\\\\"
:5 , "": "x"}]';
-splitter +JSON::PP->new , '[ "x\\"","\\u1000\\\\n\\nx" , 1,{"\\\\
" :5 , "": " x"} ] ';
-splitter +JSON::PP->new->allow_nonref, '"test"';
-splitter +JSON::PP->new->allow_nonref, ' "5" ';
-
-
+splitter +JSON::PP->new->allow_nonref (0), '
["x\\"","\\u1000\\\\n\\nx",1,{"\\\\" :5 , "": "x"}]';
+splitter +JSON::PP->new->allow_nonref (0), '[ "x\\"","\\u1000\\\\n\\nx" ,
1,{"\\\\ " :5 , "": " x"} ] ';
+splitter +JSON::PP->new , '"test"';
+splitter +JSON::PP->new , ' "5" ';
+splitter +JSON::PP->new , '-1e5';
+{ #SKIP_UNLESS_PP 3, 33
+splitter +JSON::PP->new , ' 0.00E+00 ';
+}
{
my $text = '[5],{"":1} , [ 1,2, 3], {"3":null}';
@@ -75,107 +77,32 @@ splitter +JSON::PP->new->allow_nonref, ' "5" ';
ok ('[5]' eq $coder->encode (scalar $coder->incr_parse), "sparse3");
}
-1
-TEST
-
-
-}
-else {
-
-
-eval <<'TEST' or die "Failed to eval test code for version $]: $@";
-
-my $incr_text;
-
-sub splitter {
- my ($coder, $text) = @_;
-
- for (0 .. length $text) {
- my $a = substr $text, 0, $_;
- my $b = substr $text, $_;
-
- $coder->incr_parse ($a);
- $coder->incr_parse ($b);
-
- my $data = $coder->incr_parse;
- ok ($data);
- ok ($coder->encode ($data) eq $coder->encode ($coder->decode ($text)),
"data");
- ok (($incr_text = $coder->incr_text) =~ /^\s*$/, "tailws");
- }
-}
-
-splitter +JSON::PP->new , ' ["x\\"","\\u1000\\\\n\\nx",1,{"\\\\"
:5 , "": "x"}]';
-splitter +JSON::PP->new , '[ "x\\"","\\u1000\\\\n\\nx" , 1,{"\\\\
" :5 , "": " x"} ] ';
-splitter +JSON::PP->new->allow_nonref, '"test"';
-splitter +JSON::PP->new->allow_nonref, ' "5" ';
-
-
-{
- my $text = '[5],{"":1} , [ 1,2, 3], {"3":null}';
- my $coder = new JSON::PP;
- for (0 .. length $text) {
- my $a = substr $text, 0, $_;
- my $b = substr $text, $_;
-
- $coder->incr_parse ($a);
- $coder->incr_parse ($b);
-
- my $j1 = $coder->incr_parse; ok ( $coder->incr_text( ($incr_text =
$coder->incr_text) =~ s/^\s*,// and $incr_text ), "cskip1");
- my $j2 = $coder->incr_parse; ok ( $coder->incr_text( ($incr_text =
$coder->incr_text) =~ s/^\s*,// and $incr_text ), "cskip2");
- my $j3 = $coder->incr_parse; ok ( $coder->incr_text( ($incr_text =
$coder->incr_text) =~ s/^\s*,// and $incr_text ), "cskip3");
- my $j4 = $coder->incr_parse; ok (($incr_text = $coder->incr_text) !~
s/^\s*,//, "cskip4");
- my $j5 = $coder->incr_parse; ok (($incr_text = $coder->incr_text) !~
s/^\s*,//, "cskip5");
-
- ok ('[5]' eq encode_json $j1, "cjson1");
- ok ('{"":1}' eq encode_json $j2, "cjson2");
- ok ('[1,2,3]' eq encode_json $j3, "cjson3");
- ok ('{"3":null}' eq encode_json $j4, "cjson4");
- ok (!defined $j5, "cjson5");
- }
-}
-
-{
- my $text = '[x][5]';
- my $coder = new JSON::PP;
- $coder->incr_parse ($text);
- ok (!eval { $coder->incr_parse }, "sparse1");
- ok (!eval { $coder->incr_parse }, "sparse2");
- $coder->incr_skip;
- ok ('[5]' eq $coder->encode (scalar $coder->incr_parse), "sparse3");
-}
-
-
-TEST
-
-} # for 5.005
-
-
-
-
{
my $coder = JSON::PP->new->max_size (5);
ok (!$coder->incr_parse ("[ "), "incsize1");
- eval q{ !$coder->incr_parse ("] ") }; ok ($@ =~ /6 bytes/, "incsize2 $@");
+ eval { !$coder->incr_parse ("] ") }; ok ($@ =~ /6 bytes/, "incsize2 $@");
}
{
my $coder = JSON::PP->new->max_depth (3);
ok (!$coder->incr_parse ("[[["), "incdepth1");
- eval q{ !$coder->incr_parse (" [] ") }; ok ($@ =~ /maximum nesting/,
"incdepth2 $@");
+ eval { !$coder->incr_parse (" [] ") }; ok ($@ =~ /maximum nesting/,
"incdepth2 $@");
}
+# contributed by yuval kogman, reformatted to fit style
{
my $coder = JSON::PP->new;
-
+
my $res = eval { $coder->incr_parse("]") };
my $e = $@; # test more clobbers $@, we need it twice
-
- ok(!$res, "unbalanced bracket" );
- ok($e, "got error");
- like( $e, qr/malformed/, "malformed json string error" );
-
+
+ ok (!$res, "unbalanced bracket");
+ ok ($e, "got error");
+ like ($e, qr/malformed/, "malformed json string error");
+
$coder->incr_skip;
-
- is_deeply(eval { $coder->incr_parse("[42]") }, [42], "valid data after
incr_skip");
+
+ is_deeply (eval { $coder->incr_parse("[42]") }, [42], "valid data after
incr_skip");
}
+
diff --git a/cpan/JSON-PP/t/020_faihu.t b/cpan/JSON-PP/t/020_faihu.t
new file mode 100644
index 0000000000..3aa2902a9c
--- /dev/null
+++ b/cpan/JSON-PP/t/020_faihu.t
@@ -0,0 +1,32 @@
+# copied over from JSON::XS and modified to use JSON::PP
+
+# adapted from a test by Aristotle Pagaltzis
(http://intertwingly.net/blog/2007/11/15/Astral-Plane-Characters-in-Json)
+
+use strict;
+use warnings;
+
+BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
+
+BEGIN { if ($] < 5.008) { require Test::More; Test::More::plan(skip_all =>
"requires Perl 5.8 or later"); } };
+
+use JSON::PP;
+use Encode qw(encode decode);
+
+use Test::More tests => 3;
+
+my ($faihu, $faihu_json, $roundtrip, $js) = "\x{10346}";
+
+$js = JSON::PP->new->allow_nonref->ascii;
+$faihu_json = $js->encode($faihu);
+$roundtrip = $js->decode($faihu_json);
+is ($roundtrip, $faihu, 'JSON in ASCII roundtrips correctly');
+
+$js = JSON::PP->new->allow_nonref->utf8;
+$faihu_json = $js->encode ($faihu);
+$roundtrip = $js->decode ($faihu_json);
+is ($roundtrip, $faihu, 'JSON in UTF-8 roundtrips correctly');
+
+$js = JSON::PP->new->allow_nonref;
+$faihu_json = encode 'UTF-16BE', $js->encode ($faihu);
+$roundtrip = $js->decode( decode 'UTF-16BE', $faihu_json);
+is ($roundtrip, $faihu, 'JSON with external recoding roundtrips correctly' );
diff --git a/cpan/JSON-PP/t/021_evans.t b/cpan/JSON-PP/t/021_evans.t
new file mode 100644
index 0000000000..655f6fc2fe
--- /dev/null
+++ b/cpan/JSON-PP/t/021_evans.t
@@ -0,0 +1,25 @@
+# copied over from JSON::XS and modified to use JSON::PP
+
+# adapted from a test by Martin Evans
+
+use strict;
+use warnings;
+
+BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
+
+use JSON::PP;
+
+print "1..1\n";
+
+my $data = ["\x{53f0}\x{6240}\x{306e}\x{6d41}\x{3057}",
+ "\x{6c60}\x{306e}\x{30ab}\x{30a8}\x{30eb}"];
+my $js = JSON::PP->new->encode ($data);
+my $j = new JSON::PP;
+my $object = $j->incr_parse ($js);
+
+die "no object" if !$object;
+
+eval { $j->incr_text };
+
+print $@ ? "not " : "", "ok 1 # $@\n";
+
diff --git a/cpan/JSON-PP/t/021_evans_bugrep.t
b/cpan/JSON-PP/t/021_evans_bugrep.t
deleted file mode 100644
index ecbfcddc1d..0000000000
--- a/cpan/JSON-PP/t/021_evans_bugrep.t
+++ /dev/null
@@ -1,49 +0,0 @@
-use strict;
-use Test::More;
-
-BEGIN { plan tests => 6 };
-
-BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
-
-BEGIN {
- use lib qw(t);
- use _unicode_handling;
-}
-
-
-use JSON::PP;
-
-
-my $data = ["\x{3042}\x{3044}\x{3046}\x{3048}\x{304a}",
- "\x{304b}\x{304d}\x{304f}\x{3051}\x{3053}"];
-
-my $j = new JSON::PP;
-my $js = $j->encode($data);
-$j = undef;
-
-my @parts = (substr($js, 0, int(length($js) / 2)),
- substr($js, int(length($js) / 2)));
-$j = JSON::PP->new;
-my $object = $j->incr_parse($parts[0]);
-
-ok( !defined $object );
-
-eval {
- $j->incr_text;
-};
-
-like( $@, qr/incr_text can ?not be called when the incremental parser already
started parsing/ );
-
-$object = $j->incr_parse($parts[1]);
-
-ok( defined $object );
-
-is( $object->[0], $data->[0] );
-is( $object->[1], $data->[1] );
-
-eval {
- $j->incr_text;
-};
-
-ok( !$@ );
-
diff --git a/cpan/JSON-PP/t/022_comment_at_eof.t
b/cpan/JSON-PP/t/022_comment_at_eof.t
index b235b1f2f9..5cb7f21e25 100644
--- a/cpan/JSON-PP/t/022_comment_at_eof.t
+++ b/cpan/JSON-PP/t/022_comment_at_eof.t
@@ -1,6 +1,9 @@
-# the oritinal test case was provided by ikeg...@cpan.org
+# copied over from JSON::XS and modified to use JSON::PP
+
+# the original test case was provided by ikeg...@cpan.org
use strict;
+use warnings;
use Test::More tests => 13;
@@ -29,7 +32,6 @@ sub decoder {
return Dumper($rv);
}
-
is( decoder( "[]" ), '[]', 'array baseline' );
is( decoder( " []" ), '[]', 'space ignored before array' );
is( decoder( "\n[]" ), '[]', 'newline ignored before array' );
@@ -44,4 +46,5 @@ is( decoder( "\n" ), 'undef', 'newline ignored before
eof' );
is( decoder( "#,foo\n" ), 'undef', 'comment ignored before eof' );
is( decoder( "# []o\n" ), 'undef', 'comment ignored before eof' );
-is( decoder( qq/#\n[#foo\n"#\\n"#\n]/), '["#\n"]', 'array and string in
multiple lines' );
+is( decoder(qq/#\n[#foo\n"#\\n"#\n]/), '["#\n"]', 'array and string in
multiple lines' );
+
diff --git a/cpan/JSON-PP/t/052_object.t b/cpan/JSON-PP/t/052_object.t
new file mode 100644
index 0000000000..020db32cbb
--- /dev/null
+++ b/cpan/JSON-PP/t/052_object.t
@@ -0,0 +1,58 @@
+# copied over from JSON::XS and modified to use JSON::PP
+
+use strict;
+use Test::More;
+BEGIN { plan tests => 20 };
+BEGIN { $^W = 0 } # hate
+
+BEGIN { $ENV{PERL_JSON_BACKEND} = 0; }
+
+use JSON::PP;
+
+my $json = JSON::PP->new->convert_blessed->allow_tags->allow_nonref;
+
+ok (1);
+
+sub JSON::PP::tojson::TO_JSON {
+ ok (@_ == 1);
+ ok (JSON::PP::tojson:: eq ref $_[0]);
+ ok ($_[0]{k} == 1);
+ 7
+}
+
+my $obj = bless { k => 1 }, JSON::PP::tojson::;
+
+ok (1);
+
... 330 lines suppressed ...
--
Perl5 Master Repository
