Cpanel-JSON-XS: Update to 3.0236

Stringify true again as "1"
Disallow duplicate keys by default, only allow them in relaxed mode.
De-fragilize t/96_mojo.t false test to "". It mostly is.
Fix and unify utf8 handling with 5.6.2 and improve many utf8 tests.
Add tests for boolean sv_yes and sv_no
Check for correct module in %INC (Patrick Cronin #89)
Fix inf/nan for strawberry 5.26

Author: rurban

MANIFEST

@@ -415,6 +415,7 @@ cpan/Cpanel-JSON-XS/t/22_comment_at_eof.t
 cpan/Cpanel-JSON-XS/t/23_array_ctx.t
 cpan/Cpanel-JSON-XS/t/24_freeze_recursion.t
 cpan/Cpanel-JSON-XS/t/25_boolean.t
+cpan/Cpanel-JSON-XS/t/26_duplicate.t
 cpan/Cpanel-JSON-XS/t/31_bom.t
 cpan/Cpanel-JSON-XS/t/52_object.t
 cpan/Cpanel-JSON-XS/t/53_readonly.t

META.json

@@ -142,5 +142,5 @@
       }
    },
    "version" : "5.027001c",
-   "x_serialization_backend" : "Cpanel::JSON::XS version 3.0233"
+   "x_serialization_backend" : "Cpanel::JSON::XS version 3.0236"
 }

Porting/Maintainers.pl

@@ -437,7 +437,7 @@ package Maintainers;
     },
 
     'Cpanel::JSON::XS' => {
-        'DISTRIBUTION' => 'RURBAN/Cpanel-JSON-XS-3.0233.tar.gz',
+        'DISTRIBUTION' => 'RURBAN/Cpanel-JSON-XS-3.0236.tar.gz',
         'FILES'        => q[cpan/Cpanel-JSON-XS],
         'EXCLUDED'     => [
             '.appveyor.yml',

cpan/Cpanel-JSON-XS/XS.pm

@@ -37,9 +37,11 @@
 #define UTF32BOM_BE "\000\000\376\377"  /* 00 00 FE FF */
 
 /* strawberry 5.22 with USE_MINGW_ANSI_STDIO and USE_LONG_DOUBLE has now 
-   a proper inf/nan */
+   a proper inf/nan. */
 #if defined(WIN32) && !defined(__USE_MINGW_ANSI_STDIO) && !defined(USE_LONG_DOUBLE)
-# if _MSC_VER > 1800
+/* TODO: we really need the msvcrt version, not the MSVC version.
+   strawberry 5.26 uses it also now. */
+# if (_MSC_VER > 1800) || (!defined(_MSC_VER) && PERL_VERSION >= 26)
 #  define STR_INF "inf"
 #  define STR_INF2 "inf.0"
 #  define STR_NAN "nan"
@@ -235,11 +237,7 @@ mingw_modfl(long double x, long double *ip)
 
 #define SHORT_STRING_LEN 16384 // special-case strings of up to this size
 
-#if PERL_VERSION >= 8
 #define DECODE_WANTS_OCTETS(json) ((json)->flags & F_UTF8)
-#else
-#define DECODE_WANTS_OCTETS(json) (0)
-#endif
 
 #define SB do {
 #define SE } while (0)
@@ -2705,6 +2703,7 @@ decode_hv (pTHX_ dec_t *dec)
   HV *hv = newHV ();
   int allow_squote = dec->json.flags & F_ALLOW_SQUOTE;
   int allow_barekey = dec->json.flags & F_ALLOW_BAREKEY;
+  int relaxed = dec->json.flags & F_RELAXED;
   char endstr = '"';
 
   DEC_INC_DEPTH;
@@ -2786,6 +2785,10 @@ decode_hv (pTHX_ dec_t *dec)
                   if (UNLIKELY(p - key > I32_MAX))
                     ERR ("Hash key too large");
 #endif
+                  if (!relaxed && UNLIKELY(hv_exists (hv, key, len))) {
+                    ERR ("Duplicate keys not allowed");
+                  }
+
                   dec->cur = p + 1;
 
                   decode_ws (dec); if (*p != ':') EXPECT_CH (':');
@@ -2847,7 +2850,7 @@ decode_hv (pTHX_ dec_t *dec)
 
           /* the next line creates a mortal sv each time it's called. */
           /* might want to optimise this for common cases. */
-          if (LIKELY(he))
+          if (LIKELY((long)he))
             cb = hv_fetch_ent (dec->json.cb_sk_object, hv_iterkeysv (he), 0, 0);
 
           if (cb)
@@ -3185,14 +3188,12 @@ decode_json (pTHX_ SV *string, JSON *json, STRLEN *offset_return)
     }
   }
 
