summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.github/workflows/testsuite.yml192
-rw-r--r--.gitignore21
-rw-r--r--.travis.yml32
-rw-r--r--Changes9
-rw-r--r--MANIFEST2
-rw-r--r--MANIFEST.SKIP22
-rw-r--r--META.json53
-rw-r--r--META.yml28
-rw-r--r--author/bin/sync_pp.pl124
-rw-r--r--lib/JSON.pm2
-rw-r--r--lib/JSON/backportPP.pm84
-rw-r--r--lib/JSON/backportPP/Boolean.pm3
-rw-r--r--t/03_types.t10
-rw-r--r--t/core_bools.t86
-rw-r--r--t/e02_bool.t10
-rw-r--r--xt/00_pod.t8
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
diff --git a/Changes b/Changes
index bf8ad1c..a024925 100644
--- a/Changes
+++ b/Changes
@@ -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
diff --git a/MANIFEST b/MANIFEST
index ce99264..1909c5b 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -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 ();
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 19:10:52 +0000