From ed904d9644229fc85ab517362abd324de1cad43c Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sat, 22 May 2021 09:16:45 +0000 Subject: [PATCH] Data::Dumper's minimum Perl version is now v5.8.1, up from v5.6.1 Tests have been failing on v5.8.0, v5.6.2 and v5.6.1 since 2.136 (Oct 2012) and no-one has reported this, so I guess for those versions the userbase is exclusively CPAN Testers automaton toiling diligently, because they know no better. Those CPU cycles are better reallocated to newer things. --- dist/Data-Dumper/Dumper.pm | 43 ++-------------- dist/Data-Dumper/Dumper.xs | 79 +++-------------------------- dist/Data-Dumper/t/dumper.t | 83 ++++++++++--------------------- dist/Data-Dumper/t/lib/Testing.pm | 2 +- 4 files changed, 39 insertions(+), 168 deletions(-) diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm index 4ee176ff5d20..ea2e97c84877 100644 --- a/dist/Data-Dumper/Dumper.pm +++ b/dist/Data-Dumper/Dumper.pm @@ -14,7 +14,7 @@ use warnings; #$| = 1; -use 5.006_001; +use 5.008_001; require Exporter; use constant IS_PRE_516_PERL => $] < 5.016; @@ -123,46 +123,17 @@ sub new { # Packed numeric addresses take less memory. Plus pack is faster than sprintf -# Most users of current versions of Data::Dumper will be 5.008 or later. -# Anyone on 5.6.1 and 5.6.2 upgrading will be rare (particularly judging by -# the bug reports from users on those platforms), so for the common case avoid -# complexity, and avoid even compiling the unneeded code. - -sub init_refaddr_format { -} - sub format_refaddr { require Scalar::Util; pack "J", Scalar::Util::refaddr(shift); }; -if ($] < 5.008) { - eval <<'EOC' or die; - no warnings 'redefine'; - my $refaddr_format; - sub init_refaddr_format { - require Config; - my $f = $Config::Config{uvxformat}; - $f =~ tr/"//d; - $refaddr_format = "0x%" . $f; - } - - sub format_refaddr { - require Scalar::Util; - sprintf $refaddr_format, Scalar::Util::refaddr(shift); - } - - 1 -EOC -} - # # add-to or query the table of already seen references # sub Seen { my($s, $g) = @_; if (defined($g) && (ref($g) eq 'HASH')) { - init_refaddr_format(); my($k, $v, $id); while (($k, $v) = each %$g) { if (defined $v) { @@ -252,7 +223,6 @@ sub Dumpperl { my(@out, $val, $name); my($i) = 0; local(@post); - init_refaddr_format(); $s = $s->new(@_) unless ref $s; @@ -545,7 +515,7 @@ sub _dump { else { local $s->{useqq} = IS_PRE_516_PERL && ($s->{useqq} || $name =~ /[^\x00-\x7f]/) ? 1 : $s->{useqq}; $sname = $s->_dump( - $name eq 'main::' || $] < 5.007 && $name eq "main::\0" + $name eq 'main::' ? '' : $name, "", @@ -778,7 +748,7 @@ sub qquote { # the string is UTF-8 but there are no UTF-8 variant characters in it. # We want that to come out as \x{} anyway. We need is_utf8() to do # this. - || (! $IS_ASCII && $] ge 5.008_001 && utf8::is_utf8($_)); + || (! $IS_ASCII && utf8::is_utf8($_)); return qq("$_") unless /[[:^print:]]/; # fast exit if only printables @@ -798,7 +768,7 @@ sub qquote { if ($IS_ASCII) { s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg; } - elsif ($] ge 5.007_003) { + else { my $high_control = utf8::unicode_to_native(0x9F); s/$high_control/sprintf('\\%o',ord($1))/eg; } @@ -1451,12 +1421,9 @@ for L. SCALAR objects have the weirdest looking C workaround. -Pure Perl version of C escapes UTF-8 strings correctly -only in Perl 5.8.0 and later. - =head2 NOTE -Starting from Perl 5.8.1 different runs of Perl will have different +Different runs of Perl will have different ordering of hash keys. The change was done for greater security, see L. This means that different runs of Perl will have different Data::Dumper outputs if diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs index 9fb11836445b..30a9a7b83a5c 100644 --- a/dist/Data-Dumper/Dumper.xs +++ b/dist/Data-Dumper/Dumper.xs @@ -13,10 +13,6 @@ # include "ppport.h" #endif -#if PERL_VERSION_LT(5,8,0) -# define DD_USE_OLD_ID_FORMAT -#endif - #ifndef strlcpy # ifdef my_strlcpy # define strlcpy(d,s,l) my_strlcpy(d,s,l) @@ -110,30 +106,12 @@ static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, #define HvNAME_get HvNAME #endif -/* Perls 7 through portions of 15 used utf8_to_uvchr() which didn't have a +/* Perls 5.7 through portions of 5.15 used utf8_to_uvchr() which didn't have a * length parameter. This wrongly allowed reading beyond the end of buffer * given malformed input */ -#if PERL_VERSION_LE(5,6,'*') /* Perl 5.6 and earlier */ - -UV -Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen) -{ - const UV uv = utf8_to_uv(s, send - s, retlen, - ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); - return UNI_TO_NATIVE(uv); -} - -# if !defined(PERL_IMPLICIT_CONTEXT) -# define utf8_to_uvchr_buf Perl_utf8_to_uvchr_buf -# else -# define utf8_to_uvchr_buf(a,b,c) Perl_utf8_to_uvchr_buf(aTHX_ a,b,c) -# endif - -#endif /* PERL_VERSION_LE(5,6,'*') */ - /* Perl 5.7 through part of 5.15 */ -#if PERL_VERSION_GE(5,7,0) && PERL_VERSION_LE(5,15,'*') && ! defined(utf8_to_uvchr_buf) +#if PERL_VERSION_LE(5,15,'*') && ! defined(utf8_to_uvchr_buf) UV Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen) @@ -153,14 +131,7 @@ Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen) #endif /* Perl 5.7 through part of 5.15 */ -/* Changes in 5.7 series mean that now IOK is only set if scalar is - precisely integer but in 5.6 and earlier we need to do a more - complex test */ -#if PERL_VERSION_LT(5,7,0) -#define DD_is_integer(sv) (SvIOK(sv) && (SvIsUV(val) ? SvUV(sv) == SvNV(sv) : SvIV(sv) == SvNV(sv))) -#else #define DD_is_integer(sv) SvIOK(sv) -#endif /* does a glob name need to be protected? */ static bool @@ -743,12 +714,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, char tmpbuf[128]; Size_t i; char *c, *r, *realpack; -#ifdef DD_USE_OLD_ID_FORMAT - char id[128]; -#else UV id_buffer; char *const id = (char *)&id_buffer; -#endif SV **svp; SV *sv, *ipad, *ival; SV *blesspad = Nullsv; @@ -800,12 +767,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, ival = SvRV(val); realtype = SvTYPE(ival); -#ifdef DD_USE_OLD_ID_FORMAT - idlen = my_snprintf(id, sizeof(id), "0x%" UVxf, PTR2UV(ival)); -#else id_buffer = PTR2UV(ival); idlen = sizeof(id_buffer); -#endif if (SvOBJECT(ival)) realpack = HvNAME_get(SvSTASH(ival)); else @@ -856,11 +819,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, return 1; } else { -#ifdef DD_USE_OLD_ID_FORMAT - warn("ref name not found for %s", id); -#else warn("ref name not found for 0x%" UVxf, PTR2UV(ival)); -#endif return 0; } } @@ -889,9 +848,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, /* regexps dont have to be blessed into package "Regexp" * they can be blessed into any package. */ -#if PERL_VERSION_LT(5,8,0) - if (realpack && *realpack == 'R' && strEQ(realpack, "Regexp")) -#elif PERL_VERSION_LT(5,11,0) +#if PERL_VERSION_LT(5,11,0) if (realpack && realtype == SVt_PVMG && mg_find(ival, PERL_MAGIC_qr)) #else if (realpack && realtype == SVt_REGEXP) @@ -1097,7 +1054,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, /* If requested, get a sorted/filtered array of hash keys */ if (style->sortkeys) { -#if PERL_VERSION_GE(5,8,0) if (style->sortkeys == &PL_sv_yes) { keys = newAV(); (void)hv_iterinit((HV*)ival); @@ -1106,19 +1062,19 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, (void)SvREFCNT_inc(sv); av_push(keys, sv); } -# ifdef USE_LOCALE_COLLATE -# ifdef IN_LC /* Use this if available */ +#ifdef USE_LOCALE_COLLATE +# ifdef IN_LC /* Use this if available */ if (IN_LC(LC_COLLATE)) -# else +# else if (IN_LOCALE) -# endif +# endif { sortsv(AvARRAY(keys), av_len(keys)+1, Perl_sv_cmp_locale); } else -# endif +#endif { sortsv(AvARRAY(keys), av_len(keys)+1, @@ -1126,7 +1082,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, } } else -#endif { dSP; ENTER; SAVETMPS; PUSHMARK(sp); XPUSHs(sv_2mortal(newRV_inc(ival))); PUTBACK; @@ -1354,12 +1309,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, const MAGIC *mg; if (namelen) { -#ifdef DD_USE_OLD_ID_FORMAT - idlen = my_snprintf(id, sizeof(id), "0x%" UVxf, PTR2UV(val)); -#else id_buffer = PTR2UV(val); idlen = sizeof(id_buffer); -#endif if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) && (sv = *svp) && SvROK(sv) && (seenentry = (AV*)SvRV(sv))) @@ -1418,11 +1369,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, if(i) ++c, --i; /* just get the name */ if (memBEGINs(c, i, "main::")) { c += 4; -#if PERL_VERSION_LT(5,7,0) - if (i == 6 || (i == 7 && c[6] == '\0')) -#else if (i == 6) -#endif i = 0; else i -= 4; } if (globname_needs_quote(c,i)) { @@ -1672,18 +1619,8 @@ Data_Dumper_Dumpxs(href, ...) else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) style.sortkeys = sv; else -#if PERL_VERSION_LT(5,8,0) - /* 5.6 doesn't make sortsv() available to XS code, - * so we must use this helper instead. Note that we - * always allocate this mortal SV, but it will be - * used only if at least one hash is encountered - * while dumping recursively; an older version - * allocated it lazily as needed. */ - style.sortkeys = sv_2mortal(newSVpvs("Data::Dumper::_sortkeys")); -#else /* flag to use sortsv() for sorting hash keys */ style.sortkeys = &PL_sv_yes; -#endif } postav = newAV(); sv_2mortal((SV*)postav); diff --git a/dist/Data-Dumper/t/dumper.t b/dist/Data-Dumper/t/dumper.t index f05449e8493c..e415f9780a93 100644 --- a/dist/Data-Dumper/t/dumper.t +++ b/dist/Data-Dumper/t/dumper.t @@ -43,10 +43,6 @@ sub change_glob_expectation { sub convert_to_native($) { my $input = shift; - # unicode_to_native() not available before this release; hence won't work - # on EBCDIC platforms for earlier. - return $input if $] lt 5.007_003; - my @output; # The input should always be one of the following constructs @@ -976,11 +972,7 @@ TEST (q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;), #$a = "\x{9c10}"; EOT - if($] >= 5.007) { - TEST q(Data::Dumper->Dump([$a], ['a'])), "\\x{9c10}"; - } else { - SKIP_TEST "Incomplete support for UTF-8 in old perls"; - } + TEST q(Data::Dumper->Dump([$a], ['a'])), "\\x{9c10}"; TEST q(Data::Dumper->Dumpxs([$a], ['a'])), "XS \\x{9c10}" if $XS; } @@ -1509,16 +1501,11 @@ EOT $ping = 5; %ping = (chr (0xDECAF) x 4 =>\$ping); for $Data::Dumper::Sortkeys (0, 1) { - if($] >= 5.007) { - TEST (q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong'])), - "utf8: Purity 1: Sortkeys: Dump()"); - TEST (q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])), - "utf8: Purity 1: Sortkeys: Dumpxs()") - if $XS; - } else { - SKIP_TEST "Incomplete support for UTF-8 in old perls"; - SKIP_TEST "Incomplete support for UTF-8 in old perls"; - } + TEST (q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong'])), + "utf8: Purity 1: Sortkeys: Dump()"); + TEST (q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])), + "utf8: Purity 1: Sortkeys: Dumpxs()") + if $XS; } } @@ -1593,13 +1580,8 @@ EOT $foo = [ join "", map chr, 0..255, 0x20ac ]; local $Data::Dumper::Useqq = 1; - if ($] < 5.007) { - print "not ok " . (++$TNUM) . " # TODO - fails under 5.6\n" for 1..3; - } - else { - TEST q(Dumper($foo)), - 'All latin1 characters with utf8 flag including a wide character: Dumper'; - } + TEST q(Dumper($foo)), + 'All latin1 characters with utf8 flag including a wide character: Dumper'; TEST (q(Data::Dumper::DumperX($foo)), 'All latin1 characters with utf8 flag including a wide character: DumperX') if $XS; @@ -1608,27 +1590,18 @@ EOT ############# { # If XS cannot load, the pure-Perl version cannot deparse vstrings with - # underscores properly. In 5.8.0, vstrings are just strings. - my $no_vstrings = <<'NOVSTRINGS'; -#$a = \'ABC'; -#$b = \'ABC'; -#$c = \'ABC'; -#$d = \'ABC'; -NOVSTRINGS -my $ABC_native = chr(65) . chr(66) . chr(67); - my $vstrings_corr = <= 5.8"; - SKIP_TEST "Test is only problematic for EBCDIC, which only works for >= 5.8"; - } - else { - # There is special code to handle the single control that in EBCDIC is - # not in the block with all the other controls, when it is UTF-8 and - # there are no variants in it (All controls in EBCDIC are invariant.) - # This tests that. There is no harm in testing this works on ASCII, - # and is better to not have split code paths. - my $outlier = chr utf8::unicode_to_native(0x9F); - my $outlier_hex = sprintf "%x", ord $outlier; - $WANT = <