Skip to content

Commit 10de544

Browse files
atoomicatoomic
committed
Storable: use PERL_COMPARE macros
When bumping Storable with this change we would need to make sure to use the last version of ppport.h
1 parent 607b4d3 commit 10de544

File tree

3 files changed

+51
-52
lines changed

3 files changed

+51
-52
lines changed

‎dist/Storable/Storable.pm‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,9 @@ our @EXPORT_OK = qw(
2727

2828
our ($canonical, $forgive_me);
2929

30+
our $VERSION;
3031
BEGIN {
31-
our $VERSION = '3.21';
32+
$VERSION = '3.22';
3233
}
3334

3435
our $recursion_limit;

‎dist/Storable/Storable.xs‎

Lines changed: 46 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -16,18 +16,16 @@
1616
#include <perl.h>
1717
#include <XSUB.h>
1818

19-
#ifndef PATCHLEVEL
20-
#include <patchlevel.h> /* Perl's one, needed since 5.6 */
21-
#endif
22-
23-
#if !defined(PERL_VERSION) || PERL_VERSION < 10 || (PERL_VERSION == 10 && PERL_SUBVERSION < 1)
24-
#define NEED_PL_parser
25-
#define NEED_sv_2pv_flags
26-
#define NEED_load_module
27-
#define NEED_vload_module
28-
#define NEED_newCONSTSUB
29-
#define NEED_newSVpvn_flags
30-
#define NEED_newRV_noinc
19+
#ifndef PERL_VERSION_LT
20+
# if !defined(PERL_VERSION) || !defined(PERL_REVISION) || ( PERL_REVISION == 5 && ( PERL_VERSION < 10 || (PERL_VERSION == 10 && PERL_SUBVERSION < 1) ) )
21+
# define NEED_PL_parser
22+
# define NEED_sv_2pv_flags
23+
# define NEED_load_module
24+
# define NEED_vload_module
25+
# define NEED_newCONSTSUB
26+
# define NEED_newSVpvn_flags
27+
# define NEED_newRV_noinc
28+
# endif
3129
#include "ppport.h" /* handle old perls */
3230
#endif
3331

@@ -521,7 +519,7 @@ static MAGIC *THX_sv_magicext(pTHX_
521519

522520
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
523521

524-
#if (PATCHLEVEL <= 4) && (SUBVERSION < 68)
522+
#if PERL_VERSION_LT(5,4,68)
525523
#define dSTCXT_SV \
526524
SV *perinterp_sv = get_sv(MY_VERSION, 0)
527525
#else /* >= perl5.004_68 */
@@ -1012,22 +1010,22 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
10121010
#define STORABLE_BIN_MAJOR 2 /* Binary major "version" */
10131011
#define STORABLE_BIN_MINOR 11 /* Binary minor "version" */
10141012

1015-
#if (PATCHLEVEL <= 5)
1013+
#if PERL_VERSION_LT(5,6,0)
10161014
#define STORABLE_BIN_WRITE_MINOR 4
10171015
#elif !defined (SvVOK)
10181016
/*
10191017
* Perl 5.6.0-5.8.0 can do weak references, but not vstring magic.
10201018
*/
10211019
#define STORABLE_BIN_WRITE_MINOR 8
1022-
#elif PATCHLEVEL >= 19
1020+
#elif PERL_VERSION_GE(5,19,0)
10231021
/* Perl 5.19 takes away the special meaning of PL_sv_undef in arrays. */
10241022
/* With 3.x we added LOBJECT */
10251023
#define STORABLE_BIN_WRITE_MINOR 11
10261024
#else
10271025
#define STORABLE_BIN_WRITE_MINOR 9
1028-
#endif /* (PATCHLEVEL <= 5) */
1026+
#endif /* PERL_VERSION_LT(5,6,0) */
10291027

1030-
#if (PATCHLEVEL < 8 || (PATCHLEVEL == 8 && SUBVERSION < 1))
1028+
#if PERL_VERSION_LT(5,8,1)
10311029
#define PL_sv_placeholder PL_sv_undef
10321030
#endif
10331031

@@ -1354,7 +1352,7 @@ static U32 Sntohl(U32 x) {
13541352
* sortsv is not available ( <= 5.6.1 ).
13551353
*/
13561354

1357-
#if (PATCHLEVEL <= 6)
1355+
#if PERL_VERSION_LT(5,7,0)
13581356

13591357
#if defined(USE_ITHREADS)
13601358

@@ -1373,12 +1371,12 @@ static U32 Sntohl(U32 x) {
13731371

13741372
#endif /* USE_ITHREADS */
13751373

1376-
#else /* PATCHLEVEL > 6 */
1374+
#else /* PERL >= 5.7.0 */
13771375

13781376
#define STORE_HASH_SORT \
13791377
sortsv(AvARRAY(av), len, Perl_sv_cmp);
13801378

1381-
#endif /* PATCHLEVEL <= 6 */
1379+
#endif /* PERL_VERSION_LT(5,7,0) */
13821380

13831381
static int store(pTHX_ stcxt_t *cxt, SV *sv);
13841382
static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname);
@@ -1650,7 +1648,7 @@ static void init_store_context(pTHX_
16501648
*
16511649
* It is reported fixed in 5.005, hence the #if.
16521650
*/
1653-
#if PERL_VERSION >= 5
1651+
#if PERL_VERSION_GE(5,5,0)
16541652
#define HBUCKETS 4096 /* Buckets for %hseen */
16551653
#ifndef USE_PTR_TABLE
16561654
HvMAX(cxt->hseen) = HBUCKETS - 1; /* keys %hseen = $HBUCKETS; */
@@ -1667,7 +1665,7 @@ static void init_store_context(pTHX_
16671665

16681666
cxt->hclass = newHV(); /* Where seen classnames are stored */
16691667

1670-
#if PERL_VERSION >= 5
1668+
#if PERL_VERSION_GE(5,5,0)
16711669
HvMAX(cxt->hclass) = HBUCKETS - 1; /* keys %hclass = $HBUCKETS; */
16721670
#endif
16731671

@@ -2244,15 +2242,15 @@ static AV *array_call(pTHX_
22442242
return av;
22452243
}
22462244

2247-
#if PERL_VERSION < 15
2245+
#if PERL_VERSION_LT(5,15,0)
22482246
static void
22492247
cleanup_recursive_av(pTHX_ AV* av) {
22502248
SSize_t i = AvFILLp(av);
22512249
SV** arr = AvARRAY(av);
22522250
if (SvMAGICAL(av)) return;
22532251
while (i >= 0) {
22542252
if (arr[i]) {
2255-
#if PERL_VERSION < 14
2253+
#if PERL_VERSION_LT(5,14,0)
22562254
arr[i] = NULL;
22572255
#else
22582256
SvREFCNT_dec(arr[i]);
@@ -2283,7 +2281,7 @@ cleanup_recursive_hv(pTHX_ HV* hv) {
22832281
}
22842282
i--;
22852283
}
2286-
#if PERL_VERSION < 8
2284+
#if PERL_VERSION_LT(5,8,0)
22872285
((XPVHV*)SvANY(hv))->xhv_array = NULL;
22882286
#else
22892287
HvARRAY(hv) = NULL;
@@ -2394,7 +2392,7 @@ static int store_ref(pTHX_ stcxt_t *cxt, SV *sv)
23942392
TRACEME((">ref recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth,
23952393
PTR2UV(cxt->recur_sv), cxt->max_recur_depth));
23962394
if (RECURSION_TOO_DEEP()) {
2397-
#if PERL_VERSION < 15
2395+
#if PERL_VERSION_LT(5,15,0)
23982396
cleanup_recursive_data(aTHX_ (SV*)sv);
23992397
#endif
24002398
CROAK((MAX_DEPTH_ERROR));
@@ -2498,7 +2496,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
24982496
/* public string - go direct to string read. */
24992497
goto string_readlen;
25002498
} else if (
2501-
#if (PATCHLEVEL <= 6)
2499+
#if PERL_VERSION_LT(5,7,0)
25022500
/* For 5.6 and earlier NV flag trumps IV flag, so only use integer
25032501
direct if NV flag is off. */
25042502
(flags & (SVf_NOK | SVf_IOK)) == SVf_IOK
@@ -2576,7 +2574,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
25762574
*/
25772575
Zero(&nv, 1, NV_bytes);
25782576
#endif
2579-
#if (PATCHLEVEL <= 6)
2577+
#if PERL_VERSION_LT(5,7,0)
25802578
nv.nv = SvNV(sv);
25812579
/*
25822580
* Watch for number being an integer in disguise.
@@ -2699,7 +2697,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
26992697
if (recur_sv != (SV*)av) {
27002698
if (RECURSION_TOO_DEEP()) {
27012699
/* with <= 5.14 it recurses in the cleanup also, needing 2x stack size */
2702-
#if PERL_VERSION < 15
2700+
#if PERL_VERSION_LT(5,15,0)
27032701
cleanup_recursive_data(aTHX_ (SV*)av);
27042702
#endif
27052703
CROAK((MAX_DEPTH_ERROR));
@@ -2717,7 +2715,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
27172715
STORE_SV_UNDEF();
27182716
continue;
27192717
}
2720-
#if PATCHLEVEL >= 19
2718+
#if PERL_VERSION_GE(5,19,0)
27212719
/* In 5.19.3 and up, &PL_sv_undef can actually be stored in
27222720
* an array; it no longer represents nonexistent elements.
27232721
* Historically, we have used SX_SV_UNDEF in arrays for
@@ -2748,7 +2746,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
27482746
}
27492747

27502748

2751-
#if (PATCHLEVEL <= 6)
2749+
#if PERL_VERSION_LT(5,7,0)
27522750

27532751
/*
27542752
* sortcmp
@@ -2765,7 +2763,7 @@ sortcmp(const void *a, const void *b)
27652763
return sv_cmp(*(SV * const *) a, *(SV * const *) b);
27662764
}
27672765

2768-
#endif /* PATCHLEVEL <= 6 */
2766+
#endif /* PERL_VERSION_LT(5,7,0) */
27692767

27702768
/*
27712769
* store_hash
@@ -2861,7 +2859,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
28612859
++cxt->recur_depth;
28622860
}
28632861
if (RECURSION_TOO_DEEP_HASH()) {
2864-
#if PERL_VERSION < 15
2862+
#if PERL_VERSION_LT(5,15,0)
28652863
cleanup_recursive_data(aTHX_ (SV*)hv);
28662864
#endif
28672865
CROAK((MAX_DEPTH_ERROR));
@@ -3275,7 +3273,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
32753273
++cxt->recur_depth;
32763274
}
32773275
if (RECURSION_TOO_DEEP_HASH()) {
3278-
#if PERL_VERSION < 15
3276+
#if PERL_VERSION_LT(5,15,0)
32793277
cleanup_recursive_data(aTHX_ (SV*)hv);
32803278
#endif
32813279
CROAK((MAX_DEPTH_ERROR));
@@ -3311,7 +3309,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
33113309
*/
33123310
static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
33133311
{
3314-
#if PERL_VERSION < 6
3312+
#if PERL_VERSION_LT(5,6,0)
33153313
/*
33163314
* retrieve_code does not work with perl 5.005 or less
33173315
*/
@@ -3410,10 +3408,10 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
34103408
#endif
34113409
}
34123410

3413-
#if PERL_VERSION < 8
3411+
#if PERL_VERSION_LT(5,8,0)
34143412
# define PERL_MAGIC_qr 'r' /* precompiled qr// regex */
34153413
# define BFD_Svs_SMG_OR_RMG SVs_RMG
3416-
#elif ((PERL_VERSION==8) && (PERL_SUBVERSION >= 1) || (PERL_VERSION>8))
3414+
#elif PERL_VERSION_GE(5,8,1)
34173415
# define BFD_Svs_SMG_OR_RMG SVs_SMG
34183416
# define MY_PLACEHOLDER PL_sv_placeholder
34193417
#else
@@ -3424,7 +3422,7 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
34243422
static int get_regexp(pTHX_ stcxt_t *cxt, SV* sv, SV **re, SV **flags) {
34253423
dSP;
34263424
SV* rv;
3427-
#if PERL_VERSION >= 12
3425+
#if PERL_VERSION_GE(5,12,0)
34283426
CV *cv = get_cv("re::regexp_pattern", 0);
34293427
#else
34303428
CV *cv = get_cv("Storable::_regexp_pattern", 0);
@@ -4286,7 +4284,7 @@ static int sv_type(pTHX_ SV *sv)
42864284
{
42874285
switch (SvTYPE(sv)) {
42884286
case SVt_NULL:
4289-
#if PERL_VERSION <= 10
4287+
#if PERL_VERSION_LT(5,11,0)
42904288
case SVt_IV:
42914289
#endif
42924290
case SVt_NV:
@@ -4296,7 +4294,7 @@ static int sv_type(pTHX_ SV *sv)
42964294
*/
42974295
return svis_SCALAR;
42984296
case SVt_PV:
4299-
#if PERL_VERSION <= 10
4297+
#if PERL_VERSION_LT(5,11,0)
43004298
case SVt_RV:
43014299
#else
43024300
case SVt_IV:
@@ -4314,7 +4312,7 @@ static int sv_type(pTHX_ SV *sv)
43144312
*/
43154313
return SvROK(sv) ? svis_REF : svis_SCALAR;
43164314
case SVt_PVMG:
4317-
#if PERL_VERSION <= 10
4315+
#if PERL_VERSION_LT(5,11,0)
43184316
if ((SvFLAGS(sv) & (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
43194317
== (SVs_OBJECT|BFD_Svs_SMG_OR_RMG)
43204318
&& mg_find(sv, PERL_MAGIC_qr)) {
@@ -4327,7 +4325,7 @@ static int sv_type(pTHX_ SV *sv)
43274325
(mg_find(sv, 'p')))
43284326
return svis_TIED_ITEM;
43294327
/* FALL THROUGH */
4330-
#if PERL_VERSION < 9
4328+
#if PERL_VERSION_LT(5,9,0)
43314329
case SVt_PVBM:
43324330
#endif
43334331
if ((SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) ==
@@ -4345,10 +4343,10 @@ static int sv_type(pTHX_ SV *sv)
43454343
return svis_HASH;
43464344
case SVt_PVCV:
43474345
return svis_CODE;
4348-
#if PERL_VERSION > 8
4346+
#if PERL_VERSION_GE(5,9,0)
43494347
/* case SVt_INVLIST: */
43504348
#endif
4351-
#if PERL_VERSION > 10
4349+
#if PERL_VERSION_GE(5,11,0)
43524350
case SVt_REGEXP:
43534351
return svis_REGEXP;
43544352
#endif
@@ -6689,7 +6687,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname)
66896687
*/
66906688
static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
66916689
{
6692-
#if PERL_VERSION < 6
6690+
#if PERL_VERSION_LT(5,6,0)
66936691
CROAK(("retrieve_code does not work with perl 5.005 or less\n"));
66946692
#else
66956693
dSP;
@@ -6817,7 +6815,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
68176815
}
68186816

68196817
static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
6820-
#if PERL_VERSION >= 8
6818+
#if PERL_VERSION_GE(5,8,0)
68216819
int op_flags;
68226820
U32 re_len;
68236821
STRLEN flags_len;
@@ -7582,7 +7580,7 @@ static SV *do_retrieve(
75827580

75837581
if (!sv) {
75847582
TRACEMED(("retrieve ERROR"));
7585-
#if (PATCHLEVEL <= 4)
7583+
#if PERL_VERSION_LT(5,5,0)
75867584
/* perl 5.00405 seems to screw up at this point with an
75877585
'attempt to modify a read only value' error reported in the
75887586
eval { $self = pretrieve(*FILE) } in _retrieve.
@@ -7712,7 +7710,7 @@ static SV *dclone(pTHX_ SV *sv)
77127710
*/
77137711

77147712
if ((SvTYPE(sv) == SVt_PVLV
7715-
#if PERL_VERSION < 8
7713+
#if PERL_VERSION_LT(5,8,0)
77167714
|| SvTYPE(sv) == SVt_PVMG
77177715
#endif
77187716
) && (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) ==

‎dist/Storable/t/malice.t‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -63,7 +63,7 @@ sub test_hash {
6363
is (ref $clone, "HASH", "Get hash back");
6464
is (scalar keys %$clone, 1, "with 1 key");
6565
is ((keys %$clone)[0], "perl", "which is correct");
66-
is ($clone->{perl}, "rules");
66+
is ($clone->{perl}, "rules", "Got expected value when looking up key in clone");
6767
}
6868

6969
sub test_header {
@@ -238,7 +238,7 @@ sub test_things {
238238
}
239239
}
240240

241-
ok (defined store(\%hash, $file));
241+
ok (defined store(\%hash, $file), "store() returned defined value");
242242

243243
my $expected = 20 + length ($file_magic_str) + $other_magic + $fancy;
244244
my $length = -s $file;
@@ -266,7 +266,7 @@ test_things($stored, \&freeze_and_thaw, 'string');
266266
# Network order.
267267
unlink $file or die "Can't unlink '$file': $!";
268268

269-
ok (defined nstore(\%hash, $file));
269+
ok (defined nstore(\%hash, $file), "nstore() returned defined value");
270270

271271
$expected = 20 + length ($file_magic_str) + $network_magic + $fancy;
272272
$length = -s $file;

0 commit comments

Comments
 (0)