diff options
author | TizenOpenSource <tizenopensrc@samsung.com> | 2023-12-28 17:46:21 +0900 |
---|---|---|
committer | TizenOpenSource <tizenopensrc@samsung.com> | 2023-12-28 17:46:21 +0900 |
commit | 782d8bd355c14b4617bde530e43d31b89ec298f5 (patch) | |
tree | 8c4fb6771f3e13e1e98543e5bf179c989659d5b9 | |
parent | 486774dd555cba55fb31657143ea9cc9ad64a561 (diff) | |
download | perl-json-upstream.tar.gz perl-json-upstream.tar.bz2 perl-json-upstream.zip |
Imported Upstream version 4.10upstream/4.10upstream
-rw-r--r-- | .github/workflows/testsuite.yml | 192 | ||||
-rw-r--r-- | .gitignore | 21 | ||||
-rw-r--r-- | .travis.yml | 32 | ||||
-rw-r--r-- | Changes | 9 | ||||
-rw-r--r-- | MANIFEST | 2 | ||||
-rw-r--r-- | MANIFEST.SKIP | 22 | ||||
-rw-r--r-- | META.json | 53 | ||||
-rw-r--r-- | META.yml | 28 | ||||
-rw-r--r-- | author/bin/sync_pp.pl | 124 | ||||
-rw-r--r-- | lib/JSON.pm | 2 | ||||
-rw-r--r-- | lib/JSON/backportPP.pm | 84 | ||||
-rw-r--r-- | lib/JSON/backportPP/Boolean.pm | 3 | ||||
-rw-r--r-- | t/03_types.t | 10 | ||||
-rw-r--r-- | t/core_bools.t | 86 | ||||
-rw-r--r-- | t/e02_bool.t | 10 | ||||
-rw-r--r-- | xt/00_pod.t | 8 |
16 files changed, 593 insertions, 93 deletions
diff --git a/.github/workflows/testsuite.yml b/.github/workflows/testsuite.yml new file mode 100644 index 0000000..85b8b81 --- /dev/null +++ b/.github/workflows/testsuite.yml @@ -0,0 +1,192 @@ +name: testsuite + +on: + push: + branches: + - "*" + tags-ignore: + - "*" + pull_request: + +jobs: + + ubuntu: + env: + PERL_USE_UNSAFE_INC: 0 + AUTHOR_TESTING: 1 + AUTOMATED_TESTING: 1 + RELEASE_TESTING: 1 + + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v1 + - name: perl -V + run: perl -V + - name: Makefile.PL + run: perl -I$(pwd) Makefile.PL + - name: make test + run: make test + - name: prove xt + run: prove -b xt + + linux: + name: "linux ${{ matrix.perl-version }}" + needs: [ubuntu] + env: + PERL_USE_UNSAFE_INC: 0 + AUTHOR_TESTING: 1 + AUTOMATED_TESTING: 1 + RELEASE_TESTING: 1 + + runs-on: ubuntu-latest + + strategy: + fail-fast: false + matrix: + include: + - backend: JSON::backportPP + backend-version: 0 + perl-version: latest + - backend: JSON::XS + backend-version: 4.00 + perl-version: latest + - backend: JSON::XS + backend-version: 3.02 + perl-version: latest + - backend: JSON::XS + backend-version: 2.34 + perl-version: latest + - backend: JSON::PP + backend-version: 2.97001 + perl-version: latest + - backend: JSON::PP + backend-version: 2.27400 + perl-version: latest + - backend: JSON::PP + backend-version: 2.27101 + perl-version: latest + - backend: Cpanel::JSON::XS + backend-version: 4.32 + perl-version: latest + - backend: Cpanel::JSON::XS + backend-version: 4.08 + perl-version: latest + - backend: Cpanel::JSON::XS + backend-version: 3.0218 + perl-version: latest + - backend: JSON::XS + backend-version: 4.00 + perl-version: 5.8 + - backend: JSON::XS + backend-version: 3.02 + perl-version: 5.8 + - backend: JSON::XS + backend-version: 2.34 + perl-version: 5.8 + - backend: JSON::PP + backend-version: 2.97001 + perl-version: 5.8 + - backend: JSON::PP + backend-version: 2.27400 + perl-version: 5.8 + - backend: JSON::PP + backend-version: 2.27101 + perl-version: 5.8 + - backend: Cpanel::JSON::XS + backend-version: 0 + perl-version: 5.8 + - backend: Cpanel::JSON::XS + backend-version: 4.32 + perl-version: 5.8 + - backend: Cpanel::JSON::XS + backend-version: 4.08 + perl-version: 5.8 + - backend: Cpanel::JSON::XS + backend-version: 3.0218 + perl-version: 5.8 + + container: + image: perl:${{ matrix.perl-version }} + + steps: + - uses: actions/checkout@v1 + - name: perl -V + run: perl -V; echo "${{ matrix.backend }}"; echo "${{ matrix.backend-version }}" + - name: install backend + if: ${{ matrix.backend-version != '0' && matrix.backend != 'JSON::backportPP' }} + run: cpanm -n ${{ matrix.backend }}@${{ matrix.backend-version }} + - name: install backend2 + if: ${{ matrix.backend-version == '0' && matrix.backend != 'JSON::backportPP' }} + run: cpanm -n ${{ matrix.backend }} + - name: Makefile.PL + run: perl -I$(pwd) Makefile.PL + - name: make test + run: PERL_JSON_BACKEND=${{ matrix.backend }} make test + - name: load JSON after backend + if: ${{ matrix.backend == 'Cpanel::JSON::XS' || matrix.backend == 'JSON::XS' }} + run: cpanm -n Test::Warnings JSON::PP@4.12; perl -Ilib -we 'use Test::More; use Test::Warnings qw(:report_warnings); use ${{ matrix.backend }} (); use JSON (); done_testing' + - name: load JSON before backend + continue-on-error: true + if: ${{ matrix.backend == 'Cpanel::JSON::XS' || matrix.backend == 'JSON::XS' }} + run: cpanm -n Test::Warnings JSON::PP@4.12; perl -Ilib -we 'use Test::More; use Test::Warnings qw(:report_warnings); use JSON (); use ${{ matrix.backend }} (); done_testing' + - name: load JSON::backportPP after backend + if: ${{ matrix.backend == 'Cpanel::JSON::XS' || matrix.backend == 'JSON::XS' }} + run: cpanm -n Test::Warnings; perl -Ilib -we 'use Test::More; use Test::Warnings qw(:report_warnings); use ${{ matrix.backend }} (); use JSON::backportPP (); done_testing' + - name: load JSON::backportPP before backend + continue-on-error: true + if: ${{ matrix.backend == 'Cpanel::JSON::XS' || matrix.backend == 'JSON::XS' }} + run: cpanm -n Test::Warnings; perl -Ilib -we 'use Test::More; use Test::Warnings qw(:report_warnings); use JSON::backportPP (); use ${{ matrix.backend }} (); done_testing' + + + macOS: + needs: [ubuntu] + env: + PERL_USE_UNSAFE_INC: 0 + AUTHOR_TESTING: 1 + AUTOMATED_TESTING: 1 + RELEASE_TESTING: 1 + + runs-on: macOS-latest + + strategy: + fail-fast: false + matrix: + perl-version: [latest] + + steps: + - uses: actions/checkout@v1 + - name: perl -V + run: perl -V + - name: Makefile.PL + run: perl -I$(pwd) Makefile.PL + - name: make test + run: make test + + # windows: + # needs: [ubuntu] + # env: + # PERL_USE_UNSAFE_INC: 0 + # AUTHOR_TESTING: 0 + # AUTOMATED_TESTING: 1 + # RELEASE_TESTING: 0 + + # runs-on: windows-latest + + # strategy: + # fail-fast: false + # matrix: + # perl-version: [latest] + + # steps: + # - uses: actions/checkout@master + # - name: Set up Perl + # run: | + # choco install strawberryperl + # echo "##[add-path]C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\strawberry\perl\bin" + # - name: perl -V + # run: perl -V + # - name: Makefile.PL + # run: perl -I Makefile.PL + # - name: make test + # run: make test
\ No newline at end of file diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d7d26f4 --- /dev/null +++ b/.gitignore @@ -0,0 +1,21 @@ +blib +inc +cover_db +Makefile +META.yml +MYMETA.* +pm_to_blib +*.tar.gz +*.tgz +*.old +*.bak +*.swp +JSON-* +pod2htm* +nytprof* +tmp/* +ex/* +diff_* +.shipit +pod.txt +local/
\ No newline at end of file diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..3611047 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,32 @@ +dist: trusty +language: perl +perl: + - "5.8" + - "5.24" +matrix: + include: + - perl: 5.8 + env: JSON_XS_VERSION=4.00 + - perl: 5.8 + env: JSON_XS_VERSION=3.02 + - perl: 5.8 + env: JSON_XS_VERSION=2.34 + - perl: 5.8 + env: JSON_PP_VERSION=2.97001 + - perl: 5.8 + env: JSON_PP_VERSION=2.27400 + - perl: 5.8 + env: JSON_PP_VERSION=2.27101 + - perl: 5.8 + env: CPANEL_JSON_XS_VERSION=3.0218 + - perl: 5.8 + env: CPANEL_JSON_XS_VERSION=4.08 +before_install: + - test $JSON_PP_VERSION && cpanm -n JSON::XS@$JSON_XS_VERSION || true + - test $JSON_XS_VERSION && cpanm -n JSON::XS@$JSON_XS_VERSION || true + - test $CPANEL_JSON_XS_VERSION && cpanm -n Cpanel::JSON::XS@$CPANEL_JSON_XS_VERSION || true +script: + - if test ! $JSON_PP_VERSION && test ! $JSON_XS_VERSION && test ! $CPANEL_JSON_XS_VERSION; then perl Makefile.PL && PERL_JSON_BACKEND=JSON::backportPP make test; else true; fi + - if test $JSON_PP_VERSION; then perl Makefile.PL && PERL_JSON_BACKEND=JSON::PP make test; else true; fi + - if test $JSON_XS_VERSION; then perl Makefile.PL && PERL_JSON_BACKEND=JSON::XS make test; else true; fi + - if test $CPANEL_JSON_XS_VERSION; then perl Makefile.PL && PERL_JSON_BACKEND=Cpanel::JSON::XS make test; else true; fi @@ -1,5 +1,14 @@ Revision history for Perl extension JSON. +4.10 2022-10-09 + - updated backportPP with JSON::PP 4.12 + +4.09 2022-08-01 + - fix a test to pass under perl with core bool support + +4.08 2022-07-31 + - updated backportPP with JSON::PP 4.11 + 4.07 2022-06-24 - updated backportPP with JSON::PP 4.10 @@ -77,5 +77,3 @@ t/xe19_xs_and_suportbypp.t t/xe20_croak_message.t t/xe21_is_pp.t t/zero-mojibake.t -META.yml Module YAML meta-data (added by MakeMaker) -META.json Module JSON meta-data (added by MakeMaker) diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..f476c53 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,22 @@ +\.[oc]$ +\.bs$ +\.tgz$ +\.tar\.gz$ +\.git +\.bak$ +\.old$ +\.shipit$ +\.sh$ +blib/ +Makefile$ +MANIFEST\.SKIP +pm_to_blib +tmp/ +ex/ +JSON- +pod\.txt +author/ +MYMETA\.* +\.travis\.yml +local/ +xt/ diff --git a/META.json b/META.json deleted file mode 100644 index 4958468..0000000 --- a/META.json +++ /dev/null @@ -1,53 +0,0 @@ -{ - "abstract" : "JSON (JavaScript Object Notation) encoder/decoder", - "author" : [ - "Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>" - ], - "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", - "license" : [ - "perl_5" - ], - "meta-spec" : { - "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", - "version" : 2 - }, - "name" : "JSON", - "no_index" : { - "directory" : [ - "t", - "inc" - ] - }, - "prereqs" : { - "build" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "configure" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "runtime" : { - "recommends" : { - "JSON::XS" : "2.34" - }, - "requires" : { - "Test::More" : "0" - } - } - }, - "release_status" : "stable", - "resources" : { - "bugtracker" : { - "web" : "https://github.com/makamaka/JSON/issues" - }, - "repository" : { - "url" : "https://github.com/makamaka/JSON" - } - }, - "version" : "4.07", - "x_serialization_backend" : "JSON version 4.07" -} diff --git a/META.yml b/META.yml deleted file mode 100644 index c01733a..0000000 --- a/META.yml +++ /dev/null @@ -1,28 +0,0 @@ ---- -abstract: 'JSON (JavaScript Object Notation) encoder/decoder' -author: - - 'Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>' -build_requires: - ExtUtils::MakeMaker: '0' -configure_requires: - ExtUtils::MakeMaker: '0' -dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' -license: perl -meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: '1.4' -name: JSON -no_index: - directory: - - t - - inc -recommends: - JSON::XS: '2.34' -requires: - Test::More: '0' -resources: - bugtracker: https://github.com/makamaka/JSON/issues - repository: https://github.com/makamaka/JSON -version: '4.07' -x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/author/bin/sync_pp.pl b/author/bin/sync_pp.pl new file mode 100644 index 0000000..3336bf0 --- /dev/null +++ b/author/bin/sync_pp.pl @@ -0,0 +1,124 @@ +# This script is to sync JSON::backportPP with the latest JSON::PP + +use strict; +use warnings; +use FindBin; +use lib "$FindBin::Bin/../../lib"; +use Path::Tiny; +use JSON; + +my $re_pp_methods = join '|', JSON->pureperl_only_methods; + +my $root = path("$FindBin::Bin/../.."); +my $pp_root = $root->parent->child('JSON-PP'); +my $test_dir = $root->child('t'); + +die "JSON-PP directory not found" unless -d $pp_root; + +{ + my $pp_lib = $pp_root->child('lib/JSON/PP.pm'); + my $content = $pp_lib->slurp; + $content =~ s/^package /package # This is JSON::backportPP\n /; + $content =~ s/^( *)package (JSON::PP(?:::(?:Boolean|IncrParser))?);/$1package # hide from PAUSE\n$1 $2;/gm; + $content =~ s/use JSON::PP::Boolean/use JSON::backportPP::Boolean/; + $content =~ s/JSON::PP::Compat/JSON::backportPP::Compat/g; + $content =~ s/\$JSON::PP::([\w:]+)VERSION/\$JSON::backportPP::$1VERSION/g; + $content =~ s/\$JSON::PP::VERSION/\$JSON::backportPP::VERSION/g; + $content =~ s/\@JSON::PP::ISA/\@JSON::backportPP::ISA/g; + $root->child('lib/JSON/backportPP.pm')->spew($content); +} + +{ + my $pp_lib = $pp_root->child('lib/JSON/PP/Boolean.pm'); + my $content = $pp_lib->slurp; + $content =~ s/^package /package # This is JSON::backportPP\n /; + $content =~ s/^( *)package (JSON::PP(?:::(?:Boolean|IncrParser))?);/$1package # hide from PAUSE\n$1 $2;/gm; + $content =~ s/\$JSON::PP::([\w:]+)?VERSION/\$JSON::backportPP::$1VERSION/g; + $content =~ s/JSON::PP( )/JSON::backportPP$1/g; + $root->child('lib/JSON/backportPP/Boolean.pm')->spew($content); +} + +for my $pp_test ($pp_root->child('t')->children) { + my $basename = $pp_test->basename; + $basename =~ s/^0([0-9][0-9])/$1/; + my $json_test = $test_dir->child($basename); + if ($basename =~ /\.pm$/) { + my $content = $pp_test->slurp; + $content =~ s/JSON::PP::/JSON::/g; + $json_test->spew($content); + print STDERR "copied $pp_test to $json_test\n"; + next; + } + if ($basename =~ /\.t$/) { + my $content = $pp_test->slurp; + $content =~ s/JSON::PP(::|->|;| |\.|$)/JSON$1/mg; + $content =~ s/\$ENV{PERL_JSON_BACKEND} = 0/\$ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"/; + $content =~ s/\{\s*#SKIP_UNLESS_PP (\S+)\s*,\s*(\S+)/SKIP: { skip "requires \$JSON::BackendModule $1 or newer", $2 if \$JSON::BackendModulePP and eval \$JSON::BackendModulePP->VERSION < $1;/g; + $content =~ s/\{\s*#SKIP_IF_CPANEL/SKIP: { skip "not for \$JSON::BackendModule", 1 if \$JSON::BackendModule eq 'Cpanel::JSON::XS';/g; + $content =~ s/#SKIP_ALL_UNLESS_PP (\S+)/BEGIN { plan skip_all => "requires \$JSON::BackendModule $1 or newer" if JSON->backend->is_pp and eval \$JSON::BackendModule->VERSION < $1 }/g; + $content =~ s/#SKIP_ALL_IF_XS/BEGIN { plan skip_all => "not for \$JSON::BackendModule" if \$JSON::BackendModule eq 'JSON::XS' }/g; + + $content =~ s/\{\s*#SKIP_UNLESS_XS4_COMPAT (\S+)/SKIP: { skip "requires JSON::XS 4 compat backend", $1 if (\$JSON::BackendModulePP and eval \$JSON::BackendModulePP->VERSION < 3) or (\$JSON::BackendModule eq 'Cpanel::JSON::XS') or (\$JSON::BackendModule eq 'JSON::XS' and \$JSON::BackendModule->VERSION < 4);/g; + $content =~ s/#SKIP_ALL_UNLESS_XS4_COMPAT/BEGIN { plan skip_all => "requires JSON::XS 4 compat backend" if (\$JSON::BackendModulePP and eval \$JSON::BackendModulePP->VERSION < 3) or (\$JSON::BackendModule eq 'Cpanel::JSON::XS') or (\$JSON::BackendModule eq 'JSON::XS' and \$JSON::BackendModule->VERSION < 4); }/g; + + if ($content !~ /\$ENV{PERL_JSON_BACKEND}/) { + $content =~ s/use JSON;/BEGIN { \$ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"; }\n\nuse JSON;/; + } + + if ($content =~ /$re_pp_methods/) { + $content =~ s/use JSON;/use JSON -support_by_pp;/g; + } + + # special cases + if ($basename eq '19_incr.t') { + $content =~ s/(splitter \+JSON\->new)\s+/$1->allow_nonref (1)/g; + $content =~ s/encode_json ([^,]+?),/encode_json($1),/g; + } + if ($basename eq '52_object.t') { + my $plan = ''; + if ($content =~ s|BEGIN \{ (plan tests => \d+) };\n||s) { + $plan = $1; + } + my $skip = <<'SKIP'; +my $backend_version = JSON->backend->VERSION; $backend_version =~ s/_//; + +plan skip_all => "allow_tags is not supported" if $backend_version < 3; +SKIP + $content =~ s|(use JSON;\n)|$1\n$skip\n$plan;\n|s; + } + if ($basename eq '104_sortby.t') { + $content =~ s/JSON::hoge/JSON::PP::hoge/g; + $content =~ s/\$JSON::(a|b)\b/\$JSON::PP::$1/g; + } + if ($basename eq 'gh_28_json_test_suite.t') { + $content =~ s/\$ENV{PERL_JSON_BACKEND} \|\|= "JSON::backportPP"/\$ENV{PERL_JSON_BACKEND} = "JSON::backportPP"/; + } + if ($basename eq '118_boolean_values.t') { + $content =~ s/JSON::Boolean/JSON::PP::Boolean/g; + $content =~ s/(push \@tests, \[JSON::true\(\), JSON::false\(\), 'JSON::PP::Boolean', 'JSON::PP::Boolean'\];\n)/$1 push \@tests, [JSON->boolean(11), JSON->boolean(undef), 'JSON::PP::Boolean', 'JSON::PP::Boolean'];\n push \@tests, [JSON::boolean(11), JSON::boolean(undef), 'JSON::PP::Boolean', 'JSON::PP::Boolean'];\n/; + } + if ($basename eq '119_incr_parse_utf8.t') { + $content =~ s[(use JSON;)] + [$1\nplan skip_all => "not for older version of JSON::PP" if JSON->backend->isa('JSON::PP') && JSON->backend->VERSION < 4.07;]s; + $content =~ s|use Test::More tests => 24;|use Test::More;|; + $content =~ s|(use charnames qw< :full >;)|$1\n\nplan tests => 24;|; + } + if ($basename eq '120_incr_parse_truncated.t') { + $content =~ s[(use JSON;)] + [$1\nplan skip_all => "not for older version of JSON::PP" if JSON->backend->isa('JSON::PP') && JSON->backend->VERSION < 4.09;]s; + $content =~ s|my \$coder = JSON->new;|my \$coder = JSON->new->allow_nonref(1);|g; + } + if ($basename eq '03_types.t') { + $content =~ s|JSON\->can\("CORE_BOOL"\) && JSON::CORE_BOOL\(\)|JSON->backend->can("CORE_BOOL") && JSON->backend->CORE_BOOL|g; + } + if ($basename eq 'core_bools.t') { + $content =~ s|JSON->can\('CORE_BOOL'\)|JSON->backend->can('CORE_BOOL')|g; + $content =~ s|JSON::CORE_BOOL|JSON->backend->CORE_BOOL|g; + } + + $json_test->spew($content); + print STDERR "copied $pp_test to $json_test\n"; + next; + } + print STDERR "Skipped $pp_test\n"; +} diff --git a/lib/JSON.pm b/lib/JSON.pm index 22101ca..d44c6b4 100644 --- a/lib/JSON.pm +++ b/lib/JSON.pm @@ -9,7 +9,7 @@ BEGIN { @JSON::ISA = 'Exporter' } @JSON::EXPORT = qw(from_json to_json jsonToObj objToJson encode_json decode_json); BEGIN { - $JSON::VERSION = '4.07'; + $JSON::VERSION = '4.10'; $JSON::DEBUG = 0 unless (defined $JSON::DEBUG); $JSON::DEBUG = $ENV{ PERL_JSON_DEBUG } if exists $ENV{ PERL_JSON_DEBUG }; } diff --git a/lib/JSON/backportPP.pm b/lib/JSON/backportPP.pm index 1bec128..6870697 100644 --- a/lib/JSON/backportPP.pm +++ b/lib/JSON/backportPP.pm @@ -15,7 +15,7 @@ use JSON::backportPP::Boolean; use Carp (); #use Devel::Peek; -$JSON::backportPP::VERSION = '4.10'; +$JSON::backportPP::VERSION = '4.12'; @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json); @@ -47,6 +47,7 @@ use constant P_ALLOW_TAGS => 19; use constant OLD_PERL => $] < 5.008 ? 1 : 0; use constant USE_B => $ENV{PERL_JSON_PP_USE_B} || 0; +use constant CORE_BOOL => defined &builtin::is_bool; my $invalid_char_re; @@ -213,13 +214,54 @@ sub boolean_values { my ($false, $true) = @_; $self->{false} = $false; $self->{true} = $true; + if (CORE_BOOL) { + BEGIN { CORE_BOOL and warnings->unimport(qw(experimental::builtin)) } + if (builtin::is_bool($true) && builtin::is_bool($false) && $true && !$false) { + $self->{core_bools} = !!1; + } + else { + delete $self->{core_bools}; + } + } } else { delete $self->{false}; delete $self->{true}; + delete $self->{core_bools}; } return $self; } +sub core_bools { + my $self = shift; + my $core_bools = defined $_[0] ? $_[0] : 1; + if ($core_bools) { + $self->{true} = !!1; + $self->{false} = !!0; + $self->{core_bools} = !!1; + } + else { + $self->{true} = $JSON::PP::true; + $self->{false} = $JSON::PP::false; + $self->{core_bools} = !!0; + } + return $self; +} + +sub get_core_bools { + my $self = shift; + return !!$self->{core_bools}; +} + +sub unblessed_bool { + my $self = shift; + return $self->core_bools(@_); +} + +sub get_unblessed_bool { + my $self = shift; + return $self->get_core_bools(@_); +} + sub get_boolean_values { my $self = shift; if (exists $self->{true} and exists $self->{false}) { @@ -480,7 +522,11 @@ sub allow_bigint { my $type = ref($value); if (!$type) { - if (_looks_like_number($value)) { + BEGIN { CORE_BOOL and warnings->unimport('experimental::builtin') } + if (CORE_BOOL && builtin::is_bool($value)) { + return $value ? 'true' : 'false'; + } + elsif (_looks_like_number($value)) { return $value; } return $self->string_to_json($value); @@ -1526,7 +1572,20 @@ 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") or $_[0]->isa("Types::Serialiser::BooleanBase") or $_[0]->isa("JSON::XS::Boolean") ); } +sub is_bool { + if (blessed $_[0]) { + return ( + $_[0]->isa("JSON::PP::Boolean") + or $_[0]->isa("Types::Serialiser::BooleanBase") + or $_[0]->isa("JSON::XS::Boolean") + ); + } + elsif (CORE_BOOL) { + BEGIN { CORE_BOOL and warnings->unimport('experimental::builtin') } + return builtin::is_bool($_[0]); + } + return !!0; +} sub true { $JSON::PP::true } sub false { $JSON::PP::false } @@ -1865,6 +1924,9 @@ Returns true if the passed scalar represents either JSON::PP::true or JSON::PP::false, two constants that act like C<1> and C<0> respectively and are also used to represent JSON C<true> and C<false> in Perl strings. +On perl 5.36 and above, will also return true when given one of perl's +standard boolean values, such as the result of a comparison. + See L<MAPPING>, below, for more information on how JSON values are mapped to Perl. @@ -2281,6 +2343,22 @@ 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 core_bools + + $json->core_bools([$enable]); + +If C<$enable> is true (or missing), then C<decode>, will produce standard +perl boolean values. Equivalent to calling: + + $json->boolean_values(!!1, !!0) + +C<get_core_bools> will return true if this has been set. On perl 5.36, it will +also return true if the boolean values have been set to perl's core booleans +using the C<boolean_values> method. + +The methods C<unblessed_bool> and C<get_unblessed_bool> are provided as aliases +for compatibility with L<Cpanel::JSON::XS>. + =head2 filter_json_object $json = $json->filter_json_object([$coderef]) diff --git a/lib/JSON/backportPP/Boolean.pm b/lib/JSON/backportPP/Boolean.pm index 30cd6b9..08228b1 100644 --- a/lib/JSON/backportPP/Boolean.pm +++ b/lib/JSON/backportPP/Boolean.pm @@ -4,6 +4,7 @@ package # This is JSON::backportPP use strict; require overload; local $^W; +overload::unimport('overload', qw(0+ ++ -- fallback)); overload::import('overload', "0+" => sub { ${$_[0]} }, "++" => sub { $_[0] = ${$_[0]} + 1 }, @@ -11,7 +12,7 @@ overload::import('overload', fallback => 1, ); -$JSON::backportPP::Boolean::VERSION = '4.10'; +$JSON::backportPP::Boolean::VERSION = '4.12'; 1; diff --git a/t/03_types.t b/t/03_types.t index 1037a7c..83eff94 100644 --- a/t/03_types.t +++ b/t/03_types.t @@ -3,7 +3,7 @@ use strict; use warnings; use Test::More; -BEGIN { plan tests => 76 + 2 }; +BEGIN { plan tests => 78 + 2 }; BEGIN { $ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"; } @@ -47,6 +47,14 @@ ok ('[null]' eq encode_json [undef]); ok ('[true]' eq encode_json [JSON::true]); ok ('[false]' eq encode_json [JSON::false]); +SKIP: { + skip "core booleans not supported", 2 + unless JSON->backend->can("CORE_BOOL") && JSON->backend->CORE_BOOL; + + ok ('[true]' eq encode_json [!!1]); + ok ('[false]' eq encode_json [!!0]); +} + for my $v (1, 2, 3, 5, -1, -2, -3, -4, 100, 1000, 10000, -999, -88, -7, 7, 88, 999, -1e5, 1e6, 1e7, 1e8) { ok ($v == ((decode_json "[$v]")->[0])); ok ($v == ((decode_json encode_json [$v])->[0])); diff --git a/t/core_bools.t b/t/core_bools.t new file mode 100644 index 0000000..8c714a1 --- /dev/null +++ b/t/core_bools.t @@ -0,0 +1,86 @@ +use strict; +use warnings; +BEGIN { $ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"; } + +use JSON; +use Test::More; +BEGIN { + # this is only for JSON.pm + plan skip_all => 'no support for core boolean options' + unless JSON->backend->can('CORE_BOOL'); +} + +plan tests => 24; + +my $json = JSON->new; + +is $json->get_core_bools, !!0, 'core_bools initially false'; + +$json->boolean_values(!!0, !!1); +SKIP: { + skip "core_bools option doesn't register as true for core bools without core boolean support", 1 + unless JSON->backend->CORE_BOOL; + + is $json->get_core_bools, !!1, 'core_bools true when setting bools to core bools'; +} + +$json->boolean_values(!!1, !!0); +is $json->get_core_bools, !!0, 'core_bools false when setting bools to anything other than correct core bools'; + +my $ret = $json->core_bools; +is $ret, $json, + "returns the same object"; + +my ($new_false, $new_true) = $json->get_boolean_values; + +# ensure this registers as true on older perls where the boolean values +# themselves can't be tracked. +is $json->get_core_bools, !!1, 'core_bools true when setting core_bools'; + +ok defined $new_true, "core true value is defined"; +ok defined $new_false, "core false value is defined"; + +ok !ref $new_true, "core true value is not blessed"; +ok !ref $new_false, "core falase value is not blessed"; + +{ + my @warnings; + local $SIG{__WARN__} = sub { + push @warnings, @_; + warn @_; + }; + + cmp_ok $new_true, 'eq', '1', 'core true value is "1"'; + cmp_ok $new_true, '==', 1, 'core true value is 1'; + + cmp_ok $new_false, 'eq', '', 'core false value is ""'; + cmp_ok $new_false, '==', 0, 'core false value is 0'; + + is scalar @warnings, 0, 'no warnings'; +} + +SKIP: { + skip "core boolean support needed to detect core booleans", 4 + unless JSON->backend->CORE_BOOL; + ok JSON::is_bool($new_true), 'core true is a boolean'; + ok JSON::is_bool($new_false), 'core false is a boolean'; + + ok builtin::is_bool($new_true), 'core true is a core boolean'; + ok builtin::is_bool($new_false), 'core false is a core boolean'; +} + +my $should_true = $json->allow_nonref(1)->decode('true'); +my $should_false = $json->allow_nonref(1)->decode('false'); + +ok !ref $should_true && $should_true, "JSON true turns into an unblessed true value"; +ok !ref $should_false && !$should_false, "JSON false turns into an unblessed false value"; + +SKIP: { + skip "core boolean support needed to detect core booleans", 4 + unless JSON->backend->CORE_BOOL; + ok JSON::is_bool($should_true), 'decoded true is a boolean'; + ok JSON::is_bool($should_false), 'decoded false is a boolean'; + + ok JSON::is_bool($should_true), 'decoded true is a core boolean'; + ok JSON::is_bool($should_false), 'decoded false is a core boolean'; +} diff --git a/t/e02_bool.t b/t/e02_bool.t index 06e8dd6..bbfd9fb 100644 --- a/t/e02_bool.t +++ b/t/e02_bool.t @@ -17,16 +17,18 @@ my $not_not_a_number_is_a_number = ( ($json->backend->isa('JSON::PP') && ($JSON::PP::Boolean::VERSION || $JSON::backportPP::Boolean::VERSION)) ) ? 1 : 0; -is($json->encode([!1]), '[""]'); +my $core_bool_support = JSON->backend->can("CORE_BOOL") && JSON->backend->CORE_BOOL ? 1 : 0; + +is($json->encode([!1]), $core_bool_support ? '[false]' : '[""]'); if ($not_not_a_number_is_a_number) { -is($json->encode([!!2]), '[1]'); +is($json->encode([!!2]), $core_bool_support ? '[true]' : '[1]'); } else { is($json->encode([!!2]), '["1"]'); } -is($json->encode([ 'a' eq 'b' ]), '[""]'); +is($json->encode([ 'a' eq 'b' ]), $core_bool_support ? '[false]' : '[""]'); if ($not_not_a_number_is_a_number) { -is($json->encode([ 'a' eq 'a' ]), '[1]'); +is($json->encode([ 'a' eq 'a' ]), $core_bool_support ? '[true]' : '[1]'); } else { is($json->encode([ 'a' eq 'a' ]), '["1"]'); } diff --git a/xt/00_pod.t b/xt/00_pod.t new file mode 100644 index 0000000..e8e3082 --- /dev/null +++ b/xt/00_pod.t @@ -0,0 +1,8 @@ +use strict; +$^W = 1; + +use Test::More; + +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok (); |