From 90102878a84e4b4a2180a83ccaaef3a3c00bbc8a Mon Sep 17 00:00:00 2001
From: Jitka Plesnikova <jplesnik@redhat.com>
Date: Thu, 6 May 2021 09:15:58 +0200
Subject: [PATCH] Upgrade to 3.23
---
Storable.pm | 4 +--
Storable.xs | 94 +++++++++++++++++++++++++--------------------------
t/canonical.t | 2 +-
t/malice.t | 6 ++--
4 files changed, 52 insertions(+), 54 deletions(-)
diff --git a/Storable.pm b/Storable.pm
index 1a750f1..27c9cf5 100644
--- a/Storable.pm
+++ b/Storable.pm
@@ -28,7 +28,7 @@ our @EXPORT_OK = qw(
our ($canonical, $forgive_me);
BEGIN {
- our $VERSION = '3.21';
+ our $VERSION = '3.23';
}
our $recursion_limit;
@@ -1423,7 +1423,7 @@ Murray Nesbitt made Storable thread-safe. Marc Lehmann added overloading
and references to tied items support. Benjamin Holzman added a performance
improvement for overloaded classes; thanks to Grant Street Group for footing
the bill.
-Reini Urban took over maintainance from p5p, and added security fixes
+Reini Urban took over maintenance from p5p, and added security fixes
and huge object support.
=head1 AUTHOR
diff --git a/Storable.xs b/Storable.xs
index 4c4c268..70dddf3 100644
--- a/Storable.xs
+++ b/Storable.xs
@@ -16,18 +16,16 @@
#include <perl.h>
#include <XSUB.h>
-#ifndef PATCHLEVEL
-#include <patchlevel.h> /* Perl's one, needed since 5.6 */
-#endif
-
-#if !defined(PERL_VERSION) || PERL_VERSION < 10 || (PERL_VERSION == 10 && PERL_SUBVERSION < 1)
-#define NEED_PL_parser
-#define NEED_sv_2pv_flags
-#define NEED_load_module
-#define NEED_vload_module
-#define NEED_newCONSTSUB
-#define NEED_newSVpvn_flags
-#define NEED_newRV_noinc
+#ifndef PERL_VERSION_LT
+# if !defined(PERL_VERSION) || !defined(PERL_REVISION) || ( PERL_REVISION == 5 && ( PERL_VERSION < 10 || (PERL_VERSION == 10 && PERL_SUBVERSION < 1) ) )
+# define NEED_PL_parser
+# define NEED_sv_2pv_flags
+# define NEED_load_module
+# define NEED_vload_module
+# define NEED_newCONSTSUB
+# define NEED_newSVpvn_flags
+# define NEED_newRV_noinc
+# endif
#include "ppport.h" /* handle old perls */
#endif
@@ -521,7 +519,7 @@ static MAGIC *THX_sv_magicext(pTHX_
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
-#if (PATCHLEVEL <= 4) && (SUBVERSION < 68)
+#if PERL_VERSION_LT(5,4,68)
#define dSTCXT_SV \
SV *perinterp_sv = get_sv(MY_VERSION, 0)
#else /* >= perl5.004_68 */
@@ -1012,22 +1010,22 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
#define STORABLE_BIN_MAJOR 2 /* Binary major "version" */
#define STORABLE_BIN_MINOR 11 /* Binary minor "version" */
-#if (PATCHLEVEL <= 5)
+#if PERL_VERSION_LT(5,6,0)
#define STORABLE_BIN_WRITE_MINOR 4
#elif !defined (SvVOK)
/*
* Perl 5.6.0-5.8.0 can do weak references, but not vstring magic.
*/
#define STORABLE_BIN_WRITE_MINOR 8
-#elif PATCHLEVEL >= 19
+#elif PERL_VERSION_GE(5,19,0)
/* Perl 5.19 takes away the special meaning of PL_sv_undef in arrays. */
/* With 3.x we added LOBJECT */
#define STORABLE_BIN_WRITE_MINOR 11
#else
#define STORABLE_BIN_WRITE_MINOR 9
-#endif /* (PATCHLEVEL <= 5) */
+#endif /* PERL_VERSION_LT(5,6,0) */
-#if (PATCHLEVEL < 8 || (PATCHLEVEL == 8 && SUBVERSION < 1))
+#if PERL_VERSION_LT(5,8,1)
#define PL_sv_placeholder PL_sv_undef
#endif
@@ -1354,7 +1352,7 @@ static U32 Sntohl(U32 x) {
* sortsv is not available ( <= 5.6.1 ).
*/
-#if (PATCHLEVEL <= 6)
+#if PERL_VERSION_LT(5,7,0)
#if defined(USE_ITHREADS)
@@ -1373,12 +1371,12 @@ static U32 Sntohl(U32 x) {
#endif /* USE_ITHREADS */
-#else /* PATCHLEVEL > 6 */
+#else /* PERL >= 5.7.0 */
#define STORE_HASH_SORT \
sortsv(AvARRAY(av), len, Perl_sv_cmp);
-#endif /* PATCHLEVEL <= 6 */
+#endif /* PERL_VERSION_LT(5,7,0) */
static int store(pTHX_ stcxt_t *cxt, SV *sv);
static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname);
@@ -1650,7 +1648,7 @@ static void init_store_context(pTHX_
*
* It is reported fixed in 5.005, hence the #if.
*/
-#if PERL_VERSION >= 5
+#if PERL_VERSION_GE(5,5,0)
#define HBUCKETS 4096 /* Buckets for %hseen */
#ifndef USE_PTR_TABLE
HvMAX(cxt->hseen) = HBUCKETS - 1; /* keys %hseen = $HBUCKETS; */
@@ -1667,7 +1665,7 @@ static void init_store_context(pTHX_
cxt->hclass = newHV(); /* Where seen classnames are stored */
-#if PERL_VERSION >= 5
+#if PERL_VERSION_GE(5,5,0)
HvMAX(cxt->hclass) = HBUCKETS - 1; /* keys %hclass = $HBUCKETS; */
#endif
@@ -2244,7 +2242,7 @@ static AV *array_call(pTHX_
return av;
}
-#if PERL_VERSION < 15
+#if PERL_VERSION_LT(5,15,0)
static void
cleanup_recursive_av(pTHX_ AV* av) {
SSize_t i = AvFILLp(av);
@@ -2252,7 +2250,7 @@ cleanup_recursive_av(pTHX_ AV* av) {
if (SvMAGICAL(av)) return;
while (i >= 0) {
if (arr[i]) {
-#if PERL_VERSION < 14
+#if PERL_VERSION_LT(5,14,0)
arr[i] = NULL;
#else
SvREFCNT_dec(arr[i]);
@@ -2283,7 +2281,7 @@ cleanup_recursive_hv(pTHX_ HV* hv) {
}
i--;
}
-#if PERL_VERSION < 8
+#if PERL_VERSION_LT(5,8,0)
((XPVHV*)SvANY(hv))->xhv_array = NULL;
#else
HvARRAY(hv) = NULL;
@@ -2394,7 +2392,7 @@ static int store_ref(pTHX_ stcxt_t *cxt, SV *sv)
TRACEME((">ref recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth,
PTR2UV(cxt->recur_sv), cxt->max_recur_depth));
if (RECURSION_TOO_DEEP()) {
-#if PERL_VERSION < 15
+#if PERL_VERSION_LT(5,15,0)
cleanup_recursive_data(aTHX_ (SV*)sv);
#endif
CROAK((MAX_DEPTH_ERROR));
@@ -2498,7 +2496,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
/* public string - go direct to string read. */
goto string_readlen;
} else if (
-#if (PATCHLEVEL <= 6)
+#if PERL_VERSION_LT(5,7,0)
/* For 5.6 and earlier NV flag trumps IV flag, so only use integer
direct if NV flag is off. */
(flags & (SVf_NOK | SVf_IOK)) == SVf_IOK
@@ -2576,7 +2574,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
*/
Zero(&nv, 1, NV_bytes);
#endif
-#if (PATCHLEVEL <= 6)
+#if PERL_VERSION_LT(5,7,0)
nv.nv = SvNV(sv);
/*
* Watch for number being an integer in disguise.
@@ -2699,7 +2697,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
if (recur_sv != (SV*)av) {
if (RECURSION_TOO_DEEP()) {
/* with <= 5.14 it recurses in the cleanup also, needing 2x stack size */
-#if PERL_VERSION < 15
+#if PERL_VERSION_LT(5,15,0)
cleanup_recursive_data(aTHX_ (SV*)av);
#endif
CROAK((MAX_DEPTH_ERROR));
@@ -2717,7 +2715,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
STORE_SV_UNDEF();
continue;
}
-#if PATCHLEVEL >= 19
+#if PERL_VERSION_GE(5,19,0)
/* In 5.19.3 and up, &PL_sv_undef can actually be stored in
* an array; it no longer represents nonexistent elements.
* Historically, we have used SX_SV_UNDEF in arrays for
@@ -2748,7 +2746,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
}
-#if (PATCHLEVEL <= 6)
+#if PERL_VERSION_LT(5,7,0)
/*
* sortcmp
@@ -2765,7 +2763,7 @@ sortcmp(const void *a, const void *b)
return sv_cmp(*(SV * const *) a, *(SV * const *) b);
}
-#endif /* PATCHLEVEL <= 6 */
+#endif /* PERL_VERSION_LT(5,7,0) */
/*
* store_hash
@@ -2861,7 +2859,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
++cxt->recur_depth;
}
if (RECURSION_TOO_DEEP_HASH()) {
-#if PERL_VERSION < 15
+#if PERL_VERSION_LT(5,15,0)
cleanup_recursive_data(aTHX_ (SV*)hv);
#endif
CROAK((MAX_DEPTH_ERROR));
@@ -3275,7 +3273,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
++cxt->recur_depth;
}
if (RECURSION_TOO_DEEP_HASH()) {
-#if PERL_VERSION < 15
+#if PERL_VERSION_LT(5,15,0)
cleanup_recursive_data(aTHX_ (SV*)hv);
#endif
CROAK((MAX_DEPTH_ERROR));
@@ -3311,7 +3309,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
*/
static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
{
-#if PERL_VERSION < 6
+#if PERL_VERSION_LT(5,6,0)
/*
* retrieve_code does not work with perl 5.005 or less
*/
@@ -3410,10 +3408,10 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
#endif
}
-#if PERL_VERSION < 8
+#if PERL_VERSION_LT(5,8,0)
# define PERL_MAGIC_qr 'r' /* precompiled qr// regex */
# define BFD_Svs_SMG_OR_RMG SVs_RMG
-#elif ((PERL_VERSION==8) && (PERL_SUBVERSION >= 1) || (PERL_VERSION>8))
+#elif PERL_VERSION_GE(5,8,1)
# define BFD_Svs_SMG_OR_RMG SVs_SMG
# define MY_PLACEHOLDER PL_sv_placeholder
#else
@@ -3424,7 +3422,7 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
static int get_regexp(pTHX_ stcxt_t *cxt, SV* sv, SV **re, SV **flags) {
dSP;
SV* rv;
-#if PERL_VERSION >= 12
+#if PERL_VERSION_GE(5,12,0)
CV *cv = get_cv("re::regexp_pattern", 0);
#else
CV *cv = get_cv("Storable::_regexp_pattern", 0);
@@ -4286,7 +4284,7 @@ static int sv_type(pTHX_ SV *sv)
{
switch (SvTYPE(sv)) {
case SVt_NULL:
-#if PERL_VERSION <= 10
+#if PERL_VERSION_LT(5,11,0)
case SVt_IV:
#endif
case SVt_NV:
@@ -4296,7 +4294,7 @@ static int sv_type(pTHX_ SV *sv)
*/
return svis_SCALAR;
case SVt_PV:
-#if PERL_VERSION <= 10
+#if PERL_VERSION_LT(5,11,0)
case SVt_RV:
#else
case SVt_IV:
@@ -4314,7 +4312,7 @@ static int sv_type(pTHX_ SV *sv)
*/
return SvROK(sv) ? svis_REF : svis_SCALAR;
case SVt_PVMG:
-#if PERL_VERSION <= 10
+#if PERL_VERSION_LT(5,11,0)
if ((SvFLAGS(sv) & (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
== (SVs_OBJECT|BFD_Svs_SMG_OR_RMG)
&& mg_find(sv, PERL_MAGIC_qr)) {
@@ -4327,7 +4325,7 @@ static int sv_type(pTHX_ SV *sv)
(mg_find(sv, 'p')))
return svis_TIED_ITEM;
/* FALL THROUGH */
-#if PERL_VERSION < 9
+#if PERL_VERSION_LT(5,9,0)
case SVt_PVBM:
#endif
if ((SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) ==
@@ -4345,10 +4343,10 @@ static int sv_type(pTHX_ SV *sv)
return svis_HASH;
case SVt_PVCV:
return svis_CODE;
-#if PERL_VERSION > 8
+#if PERL_VERSION_GE(5,9,0)
/* case SVt_INVLIST: */
#endif
-#if PERL_VERSION > 10
+#if PERL_VERSION_GE(5,11,0)
case SVt_REGEXP:
return svis_REGEXP;
#endif
@@ -6689,7 +6687,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname)
*/
static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
{
-#if PERL_VERSION < 6
+#if PERL_VERSION_LT(5,6,0)
CROAK(("retrieve_code does not work with perl 5.005 or less\n"));
#else
dSP;
@@ -6817,7 +6815,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
}
static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
-#if PERL_VERSION >= 8
+#if PERL_VERSION_GE(5,8,0)
int op_flags;
U32 re_len;
STRLEN flags_len;
@@ -7582,7 +7580,7 @@ static SV *do_retrieve(
if (!sv) {
TRACEMED(("retrieve ERROR"));
-#if (PATCHLEVEL <= 4)
+#if PERL_VERSION_LT(5,5,0)
/* perl 5.00405 seems to screw up at this point with an
'attempt to modify a read only value' error reported in the
eval { $self = pretrieve(*FILE) } in _retrieve.
@@ -7712,7 +7710,7 @@ static SV *dclone(pTHX_ SV *sv)
*/
if ((SvTYPE(sv) == SVt_PVLV
-#if PERL_VERSION < 8
+#if PERL_VERSION_LT(5,8,0)
|| SvTYPE(sv) == SVt_PVMG
#endif
) && (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) ==
diff --git a/t/canonical.t b/t/canonical.t
index f7791ce..3b930aa 100644
--- a/t/canonical.t
+++ b/t/canonical.t
@@ -34,7 +34,7 @@ $maxarraysize = 100;
eval { require Digest::MD5; };
$gotmd5 = !$@;
-diag "Will use Digest::MD5" if $gotmd5;
+note "Will use Digest::MD5" if $gotmd5;
# Use Data::Dumper if debugging and it is available to create an ASCII dump
diff --git a/t/malice.t b/t/malice.t
index 5888863..8adae95 100644
--- a/t/malice.t
+++ b/t/malice.t
@@ -63,7 +63,7 @@ sub test_hash {
is (ref $clone, "HASH", "Get hash back");
is (scalar keys %$clone, 1, "with 1 key");
is ((keys %$clone)[0], "perl", "which is correct");
- is ($clone->{perl}, "rules");
+ is ($clone->{perl}, "rules", "Got expected value when looking up key in clone");
}
sub test_header {
@@ -238,7 +238,7 @@ sub test_things {
}
}
-ok (defined store(\%hash, $file));
+ok (defined store(\%hash, $file), "store() returned defined value");
my $expected = 20 + length ($file_magic_str) + $other_magic + $fancy;
my $length = -s $file;
@@ -266,7 +266,7 @@ test_things($stored, \&freeze_and_thaw, 'string');
# Network order.
unlink $file or die "Can't unlink '$file': $!";
-ok (defined nstore(\%hash, $file));
+ok (defined nstore(\%hash, $file), "nstore() returned defined value");
$expected = 20 + length ($file_magic_str) + $network_magic + $fancy;
$length = -s $file;
--
2.30.2