New upstream version 4.09000

8 files changed, 107 insertions, 13 deletions

diff --git a/Changes b/Changes
index bf8ad1c..b70533f 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,11 @@
 Revision history for Perl extension JSON.
 
+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/META.json b/META.json
index 4958468..061c78d 100644
--- a/META.json
+++ b/META.json
@@ -48,6 +48,6 @@
          "url" : "https://github.com/makamaka/JSON"
       }
    },
-   "version" : "4.07",
-   "x_serialization_backend" : "JSON version 4.07"
+   "version" : "4.09",
+   "x_serialization_backend" : "JSON version 4.09"
 }
diff --git a/META.yml b/META.yml
index c01733a..332c0d1 100644
--- a/META.yml
+++ b/META.yml
@@ -24,5 +24,5 @@ requires:
 resources:
   bugtracker: https://github.com/makamaka/JSON/issues
   repository: https://github.com/makamaka/JSON
-version: '4.07'
+version: '4.09'
 x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff --git a/lib/JSON.pm b/lib/JSON.pm
index 22101ca..ae1d981 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.09';
     $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..7daa46f 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.11';
 
 @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..e08aae5 100644
--- a/lib/JSON/backportPP/Boolean.pm
+++ b/lib/JSON/backportPP/Boolean.pm
@@ -11,7 +11,7 @@ overload::import('overload',
     fallback => 1,
 );
 
-$JSON::backportPP::Boolean::VERSION = '4.10';
+$JSON::backportPP::Boolean::VERSION = '4.11';
 
 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/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"]');
 }