-#if PERL_VERSION >= 8
   if (LIKELY(!converted)) {
     if (DECODE_WANTS_OCTETS (json))
       sv_utf8_downgrade (string, 0);
     else
       sv_utf8_upgrade (string);
   }
-#endif
 
   /* should basically be a NOP but needed for 5.6 with undef */
   if (!SvPOK(string))

cpan/Cpanel-JSON-XS/XS.xs

@@ -1,72 +1,76 @@
-use Test::More tests => 155;
+use Test::More tests => 162;
 use utf8;
 use Cpanel::JSON::XS;
+use warnings;
 
-is(Cpanel::JSON::XS->new->allow_nonref (1)->utf8 (1)->encode ("ü"), "\"\xc3\xbc\"");
-is(Cpanel::JSON::XS->new->allow_nonref (1)->encode ("ü"), "\"ü\"");
+is(Cpanel::JSON::XS->new->allow_nonref->utf8->encode("ü"), "\"\xc3\xbc\"");
+is(Cpanel::JSON::XS->new->allow_nonref->encode("ü"), "\"ü\"");
 
-is(Cpanel::JSON::XS->new->allow_nonref (1)->ascii (1)->utf8 (1)->encode (chr 0x8000), '"\u8000"');
-is(Cpanel::JSON::XS->new->allow_nonref (1)->ascii (1)->utf8 (1)->pretty (1)->encode (chr 0x10402), "\"\\ud801\\udc02\"\n");
+is(Cpanel::JSON::XS->new->allow_nonref->ascii->utf8->encode(chr 0x8000), '"\u8000"');
+is(Cpanel::JSON::XS->new->allow_nonref->ascii->utf8->pretty->encode(chr 0x10402), "\"\\ud801\\udc02\"\n");
+
+ok not defined eval { Cpanel::JSON::XS->new->allow_nonref->utf8->decode('"ü"') };
+like $@, qr/malformed UTF-8/;
+
+is(Cpanel::JSON::XS->new->allow_nonref->decode('"ü"'), "ü");
+is(Cpanel::JSON::XS->new->allow_nonref->decode('"\u00fc"'), "ü");
+
+ok not defined eval { decode_json ('"\ud801\udc02' . "\x{10204}\"", 1) };
+like $@, qr/Wide character/;
 
 SKIP: {
   skip "5.6", 1 if $] < 5.008;
-  eval { Cpanel::JSON::XS->new->allow_nonref (1)->utf8 (1)->decode ('"ü"') };
-  like $@, qr/malformed UTF-8/;
+  is(Cpanel::JSON::XS->new->allow_nonref->decode('"\ud801\udc02' . "\x{10204}\""), "\x{10402}\x{10204}");
 }
 
-is(Cpanel::JSON::XS->new->allow_nonref (1)->decode ('"ü"'), "ü");
-is(Cpanel::JSON::XS->new->allow_nonref (1)->decode ('"\u00fc"'), "ü");
-if ($] < 5.008) {
-  eval { decode_json ('"\ud801\udc02' . "\x{10204}\"", 1) };
-  like $@, qr/malformed UTF-8/;
-} else {
-  is(Cpanel::JSON::XS->new->allow_nonref (1)->decode ('"\ud801\udc02' . "\x{10204}\""), "\x{10402}\x{10204}");
-}
-is(Cpanel::JSON::XS->new->allow_nonref (1)->decode ('"\"\n\\\\\r\t\f\b"'), "\"\012\\\015\011\014\010");
+is(Cpanel::JSON::XS->new->allow_nonref->decode('"\"\n\\\\\r\t\f\b"'), "\"\012\\\015\011\014\010");
 
