417 lines
13 KiB
Diff
417 lines
13 KiB
Diff
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
|
|
|