Skip to content

Commit 1c78e65

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 3ae4daa commit 1c78e65

File tree

3 files changed

+44
-44
lines changed

3 files changed

+44
-44
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: 39 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -16,19 +16,18 @@
1616
#include <perl.h>
1717
#include <XSUB.h>
1818

19-
#ifndef PATCHLEVEL
20-
#include <patchlevel.h> /* Perl's one, needed since 5.6 */
19+
#ifndef PERL_VERSION_LT
20+
#include "ppport.h" /* handle old perls */
2121
#endif
2222

23-
#if !defined(PERL_VERSION) || PERL_VERSION < 10 || (PERL_VERSION == 10 && PERL_SUBVERSION < 1)
23+
#if !defined(PERL_VERSION) || PERL_VERSION_LT(5,10,1)
2424
#define NEED_PL_parser
2525
#define NEED_sv_2pv_flags
2626
#define NEED_load_module
2727
#define NEED_vload_module
2828
#define NEED_newCONSTSUB
2929
#define NEED_newSVpvn_flags
3030
#define NEED_newRV_noinc
31-
#include "ppport.h" /* handle old perls */
3231
#endif
3332

3433
#ifdef DEBUGGING
@@ -521,7 +520,7 @@ static MAGIC *THX_sv_magicext(pTHX_
521520

522521
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
523522

524-
#if (PATCHLEVEL <= 4) && (SUBVERSION < 68)
523+
#if PERL_VERSION_LT(5,4,68)
525524
#define dSTCXT_SV \
526525
SV *perinterp_sv = get_sv(MY_VERSION, 0)
527526
#else /* >= perl5.004_68 */
@@ -1012,22 +1011,22 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
10121011
#define STORABLE_BIN_MAJOR 2 /* Binary major "version" */
10131012
#define STORABLE_BIN_MINOR 11 /* Binary minor "version" */
10141013

1015-
#if (PATCHLEVEL <= 5)
1014+
#if PERL_VERSION_LT(5,6,0)
10161015
#define STORABLE_BIN_WRITE_MINOR 4
10171016
#elif !defined (SvVOK)
10181017
/*
10191018
* Perl 5.6.0-5.8.0 can do weak references, but not vstring magic.
10201019
*/
10211020
#define STORABLE_BIN_WRITE_MINOR 8
1022-
#elif PATCHLEVEL >= 19
1021+
#elif PERL_VERSION_GE(5,19,0)
10231022
/* Perl 5.19 takes away the special meaning of PL_sv_undef in arrays. */
10241023
/* With 3.x we added LOBJECT */
10251024
#define STORABLE_BIN_WRITE_MINOR 11
10261025
#else
10271026
#define STORABLE_BIN_WRITE_MINOR 9
1028-
#endif /* (PATCHLEVEL <= 5) */
1027+
#endif /* PERL_VERSION_LT(5,6,0) */
10291028

1030-
#if (PATCHLEVEL < 8 || (PATCHLEVEL == 8 && SUBVERSION < 1))
1029+
#if PERL_VERSION_LT(5,8,1)
10311030
#define PL_sv_placeholder PL_sv_undef
10321031
#endif
10331032

@@ -1354,7 +1353,7 @@ static U32 Sntohl(U32 x) {
13541353
* sortsv is not available ( <= 5.6.1 ).
13551354
*/
13561355

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

13591358
#if defined(USE_ITHREADS)
13601359

@@ -1373,12 +1372,12 @@ static U32 Sntohl(U32 x) {
13731372

13741373
#endif /* USE_ITHREADS */
13751374

1376-
#else /* PATCHLEVEL > 6 */
1375+
#else /* PERL >= 5.7.0 */
13771376

13781377
#define STORE_HASH_SORT \
13791378
sortsv(AvARRAY(av), len, Perl_sv_cmp);
13801379

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

13831382
static int store(pTHX_ stcxt_t *cxt, SV *sv);
13841383
static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname);
@@ -1650,7 +1649,7 @@ static void init_store_context(pTHX_
16501649
*
16511650
* It is reported fixed in 5.005, hence the #if.
16521651
*/
1653-
#if PERL_VERSION >= 5
1652+
#if PERL_VERSION_GE(5,5,0)
16541653
#define HBUCKETS 4096 /* Buckets for %hseen */
16551654
#ifndef USE_PTR_TABLE
16561655
HvMAX(cxt->hseen) = HBUCKETS - 1; /* keys %hseen = $HBUCKETS; */
@@ -1667,7 +1666,7 @@ static void init_store_context(pTHX_
16671666

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

1670-
#if PERL_VERSION >= 5
1669+
#if PERL_VERSION_GE(5,5,0)
16711670
HvMAX(cxt->hclass) = HBUCKETS - 1; /* keys %hclass = $HBUCKETS; */
16721671
#endif
16731672

@@ -2244,15 +2243,15 @@ static AV *array_call(pTHX_
22442243
return av;
22452244
}
22462245

2247-
#if PERL_VERSION < 15
2246+
#if PERL_VERSION_LT(5,15,0)
22482247
static void
22492248
cleanup_recursive_av(pTHX_ AV* av) {
22502249
SSize_t i = AvFILLp(av);
22512250
SV** arr = AvARRAY(av);
22522251
if (SvMAGICAL(av)) return;
22532252
while (i >= 0) {
22542253
if (arr[i]) {
2255-
#if PERL_VERSION < 14
2254+
#if PERL_VERSION_LT(5,14,0)
22562255
arr[i] = NULL;
22572256
#else
22582257
SvREFCNT_dec(arr[i]);
@@ -2283,7 +2282,7 @@ cleanup_recursive_hv(pTHX_ HV* hv) {
22832282
}
22842283
i--;
22852284
}
2286-
#if PERL_VERSION < 8
2285+
#if PERL_VERSION_LT(5,8,0)
22872286
((XPVHV*)SvANY(hv))->xhv_array = NULL;
22882287
#else
22892288
HvARRAY(hv) = NULL;
@@ -2394,7 +2393,7 @@ static int store_ref(pTHX_ stcxt_t *cxt, SV *sv)
23942393
TRACEME((">ref recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth,
23952394
PTR2UV(cxt->recur_sv), cxt->max_recur_depth));
23962395
if (RECURSION_TOO_DEEP()) {
2397-
#if PERL_VERSION < 15
2396+
#if PERL_VERSION_LT(5,15,0)
23982397
cleanup_recursive_data(aTHX_ (SV*)sv);
23992398
#endif
24002399
CROAK((MAX_DEPTH_ERROR));
@@ -2498,7 +2497,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
24982497
/* public string - go direct to string read. */
24992498
goto string_readlen;
25002499
} else if (
2501-
#if (PATCHLEVEL <= 6)
2500+
#if PERL_VERSION_LT(5,7,0)
25022501
/* For 5.6 and earlier NV flag trumps IV flag, so only use integer
25032502
direct if NV flag is off. */
25042503
(flags & (SVf_NOK | SVf_IOK)) == SVf_IOK
@@ -2576,7 +2575,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
25762575
*/
25772576
Zero(&nv, 1, NV_bytes);
25782577
#endif
2579-
#if (PATCHLEVEL <= 6)
2578+
#if PERL_VERSION_LT(5,7,0)
25802579
nv.nv = SvNV(sv);
25812580
/*
25822581
* Watch for number being an integer in disguise.
@@ -2699,7 +2698,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
26992698
if (recur_sv != (SV*)av) {
27002699
if (RECURSION_TOO_DEEP()) {
27012700
/* with <= 5.14 it recurses in the cleanup also, needing 2x stack size */
2702-
#if PERL_VERSION < 15
2701+
#if PERL_VERSION_LT(5,15,0)
27032702
cleanup_recursive_data(aTHX_ (SV*)av);
27042703
#endif
27052704
CROAK((MAX_DEPTH_ERROR));
@@ -2717,7 +2716,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
27172716
STORE_SV_UNDEF();
27182717
continue;
27192718
}
2720-
#if PATCHLEVEL >= 19
2719+
#if PERL_VERSION_GE(5,19,0)
27212720
/* In 5.19.3 and up, &PL_sv_undef can actually be stored in
27222721
* an array; it no longer represents nonexistent elements.
27232722
* Historically, we have used SX_SV_UNDEF in arrays for
@@ -2748,7 +2747,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
27482747
}
27492748

27502749

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

27532752
/*
27542753
* sortcmp
@@ -2765,7 +2764,7 @@ sortcmp(const void *a, const void *b)
27652764
return sv_cmp(*(SV * const *) a, *(SV * const *) b);
27662765
}
27672766

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

27702769
/*
27712770
* store_hash
@@ -2861,7 +2860,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
28612860
++cxt->recur_depth;
28622861
}
28632862
if (RECURSION_TOO_DEEP_HASH()) {
2864-
#if PERL_VERSION < 15
2863+
#if PERL_VERSION_LT(5,15,0)
28652864
cleanup_recursive_data(aTHX_ (SV*)hv);
28662865
#endif
28672866
CROAK((MAX_DEPTH_ERROR));
@@ -3275,7 +3274,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
32753274
++cxt->recur_depth;
32763275
}
32773276
if (RECURSION_TOO_DEEP_HASH()) {
3278-
#if PERL_VERSION < 15
3277+
#if PERL_VERSION_LT(5,15,0)
32793278
cleanup_recursive_data(aTHX_ (SV*)hv);
32803279
#endif
32813280
CROAK((MAX_DEPTH_ERROR));
@@ -3311,7 +3310,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
33113310
*/
33123311
static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
33133312
{
3314-
#if PERL_VERSION < 6
3313+
#if PERL_VERSION_LT(5,6,0)
33153314
/*
33163315
* retrieve_code does not work with perl 5.005 or less
33173316
*/
@@ -3410,10 +3409,10 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
34103409
#endif
34113410
}
34123411

3413-
#if PERL_VERSION < 8
3412+
#if PERL_VERSION_LT(5,8,0)
34143413
# define PERL_MAGIC_qr 'r' /* precompiled qr// regex */
34153414
# define BFD_Svs_SMG_OR_RMG SVs_RMG
3416-
#elif ((PERL_VERSION==8) && (PERL_SUBVERSION >= 1) || (PERL_VERSION>8))
3415+
#elif PERL_VERSION_GE(5,8,1)
34173416
# define BFD_Svs_SMG_OR_RMG SVs_SMG
34183417
# define MY_PLACEHOLDER PL_sv_placeholder
34193418
#else
@@ -3424,7 +3423,7 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
34243423
static int get_regexp(pTHX_ stcxt_t *cxt, SV* sv, SV **re, SV **flags) {
34253424
dSP;
34263425
SV* rv;
3427-
#if PERL_VERSION >= 12
3426+
#if PERL_VERSION_GE(5,12,0)
34283427
CV *cv = get_cv("re::regexp_pattern", 0);
34293428
#else
34303429
CV *cv = get_cv("Storable::_regexp_pattern", 0);
@@ -4286,7 +4285,7 @@ static int sv_type(pTHX_ SV *sv)
42864285
{
42874286
switch (SvTYPE(sv)) {
42884287
case SVt_NULL:
4289-
#if PERL_VERSION <= 10
4288+
#if PERL_VERSION_LT(5,11,0)
42904289
case SVt_IV:
42914290
#endif
42924291
case SVt_NV:
@@ -4296,7 +4295,7 @@ static int sv_type(pTHX_ SV *sv)
42964295
*/
42974296
return svis_SCALAR;
42984297
case SVt_PV:
4299-
#if PERL_VERSION <= 10
4298+
#if PERL_VERSION_LT(5,11,0)
43004299
case SVt_RV:
43014300
#else
43024301
case SVt_IV:
@@ -4314,7 +4313,7 @@ static int sv_type(pTHX_ SV *sv)
43144313
*/
43154314
return SvROK(sv) ? svis_REF : svis_SCALAR;
43164315
case SVt_PVMG:
4317-
#if PERL_VERSION <= 10
4316+
#if PERL_VERSION_LT(5,11,0)
43184317
if ((SvFLAGS(sv) & (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
43194318
== (SVs_OBJECT|BFD_Svs_SMG_OR_RMG)
43204319
&& mg_find(sv, PERL_MAGIC_qr)) {
@@ -4327,7 +4326,7 @@ static int sv_type(pTHX_ SV *sv)
43274326
(mg_find(sv, 'p')))
43284327
return svis_TIED_ITEM;
43294328
/* FALL THROUGH */
4330-
#if PERL_VERSION < 9
4329+
#if PERL_VERSION_LT(5,9,0)
43314330
case SVt_PVBM:
43324331
#endif
43334332
if ((SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) ==
@@ -4345,10 +4344,10 @@ static int sv_type(pTHX_ SV *sv)
43454344
return svis_HASH;
43464345
case SVt_PVCV:
43474346
return svis_CODE;
4348-
#if PERL_VERSION > 8
4347+
#if PERL_VERSION_GE(5,9,0)
43494348
/* case SVt_INVLIST: */
43504349
#endif
4351-
#if PERL_VERSION > 10
4350+
#if PERL_VERSION_GE(5,11,0)
43524351
case SVt_REGEXP:
43534352
return svis_REGEXP;
43544353
#endif
@@ -6689,7 +6688,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname)
66896688
*/
66906689
static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
66916690
{
6692-
#if PERL_VERSION < 6
6691+
#if PERL_VERSION_LT(5,6,0)
66936692
CROAK(("retrieve_code does not work with perl 5.005 or less\n"));
66946693
#else
66956694
dSP;
@@ -6817,7 +6816,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
68176816
}
68186817

68196818
static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
6820-
#if PERL_VERSION >= 8
6819+
#if PERL_VERSION_GE(5,8,0)
68216820
int op_flags;
68226821
U32 re_len;
68236822
STRLEN flags_len;
@@ -7582,7 +7581,7 @@ static SV *do_retrieve(
75827581

75837582
if (!sv) {
75847583
TRACEMED(("retrieve ERROR"));
7585-
#if (PATCHLEVEL <= 4)
7584+
#if PERL_VERSION_LT(5,5,0)
75867585
/* perl 5.00405 seems to screw up at this point with an
75877586
'attempt to modify a read only value' error reported in the
75887587
eval { $self = pretrieve(*FILE) } in _retrieve.
@@ -7712,7 +7711,7 @@ static SV *dclone(pTHX_ SV *sv)
77127711
*/
77137712

77147713
if ((SvTYPE(sv) == SVt_PVLV
7715-
#if PERL_VERSION < 8
7714+
#if PERL_VERSION_LT(5,8,0)
77167715
|| SvTYPE(sv) == SVt_PVMG
77177716
#endif
77187717
) && (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)