-my $love = $] < 5.008 ? "I \342\235\244 perl" : "I ❤ perl";
-is(Cpanel::JSON::XS->new->ascii->encode ([$love]),
-   $] < 5.008 ? '["I \u00e2\u009d\u00a4 perl"]' : '["I \u2764 perl"]', 'utf8 enc ascii');
-is(Cpanel::JSON::XS->new->latin1->encode ([$love]),
-      $] < 5.008 ? "[\"I \342\235\244 perl\"]" : '["I \u2764 perl"]', 'utf8 enc latin1');
+my $utf8_love = "I \342\235\244 perl";
+is(Cpanel::JSON::XS->new->ascii->encode([$utf8_love]), '["I \u00e2\u009d\u00a4 perl"]', 'utf8 enc ascii');
+is(Cpanel::JSON::XS->new->latin1->encode([$utf8_love]), "[\"I \342\235\244 perl\"]", 'utf8 enc latin1');
+is(Cpanel::JSON::XS->new->utf8->encode([$utf8_love]), "[\"I \303\242\302\235\302\244 perl\"]", 'utf8 enc utf8');
+is(Cpanel::JSON::XS->new->binary->encode([$utf8_love]), '["I \xe2\x9d\xa4 perl"]', 'utf8 enc binary');
 
 SKIP: {
-  skip "5.6", 1 if $] < 5.008;
-  require Encode;
-  # [RT #84244] wrong complaint: JSON::XS double encodes to ["I ❤ perl"]
-  #             and with utf8 triple encodes it to ["I ❤ perl"]
-  if ($Encode::VERSION < 2.40 or $Encode::VERSION >= 2.54) { # Encode stricter check: Cannot decode string with wide characters
-    # see also http://stackoverflow.com/questions/12994100/perl-encode-pm-cannot-decode-string-with-wide-character
-    $love = "I \342\235\244 perl";
-  }
-  my $s = Encode::decode_utf8($love); # User tries to double decode wide-char to unicode with Encode
-  is(Cpanel::JSON::XS->new->utf8->encode ([$s]), "[\"I \342\235\244 perl\"]", 'utf8 enc utf8 [RT #84244]');
+  skip "5.6", 4 if $] < 5.008;
+  my $unicode_love = "I ❤ perl";
+  is(Cpanel::JSON::XS->new->ascii->encode([$unicode_love]), '["I \u2764 perl"]', 'unicode enc ascii');
+  is(Cpanel::JSON::XS->new->latin1->encode([$unicode_love]), "[\"I \\u2764 perl\"]", 'unicode enc latin1');
+  is(Cpanel::JSON::XS->new->utf8->encode([$unicode_love]), "[\"I \342\235\244 perl\"]", 'unicode enc utf8');
+  is(Cpanel::JSON::XS->new->binary->encode([$unicode_love]), '["I \xe2\x9d\xa4 perl"]', 'unicode enc binary');
 }
-is(Cpanel::JSON::XS->new->binary->encode ([$love]), '["I \xe2\x9d\xa4 perl"]', 'utf8 enc binary');
 
 # TODO: test utf8 hash keys,
 # test utf8 strings without any char > 0x80.
 
 # warn on the 66 non-characters as in core
 {
-  my $w;
-  require warnings;
-  warnings->unimport($] < 5.014 ? 'utf8' : 'nonchar');
+  BEGIN { 'warnings'->import($] < 5.014 ? 'utf8' : 'nonchar') }
+  my $w = '';
   $SIG{__WARN__} = sub { $w = shift };
   my $d = Cpanel::JSON::XS->new->allow_nonref->decode('"\ufdd0"');
   my $warn = $w;
-  is ($d, "\x{fdd0}", substr($warn,0,31)."...");
+  {
+    no warnings 'utf8';
+    is ($d, "\x{fdd0}", substr($warn,0,31)."...");
+  }
   like ($warn, qr/^Unicode non-character U\+FDD0 is/);
   $w = '';
   # higher planes
   $d = Cpanel::JSON::XS->new->allow_nonref->decode('"\ud83f\udfff"');
   $warn = $w;
-  is ($d, "\x{1ffff}", substr($warn,0,31)."...");
+  {
+    no warnings 'utf8';
+    is ($d, "\x{1ffff}", substr($warn,0,31)."...");
+  }
   like ($w, qr/^Unicode non-character U\+1FFFF is/);
   $w = '';
   $d = Cpanel::JSON::XS->new->allow_nonref->decode('"\ud87f\udffe"');
   $warn = $w;
-  is ($d, "\x{2fffe}", substr($warn,0,31)."...");
+  {
+    no warnings 'utf8';
+    is ($d, "\x{2fffe}", substr($warn,0,31)."...");
+  }
   like ($w, qr/^Unicode non-character U\+2FFFE is/);
 
   $w = '';
