Storable-2.21
diff -urpN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST
--- perl-5.10.0.orig/MANIFEST 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/MANIFEST 2009-10-01 13:18:44.000000000 +0200
@@ -1028,6 +1028,7 @@ ext/Socket/t/Socket.t See if Socket wor
ext/Storable/ChangeLog Storable extension
ext/Storable/hints/gnukfreebsd.pl Hint for Storable for named architecture
ext/Storable/hints/gnuknetbsd.pl Hint for Storable for named architecture
+ext/Storable/hints/hpux.pl Hint for Storable for named architecture
ext/Storable/hints/linux.pl Hint for Storable for named architecture
ext/Storable/Makefile.PL Storable extension
ext/Storable/MANIFEST Storable extension
diff -urpN perl-5.10.0.orig/ext/Storable/ChangeLog perl-5.10.0/ext/Storable/ChangeLog
--- perl-5.10.0.orig/ext/Storable/ChangeLog 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/ChangeLog 2009-10-01 13:17:50.000000000 +0200
@@ -1,3 +1,18 @@
+Thu Aug 6 10:55:50 IST 2009 Abhijit Menon-Sen <ams@toroid.org>
+
+ Version 2.21
+
+ Includes hints/hpux.pl that was inadvertently left out of 2.20.
+
+Mon May 18 09:38:20 IST 2009 Abhijit Menon-Sen <ams@toroid.org>
+
+ Version 2.20
+
+ Fix bug handling blessed references to overloaded objects, plus
+ other miscellaneous fixes.
+
+ (Version 2.19 was released with 5.8.9.)
+
Thu Nov 22 13:24:18 IST 2007 Abhijit Menon-Sen <ams@toroid.org>
Version 2.18
diff -urpN perl-5.10.0.orig/ext/Storable/MANIFEST perl-5.10.0/ext/Storable/MANIFEST
--- perl-5.10.0.orig/ext/Storable/MANIFEST 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/MANIFEST 2009-10-01 13:17:50.000000000 +0200
@@ -4,6 +4,7 @@ Makefile.PL Generic Makefile templa
Storable.pm The perl side of Storable
Storable.xs The C side of Storable
ChangeLog Changes since baseline
+hints/hpux.pl Hint file to drop to -O1 on HPUX
hints/linux.pl Hint file to drop gcc to -O2
hints/gnukfreebsd.pl Hint file to drop gcc to -O2
hints/gnuknetbsd.pl Hint file to drop gcc to -O2
diff -urpN perl-5.10.0.orig/ext/Storable/Makefile.PL perl-5.10.0/ext/Storable/Makefile.PL
--- perl-5.10.0.orig/ext/Storable/Makefile.PL 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/Makefile.PL 2009-10-01 13:17:58.000000000 +0200
@@ -11,7 +11,6 @@ use Config;
WriteMakefile(
NAME => 'Storable',
DISTNAME => "Storable",
- MAN3PODS => {},
# We now ship this in t/
# PREREQ_PM => { 'Test::More' => '0.41' },
INSTALLDIRS => $] >= 5.007 ? 'perl' : 'site',
diff -urpN perl-5.10.0.orig/ext/Storable/Storable.pm perl-5.10.0/ext/Storable/Storable.pm
--- perl-5.10.0.orig/ext/Storable/Storable.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/Storable.pm 2009-10-01 13:17:58.000000000 +0200
@@ -23,7 +23,7 @@ use AutoLoader;
use FileHandle;
use vars qw($canonical $forgive_me $VERSION);
-$VERSION = '2.18';
+$VERSION = '2.21';
*AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr...
#
@@ -1177,7 +1177,7 @@ Storable was written by Raphael Manfredi
Maintenance is now done by the perl5-porters F<E<lt>perl5-porters@perl.orgE<gt>>
Please e-mail us with problems, bug fixes, comments and complaints,
-although if you have complements you should send them to Raphael.
+although if you have compliments you should send them to Raphael.
Please don't e-mail Raphael with problems, as he no longer works on
Storable, and your message will be delayed while he forwards it to us.
diff -urpN perl-5.10.0.orig/ext/Storable/Storable.xs perl-5.10.0/ext/Storable/Storable.xs
--- perl-5.10.0.orig/ext/Storable/Storable.xs 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/Storable.xs 2009-10-01 13:17:58.000000000 +0200
@@ -151,7 +151,7 @@ typedef double NV; /* Older perls lack
#define TRACEME(x) \
STMT_START { \
- if (SvTRUE(perl_get_sv("Storable::DEBUGME", TRUE))) \
+ if (SvTRUE(perl_get_sv("Storable::DEBUGME", GV_ADD))) \
{ PerlIO_stdoutf x; PerlIO_stdoutf("\n"); } \
} STMT_END
#else
@@ -401,7 +401,7 @@ typedef struct stcxt {
#if (PATCHLEVEL <= 4) && (SUBVERSION < 68)
#define dSTCXT_SV \
- SV *perinterp_sv = perl_get_sv(MY_VERSION, FALSE)
+ SV *perinterp_sv = perl_get_sv(MY_VERSION, 0)
#else /* >= perl5.004_68 */
#define dSTCXT_SV \
SV *perinterp_sv = *hv_fetch(PL_modglobal, \
@@ -1682,7 +1682,7 @@ static SV *pkg_fetchmeth(
pTHX_
HV *cache,
HV *pkg,
- char *method)
+ const char *method)
{
GV *gv;
SV *sv;
@@ -1722,7 +1722,7 @@ static void pkg_hide(
pTHX_
HV *cache,
HV *pkg,
- char *method)
+ const char *method)
{
const char *hvname = HvNAME_get(pkg);
(void) hv_store(cache,
@@ -1738,7 +1738,7 @@ static void pkg_uncache(
pTHX_
HV *cache,
HV *pkg,
- char *method)
+ const char *method)
{
const char *hvname = HvNAME_get(pkg);
(void) hv_delete(cache, hvname, strlen(hvname), G_DISCARD);
@@ -1756,7 +1756,7 @@ static SV *pkg_can(
pTHX_
HV *cache,
HV *pkg,
- char *method)
+ const char *method)
{
SV **svh;
SV *sv;
@@ -2332,7 +2332,7 @@ static int store_hash(pTHX_ stcxt_t *cxt
if (
!(cxt->optype & ST_CLONE) && (cxt->canonical == 1 ||
(cxt->canonical < 0 && (cxt->canonical =
- (SvTRUE(perl_get_sv("Storable::canonical", TRUE)) ? 1 : 0))))
+ (SvTRUE(perl_get_sv("Storable::canonical", GV_ADD)) ? 1 : 0))))
) {
/*
* Storing in order, sorted by key.
@@ -2619,7 +2619,7 @@ static int store_code(pTHX_ stcxt_t *cxt
if (
cxt->deparse == 0 ||
(cxt->deparse < 0 && !(cxt->deparse =
- SvTRUE(perl_get_sv("Storable::Deparse", TRUE)) ? 1 : 0))
+ SvTRUE(perl_get_sv("Storable::Deparse", GV_ADD)) ? 1 : 0))
) {
return store_other(aTHX_ cxt, (SV*)cv);
}
@@ -3397,7 +3397,7 @@ static int store_other(pTHX_ stcxt_t *cx
if (
cxt->forgive_me == 0 ||
(cxt->forgive_me < 0 && !(cxt->forgive_me =
- SvTRUE(perl_get_sv("Storable::forgive_me", TRUE)) ? 1 : 0))
+ SvTRUE(perl_get_sv("Storable::forgive_me", GV_ADD)) ? 1 : 0))
)
CROAK(("Can't store %s items", sv_reftype(sv, FALSE)));
@@ -3434,7 +3434,9 @@ static int sv_type(pTHX_ SV *sv)
{
switch (SvTYPE(sv)) {
case SVt_NULL:
+#if PERL_VERSION <= 10
case SVt_IV:
+#endif
case SVt_NV:
/*
* No need to check for ROK, that can't be set here since there
@@ -3442,7 +3444,11 @@ static int sv_type(pTHX_ SV *sv)
*/
return svis_SCALAR;
case SVt_PV:
+#if PERL_VERSION <= 10
case SVt_RV:
+#else
+ case SVt_IV:
+#endif
case SVt_PVIV:
case SVt_PVNV:
/*
@@ -3683,7 +3689,7 @@ static int magic_write(pTHX_ stcxt_t *cx
length = sizeof (network_file_header);
} else {
#ifdef USE_56_INTERWORK_KLUDGE
- if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", TRUE))) {
+ if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", GV_ADD))) {
header = file_header_56;
length = sizeof (file_header_56);
} else
@@ -4444,7 +4450,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *
* into the existing design. -- RAM, 17/02/2001
*/
- sv_magic(sv, rv, mtype, Nullch, 0);
+ sv_magic(sv, rv, mtype, (char *)NULL, 0);
SvREFCNT_dec(rv); /* Undo refcnt inc from sv_magic() */
return sv;
@@ -4497,7 +4503,7 @@ static SV *retrieve_ref(pTHX_ stcxt_t *c
if (cname) {
/* No need to do anything, as rv will already be PVMG. */
- assert (SvTYPE(rv) >= SVt_RV);
+ assert (SvTYPE(rv) == SVt_RV || SvTYPE(rv) >= SVt_PV);
} else {
sv_upgrade(rv, SVt_RV);
}
@@ -4561,7 +4567,7 @@ static SV *retrieve_overloaded(pTHX_ stc
* WARNING: breaks RV encapsulation.
*/
- sv_upgrade(rv, SVt_RV);
+ SvUPGRADE(rv, SVt_RV);
SvRV_set(rv, sv); /* $rv = \$sv */
SvROK_on(rv);
@@ -4641,7 +4647,7 @@ static SV *retrieve_tied_array(pTHX_ stc
sv_upgrade(tv, SVt_PVAV);
AvREAL_off((AV *)tv);
- sv_magic(tv, sv, 'P', Nullch, 0);
+ sv_magic(tv, sv, 'P', (char *)NULL, 0);
SvREFCNT_dec(sv); /* Undo refcnt inc from sv_magic() */
TRACEME(("ok (retrieve_tied_array at 0x%"UVxf")", PTR2UV(tv)));
@@ -4669,7 +4675,7 @@ static SV *retrieve_tied_hash(pTHX_ stcx
return (SV *) 0; /* Failed */
sv_upgrade(tv, SVt_PVHV);
- sv_magic(tv, sv, 'P', Nullch, 0);
+ sv_magic(tv, sv, 'P', (char *)NULL, 0);
SvREFCNT_dec(sv); /* Undo refcnt inc from sv_magic() */
TRACEME(("ok (retrieve_tied_hash at 0x%"UVxf")", PTR2UV(tv)));
@@ -4701,7 +4707,7 @@ static SV *retrieve_tied_scalar(pTHX_ st
}
sv_upgrade(tv, SVt_PVMG);
- sv_magic(tv, obj, 'q', Nullch, 0);
+ sv_magic(tv, obj, 'q', (char *)NULL, 0);
if (obj) {
/* Undo refcnt inc from sv_magic() */
@@ -4768,7 +4774,7 @@ static SV *retrieve_tied_idx(pTHX_ stcxt
RLEN(idx); /* Retrieve <idx> */
sv_upgrade(tv, SVt_PVMG);
- sv_magic(tv, sv, 'p', Nullch, idx);
+ sv_magic(tv, sv, 'p', (char *)NULL, idx);
SvREFCNT_dec(sv); /* Undo refcnt inc from sv_magic() */
return tv;
@@ -4907,7 +4913,7 @@ static SV *retrieve_utf8str(pTHX_ stcxt_
#else
if (cxt->use_bytes < 0)
cxt->use_bytes
- = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
? 1 : 0);
if (cxt->use_bytes == 0)
UTF8_CROAK();
@@ -4936,7 +4942,7 @@ static SV *retrieve_lutf8str(pTHX_ stcxt
#else
if (cxt->use_bytes < 0)
cxt->use_bytes
- = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
? 1 : 0);
if (cxt->use_bytes == 0)
UTF8_CROAK();
@@ -5267,7 +5273,7 @@ static SV *retrieve_flag_hash(pTHX_ stcx
if (hash_flags & SHV_RESTRICTED) {
if (cxt->derestrict < 0)
cxt->derestrict
- = (SvTRUE(perl_get_sv("Storable::downgrade_restricted", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::downgrade_restricted", GV_ADD))
? 1 : 0);
if (cxt->derestrict == 0)
RESTRICTED_HASH_CROAK();
@@ -5336,7 +5342,7 @@ static SV *retrieve_flag_hash(pTHX_ stcx
#else
if (cxt->use_bytes < 0)
cxt->use_bytes
- = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
? 1 : 0);
if (cxt->use_bytes == 0)
UTF8_CROAK();
@@ -5437,14 +5443,14 @@ static SV *retrieve_code(pTHX_ stcxt_t *
*/
if (cxt->eval == NULL) {
- cxt->eval = perl_get_sv("Storable::Eval", TRUE);
+ cxt->eval = perl_get_sv("Storable::Eval", GV_ADD);
SvREFCNT_inc(cxt->eval);
}
if (!SvTRUE(cxt->eval)) {
if (
cxt->forgive_me == 0 ||
(cxt->forgive_me < 0 && !(cxt->forgive_me =
- SvTRUE(perl_get_sv("Storable::forgive_me", TRUE)) ? 1 : 0))
+ SvTRUE(perl_get_sv("Storable::forgive_me", GV_ADD)) ? 1 : 0))
) {
CROAK(("Can't eval, please set $Storable::Eval to a true value"));
} else {
@@ -5459,7 +5465,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *
SAVETMPS;
if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) {
- SV* errsv = get_sv("@", TRUE);
+ SV* errsv = get_sv("@", GV_ADD);
sv_setpvn(errsv, "", 0); /* clear $@ */
PUSHMARK(sp);
XPUSHs(sv_2mortal(newSVsv(sub)));
@@ -5771,7 +5777,7 @@ static SV *magic_check(pTHX_ stcxt_t *cx
if (cxt->accept_future_minor < 0)
cxt->accept_future_minor
= (SvTRUE(perl_get_sv("Storable::accept_future_minor",
- TRUE))
+ GV_ADD))
? 1 : 0);
if (cxt->accept_future_minor == 1)
croak_now = 0; /* Don't croak yet. */
@@ -5808,7 +5814,7 @@ static SV *magic_check(pTHX_ stcxt_t *cx
#ifdef USE_56_INTERWORK_KLUDGE
/* No point in caching this in the context as we only need it once per
retrieve, and we need to recheck it each read. */
- if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", TRUE))) {
+ if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", GV_ADD))) {
if ((c != (sizeof (byteorderstr_56) - 1))
|| memNE(buf, byteorderstr_56, c))
CROAK(("Byte order is not compatible"));
@@ -5942,7 +5948,7 @@ static SV *retrieve(pTHX_ stcxt_t *cxt,
if (cxt->accept_future_minor < 0)
cxt->accept_future_minor
= (SvTRUE(perl_get_sv("Storable::accept_future_minor",
- TRUE))
+ GV_ADD))
? 1 : 0);
if (cxt->accept_future_minor == 1) {
CROAK(("Storable binary image v%d.%d contains data of type %d. "
diff -urpN perl-5.10.0.orig/ext/Storable/hints/hpux.pl perl-5.10.0/ext/Storable/hints/hpux.pl
--- perl-5.10.0.orig/ext/Storable/hints/hpux.pl 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/Storable/hints/hpux.pl 2009-10-01 13:17:58.000000000 +0200
@@ -0,0 +1,10 @@
+# HP C-ANSI-C has problems in the optimizer for 5.8.x (not for 5.11.x)
+# So drop to -O1 for Storable
+
+use Config;
+
+unless ($Config{gccversion}) {
+ my $optimize = $Config{optimize};
+ $optimize =~ s/(^| )[-+]O[2-9]( |$)/$1+O1$2/ and
+ $self->{OPTIMIZE} = $optimize;
+ }
diff -urpN perl-5.10.0.orig/ext/Storable/t/overload.t perl-5.10.0/ext/Storable/t/overload.t
--- perl-5.10.0.orig/ext/Storable/t/overload.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/t/overload.t 2009-10-01 13:17:58.000000000 +0200
@@ -25,7 +25,7 @@ sub ok;
use Storable qw(freeze thaw);
-print "1..16\n";
+print "1..19\n";
package OVERLOADED;
@@ -103,4 +103,17 @@ ok 13, $@ eq "";
ok 14, ref ($t) eq 'REF';
ok 15, ref ($$t) eq 'HAS_OVERLOAD';
ok 16, $$$t eq 'snow';
+
+
+#---
+# blessed reference to overloded object.
+{
+ my $a = bless [88], 'OVERLOADED';
+ my $c = thaw freeze bless \$a, 'main';
+ ok 17, ref $c eq 'main';
+ ok 18, ref $$c eq 'OVERLOADED';
+ ok 19, "$$c" eq "88";
+
+}
+
1;