From 5eabe05513a5c4b2372fe96af04305ab920fa86a Mon Sep 17 00:00:00 2001 From: Nicolas R Date: Thu, 14 Feb 2019 10:30:34 -0600 Subject: 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 --- 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 written by Marc Lehmann in C. JSON::PP works as a fallback module when you use L 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. +strings. All boolean flags described below are by default I +(with the exception of C, which defaults to I 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", + "HelloWorld", # literal 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 method can convert a non-reference into its corresponding string, number or null JSON value, which is an extension to RFC4627. Likewise, C 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 will croak if given something that is not a JSON object or array. -Example, encode a Perl scalar as JSON value with enabled C, -resulting in an invalid JSON text: +Example, encode a Perl scalar as JSON value without enabled C, +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. +=head2 allow_tags + + $json = $json->allow_tags([$enable]) + + $enabled = $json->get_allow_tags + +See L for details. + +If C<$enable> is true (or missing), then C, upon encountering a +blessed object, will check for the availability of the C 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 to parse such tagged JSON values and deserialise +them via a call to the C method. + +If C<$enable> is false (the default), then C will not consider +this type of conversion, and tagged JSON values will cause a parse error +in C, 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 will be decoded as a copy of C<$false>, and JSON +C 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. You can set incompatible +boolean objects (like L), but when you C a data structure +with such boolean objects, you still need to enable C +(and add a C method if necessary). + +Calling this method without any arguments will reset the booleans +to their default values. + +C 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 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 C, 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 C, 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 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, a fork of JSON::XS by Reini Urban, which -supports some of these. +you might want to try L, 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 will accept invalid JSON texts that contain strings that begin and end with -single quotation marks. C will not be affected in anyway. +single quotation marks. C will not be affected in any way. I. 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 will accept invalid JSON texts that contain JSON objects whose names don't begin and end with quotation marks. C will not be affected -in anyway. I. 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. If C<$enable> is true (or missing), then C will accept invalid JSON texts that contain unescaped [\x00-\x1f\x22\x5c] -characters. C will not be affected in anyway. +characters. C will not be affected in any way. I. 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 will not be affected in anyway. +C 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 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)I >>). + +Another nonstandard extension to the JSON syntax, enabled with the +C setting, are tagged values. In this implementation, the +I must be a perl package/class name encoded as a JSON string, and the +I must be a JSON array encoding optional constructor arguments. + +See L, 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 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 encounters a Perl object depends on the -C, C and C settings, which are -used in this order: +C, C, C and C +settings, which are used in this order: =over 4 -=item 1. C is enabled and the object has a C method. +=item 1. C is enabled and the object has a C method. + +In this case, C creates a tagged JSON value, using a nonstandard +extension to the JSON syntax. + +This works by invoking the C method on the object, with the first +argument being the object to serialise, and the second argument being the +constant string C to distinguish it from other serialisers. + +The C 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 C method might use the +objects C and C members to encode the object: + + sub My::Object::FREEZE { + my ($self, $serialiser) = @_; + + ($self->{type}, $self->{id}) + } + +=item 2. C is enabled and the object has a C method. In this case, the C 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 objects is lost. $uri->as_string } -=item 2. C is enabled and the object is a C or C. +=item 3. C is enabled and the object is a C or C. The object will be serialised as a JSON number value. -=item 3. C is enabled. +=item 4. C 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 throws an exception. =back +=head3 DESERIALISATION + +For deserialisation there are only two cases to consider: either +nonstandard tagging was used, in which case C decides, +or objects cannot be automatically be deserialised, in which +case you can use postprocessing or the C or +C 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 is disabled, a parse +error will result (as if tagged values were not part of the grammar). + +If C is enabled, C will look up the C 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 method is invoked with the classname as first +argument, the constant string C as second argument, and all the +values from the JSON array (the values originally returned by the +C 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 setting to +make that work in all cases, so better return an actual blessed reference. + +As an example, let's implement a C function that regenerates the +C from the C 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 + +L + +As for new features and requests to change common behaviors, please +ask the author of JSON::XS (Marc Lehmann, Eschmorp[at]schmorp.deE) +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, which is smaller and +written in a much cleaner way than this module. + =head1 SEE ALSO The F command line utility for quick experiments. @@ -2838,15 +3123,24 @@ L and L for older perl users. RFC4627 (L) +RFC7159 (L) + +RFC8259 (L) + =head1 AUTHOR Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE +=head1 CURRENT MAINTAINER + +Kenichi Ishigaki, Eishigaki[at]cpan.orgE =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 for more info about this class. This idea is from L written by Marc Lehmann +=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 = ) 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 IKEGAMI@cpan.org +# copied over from JSON::XS and modified to use JSON::PP + +# the original test case was provided by IKEGAMI@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); + +my $enc = $json->encode ($obj); +ok ($enc eq 7); + +ok (1); + +sub JSON::PP::freeze::FREEZE { + ok (@_ == 2); + ok ($_[1] eq "JSON"); + ok (JSON::PP::freeze:: eq ref $_[0]); + ok ($_[0]{k} == 1); + (3, 1, 2) +} + +sub JSON::PP::freeze::THAW { + ok (@_ == 5); + ok (JSON::PP::freeze:: eq $_[0]); + ok ($_[1] eq "JSON"); + ok ($_[2] == 3); + ok ($_[3] == 1); + ok ($_[4] == 2); + 777 +} + +my $obj = bless { k => 1 }, JSON::PP::freeze::; +my $enc = $json->encode ($obj); +ok ($enc eq '("JSON::PP::freeze")[3,1,2]'); + +my $dec = $json->decode ($enc); +ok ($dec eq 777); + +ok (1); + diff --git a/cpan/JSON-PP/t/099_binary.t b/cpan/JSON-PP/t/099_binary.t index e924305e03..2daa5b6469 100644 --- a/cpan/JSON-PP/t/099_binary.t +++ b/cpan/JSON-PP/t/099_binary.t @@ -1,53 +1,44 @@ # copied over from JSON::XS and modified to use JSON::PP -use Test::More; use strict; -BEGIN { plan tests => 2432 }; +use Test::More; +BEGIN { plan tests => 24576 }; BEGIN { $ENV{PERL_JSON_BACKEND} = 0; } -BEGIN { - use lib qw(t); - use _unicode_handling; -} - use JSON::PP; -SKIP: { - skip "UNICODE handling is disabale.", 2432 unless $JSON::PP::can_handle_UTF16_and_utf8; sub test($) { my $js; $js = JSON::PP->new->allow_nonref(0)->utf8->ascii->shrink->encode ([$_[0]]); - ok ($_[0] eq ((decode_json $js)->[0])); + ok ($_[0] eq ((decode_json $js)->[0]), " - 0"); $js = JSON::PP->new->allow_nonref(0)->utf8->ascii->encode ([$_[0]]); - ok ($_[0] eq (JSON::PP->new->utf8->shrink->decode($js))->[0]); + ok ($_[0] eq (JSON::PP->new->utf8->shrink->decode($js))->[0], " - 1"); $js = JSON::PP->new->allow_nonref(0)->utf8->shrink->encode ([$_[0]]); - ok ($_[0] eq ((decode_json $js)->[0])); + ok ($_[0] eq ((decode_json $js)->[0]), " - 2"); $js = JSON::PP->new->allow_nonref(1)->utf8->encode ([$_[0]]); - ok ($_[0] eq (JSON::PP->new->utf8->shrink->decode($js))->[0]); + ok ($_[0] eq (JSON::PP->new->utf8->shrink->decode($js))->[0], " - 3"); $js = JSON::PP->new->allow_nonref(1)->ascii->encode ([$_[0]]); - ok ($_[0] eq JSON::PP->new->decode ($js)->[0]); + ok ($_[0] eq JSON::PP->new->decode ($js)->[0], " - 4"); $js = JSON::PP->new->allow_nonref(0)->ascii->encode ([$_[0]]); - ok ($_[0] eq JSON::PP->new->shrink->decode ($js)->[0]); + ok ($_[0] eq JSON::PP->new->shrink->decode ($js)->[0], " - 5"); $js = JSON::PP->new->allow_nonref(1)->shrink->encode ([$_[0]]); - ok ($_[0] eq JSON::PP->new->decode ($js)->[0]); + ok ($_[0] eq JSON::PP->new->decode ($js)->[0], " - 6"); $js = JSON::PP->new->allow_nonref(0)->encode ([$_[0]]); - ok ($_[0] eq JSON::PP->new->shrink->decode ($js)->[0]); + ok ($_[0] eq JSON::PP->new->shrink->decode ($js)->[0], " - 7"); } srand 0; # doesn't help too much, but its at least more deterministic -#for (1..768) { -for (1..64, 125..129, 255..257, 512, 704, 736, 768) { +for (1..768) { test join "", map chr ($_ & 255), 0..$_; test join "", map chr rand 255, 0..$_; test join "", map chr ($_ * 97 & ~0x4000), 0..$_; test join "", map chr (rand (2**20) & ~0x800), 0..$_; } -} diff --git a/cpan/JSON-PP/t/108_decode.t b/cpan/JSON-PP/t/108_decode.t index ae645e99a7..438aeeed32 100644 --- a/cpan/JSON-PP/t/108_decode.t +++ b/cpan/JSON-PP/t/108_decode.t @@ -10,11 +10,6 @@ BEGIN { $ENV{PERL_JSON_BACKEND} = 0; } use JSON::PP; -BEGIN { - use lib qw(t); - use _unicode_handling; -} - no utf8; my $json = JSON::PP->new->allow_nonref; diff --git a/cpan/JSON-PP/t/109_encode.t b/cpan/JSON-PP/t/109_encode.t index 7526315a72..ce7f5104bc 100644 --- a/cpan/JSON-PP/t/109_encode.t +++ b/cpan/JSON-PP/t/109_encode.t @@ -10,11 +10,6 @@ BEGIN { $ENV{PERL_JSON_BACKEND} = 0; } use JSON::PP; -BEGIN { - use lib qw(t); - use _unicode_handling; -} - no utf8; my $json = JSON::PP->new->allow_nonref; diff --git a/cpan/JSON-PP/t/112_upgrade.t b/cpan/JSON-PP/t/112_upgrade.t index 1b06dd38d5..1e319dc56c 100644 --- a/cpan/JSON-PP/t/112_upgrade.t +++ b/cpan/JSON-PP/t/112_upgrade.t @@ -7,11 +7,6 @@ BEGIN { $ENV{PERL_JSON_BACKEND} = 0; } use JSON::PP; -BEGIN { - use lib qw(t); - use _unicode_handling; -} - my $json = JSON::PP->new->allow_nonref->utf8; my $str = '\\u00c8'; @@ -22,10 +17,7 @@ my $value = $json->decode( '"\\u00c8"' ); is( $value, chr 0xc8 ); -SKIP: { - skip "UNICODE handling is disabale.", 1 unless $JSON::PP::can_handle_UTF16_and_utf8; - ok( utf8::is_utf8( $value ) ); -} +ok( utf8::is_utf8( $value ) ); eval { $json->decode( '"' . chr(0xc8) . '"' ) }; ok( $@ =~ /malformed UTF-8 character in JSON string/ ); diff --git a/cpan/JSON-PP/t/114_decode_prefix.t b/cpan/JSON-PP/t/114_decode_prefix.t index 915ea1532e..10048d3acc 100644 --- a/cpan/JSON-PP/t/114_decode_prefix.t +++ b/cpan/JSON-PP/t/114_decode_prefix.t @@ -20,8 +20,8 @@ is( ( $json->decode_prefix( $garbaged_text2 ) ) [1], 13 ); is( ( $json->decode_prefix( $garbaged_text3 ) ) [1], 13 ); eval { $json->decode( "\n" ) }; ok( $@ =~ /malformed JSON/ ); -eval { $json->decode('null') }; ok $@ =~ /allow_nonref/; +eval { $json->allow_nonref(0)->decode('null') }; ok $@ =~ /allow_nonref/; eval { $json->decode_prefix( "\n" ) }; ok( $@ =~ /malformed JSON/ ); -eval { $json->decode_prefix('null') }; ok $@ =~ /allow_nonref/; +eval { $json->allow_nonref(0)->decode_prefix('null') }; ok $@ =~ /allow_nonref/; diff --git a/cpan/JSON-PP/t/116_incr_parse_fixed.t b/cpan/JSON-PP/t/116_incr_parse_fixed.t index 36e84de7fa..c00f023e21 100644 --- a/cpan/JSON-PP/t/116_incr_parse_fixed.t +++ b/cpan/JSON-PP/t/116_incr_parse_fixed.t @@ -3,7 +3,7 @@ use Test::More tests => 4; use JSON::PP; -my $json = JSON::PP->new->allow_nonref(); +my $json = JSON::PP->new->allow_nonref(1); my @vs = $json->incr_parse('"a\"bc'); @@ -14,7 +14,7 @@ ok( not scalar(@vs) ); is( $vs[0], "a\"bc" ); -$json = JSON::PP->new; +$json = JSON::PP->new->allow_nonref(0); @vs = $json->incr_parse('"a\"bc'); ok( not scalar(@vs) ); diff --git a/cpan/JSON-PP/t/117_numbers.t b/cpan/JSON-PP/t/117_numbers.t index 73b2a6c826..a9d3df810d 100644 --- a/cpan/JSON-PP/t/117_numbers.t +++ b/cpan/JSON-PP/t/117_numbers.t @@ -1,6 +1,7 @@ use Test::More; use strict; BEGIN { $ENV{PERL_JSON_BACKEND} = 0; } +BEGIN { $ENV{PERL_JSON_PP_USE_B} = 0 } use JSON::PP; #SKIP_ALL_UNLESS_PP 2.90 diff --git a/cpan/JSON-PP/t/118_boolean_values.t b/cpan/JSON-PP/t/118_boolean_values.t new file mode 100644 index 0000000000..1a5d175254 --- /dev/null +++ b/cpan/JSON-PP/t/118_boolean_values.t @@ -0,0 +1,80 @@ +use strict; +use Test::More; +BEGIN { $ENV{PERL_JSON_BACKEND} = 0; } +use JSON::PP; + +BEGIN { plan skip_all => "requires Perl 5.008 or later" if $] < 5.008 } + +#SKIP_ALL_UNLESS_XS4_COMPAT + +package # + Dummy::True; +*Dummy::True:: = *JSON::PP::Boolean::; + +package # + Dummy::False; +*Dummy::False:: = *JSON::PP::Boolean::; + +package main; + +my $dummy_true = bless \(my $dt = 1), 'Dummy::True'; +my $dummy_false = bless \(my $df = 0), 'Dummy::False'; + +my @tests = ([$dummy_true, $dummy_false, 'Dummy::True', 'Dummy::False']); + +# extra boolean classes +if (eval "require boolean; 1") { + push @tests, [boolean::true(), boolean::false(), 'boolean', 'boolean', 1]; +} +if (eval "require JSON::PP; 1") { + push @tests, [JSON::PP::true(), JSON::PP::false(), 'JSON::PP::Boolean', 'JSON::PP::Boolean']; +} +if (eval "require Data::Bool; 1") { + push @tests, [Data::Bool::true(), Data::Bool::false(), 'Data::Bool::Impl', 'Data::Bool::Impl']; +} +if (eval "require Types::Serialiser; 1") { + push @tests, [Types::Serialiser::true(), Types::Serialiser::false(), 'Types::Serialiser::BooleanBase', 'Types::Serialiser::BooleanBase']; +} + +plan tests => 13 * @tests; + +my $json = JSON::PP->new; +for my $test (@tests) { + my ($true, $false, $true_class, $false_class, $incompat) = @$test; + + $json->boolean_values($false, $true); + my ($new_false, $new_true) = $json->get_boolean_values; + ok defined $new_true, "new true class is defined"; + ok defined $new_false, "new false class is defined"; + ok $new_true->isa($true_class), "new true class is $true_class"; + ok $new_false->isa($false_class), "new false class is $false_class"; + SKIP: { + skip "$true_class is not compatible with JSON::PP::Boolean", 2 if $incompat; + ok $new_true->isa('JSON::PP::Boolean'), "new true class is also JSON::PP::Boolean"; + ok $new_false->isa('JSON::PP::Boolean'), "new false class is also JSON::PP::Boolean"; + } + + my $should_true = $json->allow_nonref(1)->decode('true'); + ok $should_true->isa($true_class), "JSON true turns into a $true_class object"; + + my $should_false = $json->allow_nonref(1)->decode('false'); + ok $should_false->isa($false_class), "JSON false turns into a $false_class object"; + + SKIP: { + skip "$true_class is not compatible with JSON::PP::Boolean", 2 if $incompat; + my $should_true_json = eval { $json->allow_nonref(1)->encode($new_true); }; + is $should_true_json => 'true', "A $true_class object turns into JSON true"; + + my $should_false_json = eval { $json->allow_nonref(1)->encode($new_false); }; + is $should_false_json => 'false', "A $false_class object turns into JSON false"; + } + + $json->boolean_values(); + ok !$json->get_boolean_values, "reset boolean values"; + + $should_true = $json->allow_nonref(1)->decode('true'); + ok $should_true->isa('JSON::PP::Boolean'), "JSON true turns into a JSON::PP::Boolean object"; + + $should_false = $json->allow_nonref(1)->decode('false'); + ok $should_false->isa('JSON::PP::Boolean'), "JSON false turns into a JSON::PP::Boolean object"; +} diff --git a/cpan/JSON-PP/t/_unicode_handling.pm b/cpan/JSON-PP/t/_unicode_handling.pm deleted file mode 100644 index 73a6748f15..0000000000 --- a/cpan/JSON-PP/t/_unicode_handling.pm +++ /dev/null @@ -1,28 +0,0 @@ -#package utf8; -package _unicode_handling; - -# this is a dummy pragma for 5.005. - - if ($] < 5.006) { - $INC{'utf8.pm'} = './utf8.pm'; - - eval q| - sub utf8::import { } - sub utf8::unimport { } - |; - - $JSON::PP::can_handle_UTF16_and_utf8 = 0; - } - else { - $JSON::PP::can_handle_UTF16_and_utf8 = 1; - - if ($] > 5.007 and $] < 5.008003) { -# $JSON::can_handle_UTF16_and_utf8 = 0; - } - - } - - - - -1; -- cgit v1.2.1