Imported Upstream version 4.06upstream/4.06

17 files changed, 422 insertions, 95 deletions

diff --git a/Changes b/Changes
index 63778d7..3e95c48 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension JSON.
 
+4.06 2022-05-22
+    - updated backportPP with JSON::PP 4.09
+
 4.05 2022-01-14
     - removed VERSION section in pod (GH#52, abraxxa++)
 
diff --git a/MANIFEST b/MANIFEST
index 79f6318..4eeccc9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -39,6 +39,7 @@ t/117_numbers.t
 t/118_boolean_values.t
 t/119_incr_parse_utf8.t
 t/11_pc_expo.t
+t/120_incr_parse_truncated.t
 t/12_blessed.t
 t/13_limit.t
 t/14_latin1.t
@@ -63,6 +64,7 @@ t/gh_28_json_test_suite.t
 t/gh_29_trailing_false_value.t
 t/rt_116998_wrong_character_offset.t
 t/rt_122270_is_bool_for_obsolete_xs_boolean.t
+t/rt_122270_old_xs_boolean.t
 t/rt_90071_incr_parse.t
 t/x00_load.t
 t/x02_error.t
diff --git a/META.json b/META.json
index fc217bb..f10ff0d 100644
--- a/META.json
+++ b/META.json
@@ -48,6 +48,6 @@
          "url" : "https://github.com/makamaka/JSON"
       }
    },
-   "version" : "4.05",
-   "x_serialization_backend" : "JSON version 4.05"
+   "version" : "4.06",
+   "x_serialization_backend" : "JSON version 4.06"
 }
diff --git a/META.yml b/META.yml
index 93c2cbc..de3da07 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.05'
+version: '4.06'
 x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff --git a/lib/JSON.pm b/lib/JSON.pm
index 7927301..2c7ed1e 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.05';
+    $JSON::VERSION = '4.06';
     $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 dfb134e..5abe6f8 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.07';
+$JSON::backportPP::VERSION = '4.09';
 
 @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
 
@@ -48,6 +48,17 @@ 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;
 
