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 + + 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 + + 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 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 Fperl5-porters@perl.orgE> 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 */ 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;