@@ -77,12 +81,15 @@ is(Cpanel::JSON::XS->new->binary->encode ([$love]), '["I \xe2\x9d\xa4 perl"]', '
 }
 {
   my $w;
-  warnings->unimport($] < 5.014 ? 'utf8' : 'nonchar');
+  BEGIN { 'warnings'->import($] < 5.014 ? 'utf8' : 'nonchar') }
   $SIG{__WARN__} = sub { $w = shift };
   # no warning with relaxed
   my $d = Cpanel::JSON::XS->new->allow_nonref->relaxed->decode('"\ufdd0"');
   my $warn = $w;
-  is ($d, "\x{fdd0}", "no warning with relaxed");
+  {
+    no warnings 'utf8';
+    is ($d, "\x{fdd0}", "no warning with relaxed");
+  }
   is($w, undef);
 }
 
@@ -144,9 +151,9 @@ my @ill =
 {
   # these are no multibyte codepoints, just raw utf8 bytes,
   # so most of them work with 5.6 also.
-  $^W = 1;
+  BEGIN { $^W = 1 }
+  BEGIN { 'warnings'->import($] < 5.014 ? 'utf8' : 'nonchar') }
   my $w;
-  warnings->import($] < 5.014 ? 'utf8' : 'nonchar');
   $SIG{__WARN__} = sub { $w = shift };
 
   for my $ill (@ill) {

cpan/Cpanel-JSON-XS/t/01_utf8.t

@@ -22,7 +22,7 @@ ok ($true eq "true", "true: eq $true");
 ok ("$false" eq "0",     "false: stringified $false eq 0");
 #ok ("$false" eq "false", "false: stringified $false eq false");
 #ok ("$true" eq "1",    "true: stringified $true eq 1");
-ok ("$true" eq "true", "true: stringified $true");
+ok ("$true" eq "1", "true: stringified $true");
 {
   my $FH;
   my $fn = "tmp_$$";
@@ -32,7 +32,7 @@ ok ("$true" eq "true", "true: stringified $true");
   open $FH, "<", $fn;
   my $s = <$FH>;
   close $FH;
-  ok ($s eq "0true\n", $s); # 11
+  ok ($s eq "01\n", $s); # 11
   unlink $fn;
 }
 

cpan/Cpanel-JSON-XS/t/03_types.t

@@ -37,6 +37,13 @@ if ($^O eq 'MSWin32'
   $have_qnan = 0;
   ($inf, $neg_inf, $nan, $neg_nan) = ('inf','-inf','nan','-nan');
 }
+if ($^O eq 'MSWin32'
+    and $Config{cc} eq 'gcc'
+    and $] >= 5.026) # updated strawberry
+{
+  $have_qnan = 0;
+  ($inf, $neg_inf, $nan, $neg_nan) = ('inf','-inf','nan','-nan');
+}
 # Windows changed it with MSVC 14.0 and the ucrtd.dll runtime
 diag "ccversion = $Config{ccversion}" if $^O eq 'MSWin32' and $Config{ccversion};
 if ($^O eq 'MSWin32' and $Config{ccversion}) {

cpan/Cpanel-JSON-XS/t/117_numbers.t

@@ -1,19 +1,16 @@
 use strict;
-use Test::More tests => 17;
+use Test::More tests => 32;
 use Cpanel::JSON::XS ();
 
 my $booltrue  = q({"is_true":true});
 my $boolfalse = q({"is_false":false});
-# since 5.16 yes/no is !0/!1, but for earlier perls we need to use a BoolSV
-my $a   = 0;
-my $yes = do{$a==0}; # < 5.16 !0 is not sv_yes
-my $no  = do{$a==1}; # < 5.16 !1 is not sv_no
-my $yesno     = [ $yes, $no ]; # native yes/no. YAML::XS compatible
 my $truefalse = "[true,false]";
 my $cjson = Cpanel::JSON::XS->new;
 my $true  = Cpanel::JSON::XS::true;
 my $false = Cpanel::JSON::XS::false;
 
+my $nonref_cjson = Cpanel::JSON::XS->new->allow_nonref;
+
 # from JSON::MaybeXS
 my $data = $cjson->decode('{"foo": true, "bar": false, "baz": 1}');
 ok($cjson->is_bool($data->{foo}), 'true decodes to a bool')
@@ -37,10 +34,43 @@ is( $cjson->encode( [\1,\0] ), $truefalse  );
 is( $cjson->encode( [ $true, $false] ),
     $truefalse );
 
-TODO: {
-  local $TODO = 'GH #39';
-  is( $cjson->encode( $yesno ), $truefalse, "map yes/no to [true,false]");
+# GH #39
+# perl block which returns sv_no or sv_yes
+is( $nonref_cjson->encode( do{(my $a=0)==1} ), "false", "map do{(my \$a)=0)==1} to false");
+is( $nonref_cjson->encode( do{(my $a=0)==1} ), "false", "map do{(my \$a)=0)==1} to false");
+is( $nonref_cjson->encode( do{(my $a=1)==1} ), "true", "map do{(my \$a)=1)==1} to true");
+is( $nonref_cjson->encode( do{(my $a=1)==1} ), "true", "map do{(my \$a)=1)==1} to true");
+
+# GH #39
+# XS function UNIVERSAL::isa returns sv_no or sv_yes
+is( $nonref_cjson->encode( UNIVERSAL::isa('0', '1') ), "false", "map UNIVERSAL::isa('0', '1') to false");
+is( $nonref_cjson->encode( UNIVERSAL::isa('0', '1') ), "false", "map UNIVERSAL::isa('0', '1') to false");
+is( $nonref_cjson->encode( UNIVERSAL::isa('UNIVERSAL', 'UNIVERSAL') ), "true", "map UNIVERSAL::isa('UNIVERSAL', 'UNIVERSAL') to true");
+is( $nonref_cjson->encode( UNIVERSAL::isa('UNIVERSAL', 'UNIVERSAL') ), "true", "map UNIVERSAL::isa('UNIVERSAL', 'UNIVERSAL') to true");
+
+# GH #39
+# XS function utf8::is_utf8 returns sv_no or sv_yes
+SKIP: {
+  skip 'Perl 5.8 is needed for boolean tests based on utf8::upgrade()+utf8::is_utf8()', 4 if $] < 5.008;
+  is( $nonref_cjson->encode( do{utf8::is_utf8(my $a)} ), "false", "map do{utf8::is_utf8(my \$a)} to false");
+  is( $nonref_cjson->encode( do{utf8::is_utf8(my $a)} ), "false", "map do{utf8::is_utf8(my \$a)} to false");
+  my $utf8 = '';
+  utf8::upgrade($utf8);
+  is( $nonref_cjson->encode( do{utf8::is_utf8($utf8)} ), "true", "map do{utf8::is_utf8(\$utf8)} to true");
+  is( $nonref_cjson->encode( do{utf8::is_utf8($utf8)} ), "true", "map do{utf8::is_utf8(\$utf8)} to true");
 }
+
+# GH #39
+# perl expression which evaluates to sv_no or sv_yes
+SKIP: {
+  # implemented in 5.16 but broken, works since 5.20
+  skip 'Perl 5.20 is needed for boolean tests based on !1 and !0', 4 if $] < 5.020;
+  is( $nonref_cjson->encode( !1 ), "false", "map !1 to false");
+  is( $nonref_cjson->encode( !1 ), "false", "map !1 to false");
+  is( $nonref_cjson->encode( !0 ), "true", "map !0 to true");
+  is( $nonref_cjson->encode( !0 ), "true", "map !0 to true");
+}
+
 $js = $cjson->decode( $truefalse );
 ok ($js->[0] == $true,  "decode true to yes");
 ok ($js->[1] == $false, "decode false to no");

cpan/Cpanel-JSON-XS/t/25_boolean.t

@@ -0,0 +1,13 @@
+use Test::More tests => 4;
+use Cpanel::JSON::XS;
+
+my $json = Cpanel::JSON::XS->new;
+
+# disallow dupkeys:
+ok (!eval { $json->decode ('{"a":"b","a":"c"}') }); # y_object_duplicated_key.json
+ok (!eval { $json->decode ('{"a":"b","a":"b"}') }); # y_object_duplicated_key_and_value.json
+
+$json->relaxed;
+is (encode_json $json->decode ('{"a":"b","a":"c"}'), '{"a":"c"}'); # y_object_duplicated_key.json
+is (encode_json $json->decode ('{"a":"b","a":"b"}'), '{"a":"b"}'); # y_object_duplicated_key_and_value.json
+