+my $invalid_char_re;
+
+BEGIN {
+    $invalid_char_re = "[";
+    for my $i (0 .. 0x01F, 0x22, 0x5c) { # '/' is ok
+        $invalid_char_re .= quotemeta chr utf8::unicode_to_native($i);
+    }
+
+    $invalid_char_re = qr/$invalid_char_re]/;
+}
+
 BEGIN {
     if (USE_B) {
         require B;
@@ -327,14 +338,6 @@ sub allow_bigint {
 
         $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
 
-        unless ($ascii or $latin1 or $utf8) {
-            utf8::upgrade($str);
-        }
-
-        if ($props->[ P_SHRINK ]) {
-            utf8::downgrade($str, 1);
-        }
-
         return $str;
     }
 
@@ -528,9 +531,11 @@ sub allow_bigint {
     sub string_to_json {
         my ($self, $arg) = @_;
 
-        $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
+        $arg =~ s/(["\\\n\r\t\f\b])/$esc{$1}/g;
         $arg =~ s/\//\\\//g if ($escape_slash);
-        $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
+
+        # On ASCII platforms, matches [\x00-\x08\x0b\x0e-\x1f]
+        $arg =~ s/([^\n\t\c?[:^cntrl:][:^ascii:]])/'\\u00' . unpack('H2', $1)/eg;
 
         if ($ascii) {
             $arg = JSON_PP_encode_ascii($arg);
@@ -605,7 +610,7 @@ sub allow_bigint {
 sub _encode_ascii {
     join('',
         map {
-            $_ <= 127 ?
+            chr($_) =~ /[[:ascii:]]/ ?
                 chr($_) :
             $_ <= 65535 ?
                 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
@@ -659,11 +664,11 @@ BEGIN {
 { # PARSE 
 
     my %escapes = ( #  by Jeremy Muhlich <jmuhlich [at] bitflood.org>
-        b    => "\x8",
-        t    => "\x9",
-        n    => "\xA",
-        f    => "\xC",
-        r    => "\xD",
+        b    => "\b",
+        t    => "\t",
+        n    => "\n",
+        f    => "\f",
+        r    => "\r",
         '\\' => '\\',
         '"'  => '"',
         '/'  => '/',
@@ -737,7 +742,6 @@ BEGIN {
             }
         }
         else {
-            utf8::upgrade( $text );
             utf8::encode( $text );
         }
 
@@ -854,7 +858,8 @@ BEGIN {
                                 decode_error("surrogate pair expected");
                             }
 
-                            if ( ( my $hex = hex( $u ) ) > 127 ) {
+                            my $hex = hex( $u );
+                            if ( chr $u =~ /[[:^ascii:]]/ ) {
                                 $is_utf8 = 1;
                                 $s .= JSON_PP_decode_unicode($u) || next;
                             }
@@ -874,7 +879,7 @@ BEGIN {
                 }
                 else{
 
-                    if ( ord $ch  > 127 ) {
+                    if ( $ch =~ /[[:^ascii:]]/ ) {
                         unless( $ch = is_valid_utf8($ch) ) {
                             $at -= 1;
                             decode_error("malformed UTF-8 character in JSON string");
@@ -887,10 +892,12 @@ BEGIN {
                     }
 
                     if (!$loose) {
-                        if ($ch =~ /[\x00-\x1f\x22\x5c]/)  { # '/' ok
+                        if ($ch =~ $invalid_char_re)  { # '/' ok
                             if (!$relaxed or $ch ne "\t") {
                                 $at--;
-                                decode_error('invalid character encountered while parsing JSON string');
+                                decode_error(sprintf "invalid character 0x%X"
+                                   . " encountered while parsing JSON string",
+                                   ord $ch);
                             }
                         }
                     }
@@ -1103,7 +1110,7 @@ BEGIN {
 
     sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
         my $key;
-        while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
+        while($ch =~ /[\$\w[:^ascii:]]/){
             $key .= $ch;
             next_chr();
         }
@@ -1236,31 +1243,55 @@ BEGIN {
         return $is_dec ? $v/1.0 : 0+$v;
     }
 
+    # Compute how many bytes are in the longest legal official Unicode
+    # character
+    my $max_unicode_length = do {
+      BEGIN { $] >= 5.006 and require warnings and warnings->unimport('utf8') }
+      chr 0x10FFFF;
+    };
+    utf8::encode($max_unicode_length);
+    $max_unicode_length = length $max_unicode_length;
 
     sub is_valid_utf8 {
 
-        $utf8_len = $_[0] =~ /[\x00-\x7F]/  ? 1
-                  : $_[0] =~ /[\xC2-\xDF]/  ? 2
-                  : $_[0] =~ /[\xE0-\xEF]/  ? 3
-                  : $_[0] =~ /[\xF0-\xF4]/  ? 4
-                  : 0
-                  ;
-
-        return unless $utf8_len;
-
-        my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
-
-        return ( $is_valid_utf8 =~ /^(?:
-             [\x00-\x7F]
-            |[\xC2-\xDF][\x80-\xBF]
-            |[\xE0][\xA0-\xBF][\x80-\xBF]
-            |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
-            |[\xED][\x80-\x9F][\x80-\xBF]
-            |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
-            |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
-            |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
-            |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
-        )$/x )  ? $is_valid_utf8 : '';
+        # Returns undef (setting $utf8_len to 0) unless the next bytes in $text
+        # comprise a well-formed UTF-8 encoded character, in which case,
+        # return those bytes, setting $utf8_len to their count.
+
+        my $start_point = substr($text, $at - 1);
+
+        # Look no further than the maximum number of bytes in a single
+        # character
+        my $limit = $max_unicode_length;
+        $limit = length($start_point) if $limit > length($start_point);
+
+        # Find the number of bytes comprising the first character in $text
+        # (without having to know the details of its internal representation).
+        # This loop will iterate just once on well-formed input.
+        while ($limit > 0) {    # Until we succeed or exhaust the input
+            my $copy = substr($start_point, 0, $limit);
+
+            # decode() will return true if all bytes are valid; false
+            # if any aren't.
+            if (utf8::decode($copy)) {
+
+                # Is valid: get the first character, convert back to bytes,
+                # and return those bytes.
+                $copy = substr($copy, 0, 1);
+                utf8::encode($copy);
+                $utf8_len = length $copy;
+                return substr($start_point, 0, $utf8_len);
+            }
+
+            # If it didn't work, it could be that there is a full legal character
+            # followed by a partial or malformed one.  Narrow the window and
+            # try again.
+            $limit--;
+        }
+
+        # Failed to find a legal UTF-8 character.
+        $utf8_len = 0;
+        return;
     }
 
 
@@ -1279,14 +1310,14 @@ BEGIN {
         }
 
         for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
-            $mess .=  $c == 0x07 ? '\a'
-                    : $c == 0x09 ? '\t'
-                    : $c == 0x0a ? '\n'
-                    : $c == 0x0d ? '\r'
-                    : $c == 0x0c ? '\f'
-                    : $c <  0x20 ? sprintf('\x{%x}', $c)
-                    : $c == 0x5c ? '\\\\'
-                    : $c <  0x80 ? chr($c)
+            my $chr_c = $c;
+            $mess .=  $chr_c eq '\\' ? '\\\\'
+                    : $chr_c =~ /[[:print:]]/ ? $chr_c
+                    : $chr_c eq '\a' ? '\a'
+                    : $chr_c eq '\t' ? '\t'
+                    : $chr_c eq '\n' ? '\n'
+                    : $chr_c eq '\r' ? '\r'
+                    : $chr_c eq '\f' ? '\f'
                     : sprintf('\x{%x}', $c)
                     ;
             if ( length $mess >= 20 ) {
@@ -1537,10 +1568,6 @@ sub incr_parse {
     $self->{incr_text} = '' unless ( defined $self->{incr_text} );
 
     if ( defined $text ) {
-        if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
-            utf8::upgrade( $self->{incr_text} ) ;
-            utf8::decode( $self->{incr_text} ) ;
-        }
         $self->{incr_text} .= $text;
     }
 
@@ -1567,7 +1594,6 @@ sub incr_parse {
                 }
 
                 unless ( $coder->get_utf8 ) {
-                    utf8::upgrade( $self->{incr_text} );
                     utf8::decode( $self->{incr_text} );
                 }
 
@@ -1608,7 +1634,7 @@ INCR_PARSE:
             while ( $len > $p ) {
                 $s = substr( $text, $p, 1 );
                 last INCR_PARSE unless defined $s;
-                if ( ord($s) > 0x20 ) {
+                if ( ord($s) > ord " " ) {
                     if ( $s eq '#' ) {
                         $self->{incr_mode} = INCR_M_C0;
                         redo INCR_PARSE;
@@ -1635,6 +1661,7 @@ INCR_PARSE:
             }
             next;
         } elsif ( $mode == INCR_M_TFN ) {
+            last INCR_PARSE if $p >= $len && $self->{incr_nest};
             while ( $len > $p ) {
                 $s = substr( $text, $p++, 1 );
                 next if defined $s and $s =~ /[rueals]/;
@@ -1646,6 +1673,7 @@ INCR_PARSE:
             last INCR_PARSE unless $self->{incr_nest};
             redo INCR_PARSE;
         } elsif ( $mode == INCR_M_NUM ) {
+            last INCR_PARSE if $p >= $len && $self->{incr_nest};
             while ( $len > $p ) {
                 $s = substr( $text, $p++, 1 );
                 next if defined $s and $s =~ /[0-9eE.+\-]/;
@@ -1682,7 +1710,7 @@ INCR_PARSE:
                 if ( $s eq "\x00" ) {
                     $p--;
                     last INCR_PARSE;
-                } elsif ( $s eq "\x09" or $s eq "\x0a" or $s eq "\x0d" or $s eq "\x20" ) {
+                } elsif ( $s =~ /^[\t\n\r ]$/) {
                     if ( !$self->{incr_nest} ) {
                         $p--; # do not eat the whitespace, let the next round do it
                         last INCR_PARSE;
diff --git a/lib/JSON/backportPP/Boolean.pm b/lib/JSON/backportPP/Boolean.pm
index d6a2d58..15af674 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.07';
+$JSON::backportPP::Boolean::VERSION = '4.09';
 
 1;
 
diff --git a/t/01_utf8.t b/t/01_utf8.t
index b05ba66..73c8ded 100644
--- a/t/01_utf8.t
+++ b/t/01_utf8.t
@@ -10,17 +10,23 @@ BEGIN { $ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"; }
 use utf8;
 use JSON;
 
-
-ok (JSON->new->allow_nonref (1)->utf8 (1)->encode ("ü") eq "\"\xc3\xbc\"");
-ok (JSON->new->allow_nonref (1)->encode ("ü") eq "\"ü\"");
-ok (JSON->new->allow_nonref (1)->ascii (1)->utf8 (1)->encode (chr 0x8000) eq '"\u8000"');
-ok (JSON->new->allow_nonref (1)->ascii (1)->utf8 (1)->pretty (1)->encode (chr 0x10402) eq "\"\\ud801\\udc02\"\n");
-
-eval { JSON->new->allow_nonref (1)->utf8 (1)->decode ('"ü"') };
+my $pilcrow_utf8 = (ord "^" == 0x5E) ? "\xc2\xb6"  # 8859-1
+                 : (ord "^" == 0x5F) ? "\x80\x65"  # CP 1024
+                 :                     "\x78\x64"; # assume CP 037
+is (JSON->new->allow_nonref (1)->utf8 (1)->encode ("¶"), "\"$pilcrow_utf8\"");
+is (JSON->new->allow_nonref (1)->encode ("¶"), "\"¶\"");
+is (JSON->new->allow_nonref (1)->ascii (1)->utf8 (1)->encode (chr 0x8000), '"\u8000"');
+is (JSON->new->allow_nonref (1)->ascii (1)->utf8 (1)->pretty (1)->encode (chr 0x10402), "\"\\ud801\\udc02\"\n");
+
+eval { JSON->new->allow_nonref (1)->utf8 (1)->decode ('"¶"') };
 ok $@ =~ /malformed UTF-8/;
 
-ok (JSON->new->allow_nonref (1)->decode ('"ü"') eq "ü");
-ok (JSON->new->allow_nonref (1)->decode ('"\u00fc"') eq "ü");
-ok (JSON->new->allow_nonref (1)->decode ('"\ud801\udc02' . "\x{10204}\"") eq "\x{10402}\x{10204}");
-ok (JSON->new->allow_nonref (1)->decode ('"\"\n\\\\\r\t\f\b"') eq "\"\012\\\015\011\014\010");
+is (JSON->new->allow_nonref (1)->decode ('"¶"'), "¶");
+is (JSON->new->allow_nonref (1)->decode ('"\u00b6"'), "¶");
+is (JSON->new->allow_nonref (1)->decode ('"\ud801\udc02' . "\x{10204}\""), "\x{10402}\x{10204}");
+
+my $controls = (ord "^" == 0x5E) ? "\012\\\015\011\014\010"
+             : (ord "^" == 0x5F) ? "\025\\\015\005\014\026"  # CP 1024
+             :                     "\045\\\015\005\014\026"; # assume CP 037
+is (JSON->new->allow_nonref (1)->decode ('"\"\n\\\\\r\t\f\b"'), "\"$controls");
 
diff --git a/t/08_pc_base.t b/t/08_pc_base.t
index 1607569..cfcb548 100644
--- a/t/08_pc_base.t
+++ b/t/08_pc_base.t
@@ -77,7 +77,7 @@ $obj = $pc->decode($js);
 is($obj->[0],"\x01");
 
 $obj = ["\e"];
-is($js = $pc->encode($obj),'["\\u001b"]');
+is($js = $pc->encode($obj), (ord("A") == 65) ? '["\\u001b"]' : '["\\u0027"]');
 $obj = $pc->decode($js);
 is($obj->[0],"\e");
 
diff --git a/t/108_decode.t b/t/108_decode.t
index e38e438..c575a2e 100644
--- a/t/108_decode.t
+++ b/t/108_decode.t
@@ -9,6 +9,8 @@ BEGIN { plan tests => 6 };
 
 BEGIN { $ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"; }
 
+my $isASCII = ord "A" == 65;
+
 use JSON;
 
 no utf8;
@@ -22,16 +24,20 @@ is($json->decode(q|"\u00c3\u00bc"|), "\xc3\xbc"); # utf8
 
 my $str = 'あ'; # Japanese 'a' in utf8
 
-is($json->decode(q|"\u00e3\u0081\u0082"|), $str);
+is($json->decode(($isASCII) ? q|"\u00e3\u0081\u0082"|
+                            : q|"\u00ce\u0043\u0043"|),
+                  $str);
 
 utf8::decode($str); # usually UTF-8 flagged on, but no-op for 5.005.
 
 is($json->decode(q|"\u3042"|), $str);
 
 
-my $utf8 = $json->decode(q|"\ud808\udf45"|); # chr 12345
+# chr 0x12400, which was chosen because it has the same representation in
+# both EBCDIC 1047 and 037
+my $utf8 = $json->decode(q|"\ud809\udc00"|);
 
 utf8::encode($utf8); # UTF-8 flagged off
 
-is($utf8, "\xf0\x92\x8d\x85");
+is($utf8, ($isASCII) ? "\xf0\x92\x90\x80" : "\xDE\x4A\x41\x41");
 
diff --git a/t/109_encode.t b/t/109_encode.t
index afc5fe3..9f28e0d 100644
--- a/t/109_encode.t
+++ b/t/109_encode.t
@@ -9,20 +9,46 @@ BEGIN { plan tests => 7 };
 
 BEGIN { $ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"; }
 
+my $isASCII = ord "A" == 65;
+
 use JSON;
 
 no utf8;
 
 my $json = JSON->new->allow_nonref;
 
-is($json->encode("ü"),                   q|"ü"|); # as is
+# U+00B6 chosen because it works on both ASCII and EBCDIC
+is($json->encode("¶"),                   q|"¶"|); # as is
 
 $json->ascii;
 
-is($json->encode("\xfc"),           q|"\u00fc"|); # latin1
-is($json->encode("\xc3\xbc"), q|"\u00c3\u00bc"|); # utf8
-is($json->encode("ü"),        q|"\u00c3\u00bc"|); # utf8
-is($json->encode('あ'), q|"\u00e3\u0081\u0082"|);
+if ($] < 5.008) {
+    is($json->encode("\xb6"),           q|"\u00b6"|); # latin1
+    is($json->encode("\xc2\xb6"), q|"\u00c2\u00b6"|); # utf8
+    is($json->encode("¶"),        q|"\u00c2\u00b6"|); # utf8
+    is($json->encode('あ'), q|"\u00e3\u0081\u0082"|);
+}
+else  {
+    is($json->encode("\xb6"),           q|"\u00b6"|); # latin1
+
+    if (ord "A" == 65)  {
+        is($json->encode("\xc2\xb6"), q|"\u00c2\u00b6"|); # utf8
+        is($json->encode("¶"),        q|"\u00c2\u00b6"|); # utf8
+        is($json->encode('あ'), q|"\u00e3\u0081\u0082"|);
+    }
+    else {
+        if (ord '^' == 95) {    # EBCDIC 1047
+            is($json->encode("\x80\x65"), q|"\u0080\u0065"|); # utf8
+            is($json->encode("¶"),        q|"\u0080\u0065"|); # utf8
+        }
+        else {  # Assume EBCDIC 037
+            is($json->encode("\x78\x64"), q|"\u0078\u0064"|); # utf8
+            is($json->encode("¶"),        q|"\u0078\u0064"|); # utf8
+        }
+
+        is($json->encode('あ'), (q|"\u00ce\u0043\u0043"|));
+    }
+}
 
 if ($] >= 5.006) {
     is($json->encode(chr hex 3042 ),  q|"\u3042"|);
diff --git a/t/112_upgrade.t b/t/112_upgrade.t
index 6b9ad89..537d54d 100644
--- a/t/112_upgrade.t
+++ b/t/112_upgrade.t
@@ -9,17 +9,17 @@ BEGIN { $ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"; }
 use JSON;
 
 my $json = JSON->new->allow_nonref->utf8;
-my $str  = '\\u00c8';
+my $str  = '\\u00b6';
 
-my $value = $json->decode( '"\\u00c8"' );
+my $value = $json->decode( '"\\u00b6"' );
 
 #use Devel::Peek;
 #Dump( $value );
 
-is( $value, chr 0xc8 );
+is( $value, chr 0xb6 );
 
 ok( utf8::is_utf8( $value ) );
 
-eval { $json->decode( '"' . chr(0xc8) . '"' ) };
+eval { $json->decode( '"' . chr(0xb6) . '"' ) };
 ok( $@ =~ /malformed UTF-8 character in JSON string/ );
 
diff --git a/t/119_incr_parse_utf8.t b/t/119_incr_parse_utf8.t
index 182a5c6..ed8ef11 100644
--- a/t/119_incr_parse_utf8.t
+++ b/t/119_incr_parse_utf8.t
@@ -1,14 +1,17 @@
 use strict;
 use warnings;
-use Test::More tests => 24;
+use Test::More;
 
 use utf8;
 BEGIN { $ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"; }
 
 use JSON;
+plan skip_all => "not for older version of JSON::PP" if JSON->backend->isa('JSON::PP') && JSON->backend->VERSION < 4.07;
 use Encode;
 use charnames qw< :full >;
 
+plan tests => 24;
+
 use vars qw< @vs >;
 
 ############################################################
diff --git a/t/120_incr_parse_truncated.t b/t/120_incr_parse_truncated.t
new file mode 100644
index 0000000..0eb908e
--- /dev/null
+++ b/t/120_incr_parse_truncated.t
@@ -0,0 +1,221 @@
+use strict;
+use warnings;
+use Test::More;
+BEGIN { $ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"; }
+
+use JSON;
+plan skip_all => "not for older version of JSON::PP" if JSON->backend->isa('JSON::PP') && JSON->backend->VERSION < 4.09;
+
+plan tests => 19 * 3 + 1 * 6;
+
+sub run_test {
+    my ($input, $sub) = @_;
+    $sub->($input);
+}
+
+run_test('{"one": 1}', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok ($res, "curly braces okay -- '$input'");
+    ok (!$e, "no error -- '$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error");
+});
+
+run_test('{"one": 1]', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "unbalanced curly braces -- '$input'");
+    ok ($e, "got error -- '$input'");
+    like ($e, qr/, or \} expected while parsing object\/hash/, "'} expected' json string error");
+});
+
+run_test('"', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+});
+
+run_test('{', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+});
+
+run_test('[', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+});
+
+run_test('}', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok ($e, "no error for input='$input'");
+    like ($e, qr/malformed JSON string/, "'malformed JSON string' json string error for input='$input'");
+});
+
+run_test(']', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok ($e, "no error for input='$input'");
+    like ($e, qr/malformed JSON string/, "'malformed JSON string' json string error for input='$input'");
+});
+
+run_test('1', sub {
+    my $input = shift;
+    my $coder = JSON->new->allow_nonref(1);
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok ($res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/malformed JSON string/, "'malformed JSON string' json string error for input='$input'");
+});
+
+run_test('1', sub {
+    my $input = shift;
+    my $coder = JSON->new->allow_nonref(0);
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok ($e, "no error for input='$input'");
+    like ($e, qr/JSON text must be an object or array/, "'JSON text must be an object or array' json string error for input='$input'");
+});
+
+run_test('"1', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/malformed JSON string/, "'malformed JSON string' json string error for input='$input'");
+});
+
+run_test('\\', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok ($e, "no error for input='$input'");
+    like ($e, qr/malformed JSON string/, "'malformed JSON string' json string error for input='$input'");
+});
+
+run_test('{"one": "', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+});
+
+run_test('{"one": {', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+});
+
+run_test('{"one": [', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+});
+
+run_test('{"one": t', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+});
+
+run_test('{"one": \\', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+});
+
+run_test('{"one": ', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+});
+
+run_test('{"one": 1', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+});
+
+run_test('{"one": {"two": 2', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated '$input'");
+    ok (!$e, "no error -- '$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error -- $input");
+});
+
+# Test Appending Closing '}' Curly Bracket
+run_test('{"one": 1', sub {
+    my $input = shift;
+    my $coder = JSON->new;
+    my $res = eval { $coder->incr_parse($input) };
+    my $e = $@; # test more clobbers $@, we need it twice
+    ok (!$res, "truncated input='$input'");
+    ok (!$e, "no error for input='$input'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input'");
+
+    $res = eval { $coder->incr_parse('}') };
+    $e = $@; # test more clobbers $@, we need it twice
+    ok ($res, "truncated input='$input' . '}'");
+    ok (!$e, "no error for input='$input' . '}'");
+    unlike ($e, qr/, or \} expected while parsing object\/hash/, "No '} expected' json string error for input='$input' . '}'");
+});
diff --git a/t/14_latin1.t b/t/14_latin1.t
index c88cbba..a3d6db0 100644
--- a/t/14_latin1.t
+++ b/t/14_latin1.t
@@ -11,9 +11,9 @@ use JSON;
 
 my $pp = JSON->new->latin1->allow_nonref;
 
-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 ($pp->encode ("\x{12}\x{b6}       ") eq "\"\\u0012\x{b6}       \"");
+ok ($pp->encode ("\x{12}\x{b6}\x{abc}") eq "\"\\u0012\x{b6}\\u0abc\"");
 
-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}");
+ok ($pp->decode ("\"\\u0012\x{b6}\""       ) eq "\x{12}\x{b6}");
+ok ($pp->decode ("\"\\u0012\x{b6}\\u0abc\"") eq "\x{12}\x{b6}\x{abc}");
 
diff --git a/t/rt_122270_old_xs_boolean.t b/t/rt_122270_old_xs_boolean.t
new file mode 100644
index 0000000..64fad70
--- /dev/null
+++ b/t/rt_122270_old_xs_boolean.t
@@ -0,0 +1,33 @@
+# copied over from JSON::XS and modified to use JSON
+
+use strict;
+use warnings;
+use Test::More;
+BEGIN { plan tests => 10 };
+
+BEGIN { $ENV{PERL_JSON_BACKEND} ||= "JSON::backportPP"; }
+
+use utf8;
+use JSON;
+
+SKIP: {
+    skip "no JSON::XS < 3", 5 unless eval { require JSON::XS; JSON::XS->VERSION < 3 };
+
+    my $false = JSON::XS::false();
+    ok (JSON::is_bool $false);
+    ok (++$false == 1);
+    ok (!JSON::is_bool $false);
+    ok (!JSON::is_bool "JSON::Boolean");
+    ok (!JSON::is_bool {}); # GH-34
+}
+
+SKIP: {
+    skip "no Types::Serialiser 0.01", 5 unless eval { require JSON::XS; JSON::XS->VERSION(3.00); require Types::Serialiser; Types::Serialiser->VERSION == 0.01 };
+
+    my $false = JSON::XS::false();
+    ok (JSON::is_bool $false);
+    ok (++$false == 1);
+    ok (!JSON::is_bool $false);
+    ok (!JSON::is_bool "JSON::Boolean");
+    ok (!JSON::is_bool {}); # GH-34
+}
diff --git a/t/xe19_xs_and_suportbypp.t b/t/xe19_xs_and_suportbypp.t
index d2467d5..ab84785 100644
--- a/t/xe19_xs_and_suportbypp.t
+++ b/t/xe19_xs_and_suportbypp.t
@@ -13,7 +13,6 @@ SKIP: {
 
     my $json = JSON->new->allow_barekey;
 
-note explain test($json, q!{foo:"foo"}!);
     for (1..2) {
         is_deeply( test($json, q!{foo:"foo"}!   ), {foo=>'foo'} );
         JSON->new->allow_singlequote(0);