From blair at orcaware.com Wed Mar 17 20:40:20 2004 From: blair at orcaware.com (Blair Zajac) Date: Wed, 17 Mar 2004 20:40:20 -0800 Subject: [Orca-checkins] r289 - in trunk/orca: . packages/Storable-2.09 packages/Storable-2.11 packages/Storable-2.11/hints packages/Storable-2.11/t Message-ID: <200403180440.i2I4eKp0007963@orcaware.com> Author: blair Date: Wed Mar 17 20:39:57 2004 New Revision: 289 Added: trunk/orca/packages/Storable-2.11/ - copied from r283, trunk/orca/packages/Storable-2.09/ trunk/orca/packages/Storable-2.11/t/just_plain_nasty.t trunk/orca/packages/Storable-2.11/t/threads.t Removed: trunk/orca/packages/Storable-2.09/ Modified: trunk/orca/INSTALL trunk/orca/configure.in trunk/orca/packages/Storable-2.11/ChangeLog trunk/orca/packages/Storable-2.11/MANIFEST trunk/orca/packages/Storable-2.11/Storable.pm trunk/orca/packages/Storable-2.11/Storable.xs trunk/orca/packages/Storable-2.11/hints/linux.pl trunk/orca/packages/Storable-2.11/t/blessed.t trunk/orca/packages/Storable-2.11/t/code.t trunk/orca/packages/Storable-2.11/t/restrict.t Log: Upgrade Storable from 2.09 to 2.11 and require the new version for Orca. * configure.in: Bump Storable's version number to 2.11. * INSTALL (Determine which Perl modules need compiling and installing): Update all references to Storable's version number from 2.09 to 2.11. * packages/Storable-2.11: Renamed from packages/Storable-2.09. Directory contents updated from Storable-2.11.tar.gz. Modified: trunk/orca/INSTALL ============================================================================== --- trunk/orca/INSTALL (original) +++ trunk/orca/INSTALL Wed Mar 17 20:39:57 2004 @@ -176,7 +176,7 @@ Digest::MD5 >= 2.33 >= 2.33 2.33 Math::IntervalSearch >= 1.05 >= 1.05 1.05 RRDs >= 1.000461 >= 1.0.46 1.0.46 - Storable >= 2.09 >= 2.09 2.09 + Storable >= 2.11 >= 2.11 2.11 Time::HiRes Not required by Orca 1.55 All seven of these modules are included with the Orca distribution @@ -267,10 +267,10 @@ Storable - http://www.perl.com/CPAN/authors/id/A/AM/AMS/Storable-2.09.tar.gz + http://www.perl.com/CPAN/authors/id/A/AM/AMS/Storable-2.11.tar.gz - % gunzip -c Storable-2.09.tar.gz | tar xvf - - % cd Storable-2.09 + % gunzip -c Storable-2.11.tar.gz | tar xvf - + % cd Storable-2.11 % perl Makefile.PL % make % make test Modified: trunk/orca/configure.in ============================================================================== --- trunk/orca/configure.in (original) +++ trunk/orca/configure.in Wed Mar 17 20:39:57 2004 @@ -39,8 +39,8 @@ MATH_INTERVALSEARCH_VER=1.05 RRDTOOL_DIR=rrdtool-1.0.46 RRDTOOL_VER=1.000461 -STORABLE_DIR=Storable-2.09 -STORABLE_VER=2.09 +STORABLE_DIR=Storable-2.11 +STORABLE_VER=2.11 TIME_HIRES_DIR=Time-HiRes-1.55 TIME_HIRES_VER=1.55 Modified: trunk/orca/packages/Storable-2.11/ChangeLog ============================================================================== --- trunk/orca/packages/Storable-2.09/ChangeLog (original) +++ trunk/orca/packages/Storable-2.11/ChangeLog Wed Mar 17 20:39:57 2004 @@ -1,3 +1,28 @@ +Sat Mar 13 20:11:03 GMT 2004 Nicholas Clark + + Version 2.11 + + 1. Storing restricted hashes in canonical order would SEGV. Fixed. + 2. It was impossible to retrieve references to PL_sv_no and and + PL_sv_undef from STORABLE_thaw hooks. + 3. restrict.t was failing on 5.8.0, due to 5.8.0's unique + implementation of restricted hashes using PL_sv_undef + 4. These changes allow a space optimisation for restricted hashes. + +Sat Jan 24 16:22:32 IST 2004 Abhijit Menon-Sen + + Version 2.10 + + 1. Thread safety: Storable::CLONE/init_perlinterp() now create + a new Perl context for each new ithread. + (From Stas Bekman and Jan Dubois.) + 2. Fix a tag count mismatch with $Storable::Deparse that caused + all back-references after a stored sub to be off-by-N (where + N was the number of code references in between). + (From Sam Vilain.) + 3. Prevent CODE references from turning into SCALAR references. + (From Slaven Rezic.) + Sat Jan 3 18:49:18 GMT 2004 Nicholas Clark Version 2.09 Modified: trunk/orca/packages/Storable-2.11/MANIFEST ============================================================================== --- trunk/orca/packages/Storable-2.09/MANIFEST (original) +++ trunk/orca/packages/Storable-2.11/MANIFEST Wed Mar 17 20:39:57 2004 @@ -16,6 +16,7 @@ t/freeze.t See if Storable works t/integer.t For "use integer" testing t/interwork56.t Test combatibility kludge for 64bit data under 5.6.x +t/just_plain_nasty.t Corner case corner. t/lock.t See if Storable works t/make_56_interwork.pl Make test data for interwork56.t t/make_downgrade.pl Make test data for downgrade.t @@ -29,6 +30,7 @@ t/tied.t See if Storable works t/tied_hook.t See if Storable works t/tied_items.t See if Storable works +t/threads.t See if Storable works under ithreads t/utf8.t See if Storable works t/utf8hash.t See if Storable works t/Test/Builder.pm For testing the CPAN release on pre 5.6.2 Modified: trunk/orca/packages/Storable-2.11/Storable.pm ============================================================================== --- trunk/orca/packages/Storable-2.09/Storable.pm (original) +++ trunk/orca/packages/Storable-2.11/Storable.pm Wed Mar 17 20:39:57 2004 @@ -21,7 +21,7 @@ use AutoLoader; use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.09'; +$VERSION = '2.11'; *AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr... # @@ -47,6 +47,11 @@ } } +sub CLONE { + # clone context under threads + Storable::init_perinterp(); +} + # Can't Autoload cleanly as this clashes 8.3 with &retrieve sub retrieve_fd { &fd_retrieve } # Backward compatibility @@ -786,10 +791,10 @@ %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1); - store(\%color, '/tmp/colors') or die "Can't store %a in /tmp/colors!\n"; + store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n"; - $colref = retrieve('/tmp/colors'); - die "Unable to retrieve from /tmp/colors!\n" unless defined $colref; + $colref = retrieve('mycolors'); + die "Unable to retrieve from mycolors!\n" unless defined $colref; printf "Blue is still %lf\n", $colref->{'Blue'}; $colref2 = dclone(\%color); Modified: trunk/orca/packages/Storable-2.11/Storable.xs ============================================================================== --- trunk/orca/packages/Storable-2.09/Storable.xs (original) +++ trunk/orca/packages/Storable-2.11/Storable.xs Wed Mar 17 20:39:57 2004 @@ -288,6 +288,7 @@ HV *hseen; /* which objects have been seen, store time */ AV *hook_seen; /* which SVs were returned by STORABLE_freeze() */ AV *aseen; /* which objects have been seen, retrieve time */ + IV where_is_undef; /* index in aseen of PL_sv_undef */ HV *hclass; /* which classnames have been seen, store time */ AV *aclass; /* which classnames have been seen, retrieve time */ HV *hook; /* cache for hook methods per class name */ @@ -791,6 +792,13 @@ * Useful store shortcuts... */ +/* + * Note that if you put more than one mark for storing a particular + * type of thing, *and* in the retrieve_foo() function you mark both + * the thingy's you get off with SEEN(), you *must* increase the + * tagnum with cxt->tagnum++ along with this macro! + * - samv 20Jan04 + */ #define PUTMARK(x) \ STMT_START { \ if (!cxt->fio) \ @@ -937,12 +945,14 @@ * To achieve that, the class name of the last retrieved object is passed down * recursively, and the first SEEN() call for which the class name is not NULL * will bless the object. + * + * i should be true iff sv is immortal (ie PL_sv_yes, PL_sv_no or PL_sv_undef) */ -#define SEEN(y,c) \ +#define SEEN(y,c,i) \ STMT_START { \ if (!y) \ return (SV *) 0; \ - if (av_store(cxt->aseen, cxt->tagnum++, SvREFCNT_inc(y)) == 0) \ + if (av_store(cxt->aseen, cxt->tagnum++, i ? (SV*)(y) : SvREFCNT_inc(y)) == 0) \ return (SV *) 0; \ TRACEME(("aseen(#%d) = 0x%"UVxf" (refcnt=%d)", cxt->tagnum-1, \ PTR2UV(y), SvREFCNT(y)-1)); \ @@ -1330,6 +1340,7 @@ ? newHV() : 0); cxt->aseen = newAV(); /* Where retrieved objects are kept */ + cxt->where_is_undef = -1; /* Special case for PL_sv_undef */ cxt->aclass = newAV(); /* Where seen classnames are kept */ cxt->tagnum = 0; /* Have to count objects... */ cxt->classnum = 0; /* ...and class names as well */ @@ -1362,6 +1373,7 @@ av_undef(aseen); sv_free((SV *) aseen); } + cxt->where_is_undef = -1; if (cxt->aclass) { AV *aclass = cxt->aclass; @@ -2179,15 +2191,44 @@ qsort((char *) AvARRAY(av), len, sizeof(SV *), sortcmp); for (i = 0; i < len; i++) { - unsigned char flags; +#ifdef HAS_RESTRICTED_HASHES + int placeholders = HvPLACEHOLDERS(hv); +#endif + unsigned char flags = 0; char *keyval; STRLEN keylen_tmp; I32 keylen; SV *key = av_shift(av); + /* This will fail if key is a placeholder. + Track how many placeholders we have, and error if we + "see" too many. */ HE *he = hv_fetch_ent(hv, key, 0, 0); - SV *val = HeVAL(he); - if (val == 0) - return 1; /* Internal error, not I/O error */ + SV *val; + + if (he) { + if (!(val = HeVAL(he))) { + /* Internal error, not I/O error */ + return 1; + } + } else { +#ifdef HAS_RESTRICTED_HASHES + /* Should be a placeholder. */ + if (placeholders-- < 0) { + /* This should not happen - number of + retrieves should be identical to + number of placeholders. */ + return 1; + } + /* Value is never needed, and PL_sv_undef is + more space efficient to store. */ + val = &PL_sv_undef; + ASSERT (flags == 0, + ("Flags not 0 but %d", flags)); + flags = SHV_K_PLACEHOLDER; +#else + return 1; +#endif + } /* * Store value first. @@ -2208,12 +2249,9 @@ /* Implementation of restricted hashes isn't nicely abstracted: */ - flags - = (((hash_flags & SHV_RESTRICTED) - && SvREADONLY(val)) - ? SHV_K_LOCKED : 0); - if (val == &PL_sv_placeholder) - flags |= SHV_K_PLACEHOLDER; + if ((hash_flags & SHV_RESTRICTED) && SvREADONLY(val)) { + flags |= SHV_K_LOCKED; + } keyval = SvPV(key, keylen_tmp); keylen = keylen_tmp; @@ -2299,6 +2337,18 @@ if (val == 0) return 1; /* Internal error, not I/O error */ + /* Implementation of restricted hashes isn't nicely + abstracted: */ + flags + = (((hash_flags & SHV_RESTRICTED) + && SvREADONLY(val)) + ? SHV_K_LOCKED : 0); + + if (val == &PL_sv_placeholder) { + flags |= SHV_K_PLACEHOLDER; + val = &PL_sv_undef; + } + /* * Store value first. */ @@ -2308,14 +2358,6 @@ if ((ret = store(cxt, val))) /* Extra () for -Wall, grr... */ goto out; - /* Implementation of restricted hashes isn't nicely - abstracted: */ - flags - = (((hash_flags & SHV_RESTRICTED) - && SvREADONLY(val)) - ? SHV_K_LOCKED : 0); - if (val == &PL_sv_placeholder) - flags |= SHV_K_PLACEHOLDER; hek = HeKEY_hek(he); len = HEK_LEN(hek); @@ -2463,6 +2505,7 @@ */ PUTMARK(SX_CODE); + cxt->tagnum++; /* necessary, as SX_CODE is a SEEN() candidate */ TRACEME(("size = %d", len)); TRACEME(("code = %s", SvPV_nolen(text))); @@ -3259,7 +3302,39 @@ svh = hv_fetch(hseen, (char *) &sv, sizeof(sv), FALSE); if (svh) { - I32 tagval = htonl(LOW_32BITS(*svh)); + I32 tagval; + + if (sv == &PL_sv_undef) { + /* We have seen PL_sv_undef before, but fake it as + if we have not. + + Not the simplest solution to making restricted + hashes work on 5.8.0, but it does mean that + repeated references to the one true undef will + take up less space in the output file. + */ + /* Need to jump past the next hv_store, because on the + second store of undef the old hash value will be + SV_REFCNT_DEC()ed, and as Storable cheats horribly + by storing non-SVs in the hash a SEGV will ensure. + Need to increase the tag number so that the + receiver has no idea what games we're up to. This + special casing doesn't affect hooks that store + undef, as the hook routine does its own lookup into + hseen. Also this means that any references back + to PL_sv_undef (from the pathological case of hooks + storing references to it) will find the seen hash + entry for the first time, as if we didn't have this + hackery here. (That hseen lookup works even on 5.8.0 + because it's a key of &PL_sv_undef and a value + which is a tag number, not a value which is + PL_sv_undef.) */ + cxt->tagnum++; + type = svis_SCALAR; + goto undef_special_case; + } + + tagval = htonl(LOW_32BITS(*svh)); TRACEME(("object 0x%"UVxf" seen as #%d", PTR2UV(sv), ntohl(tagval))); @@ -3291,6 +3366,7 @@ type = sv_type(sv); +undef_special_case: TRACEME(("storing 0x%"UVxf" tag #%d, type %d...", PTR2UV(sv), cxt->tagnum, type)); @@ -3816,7 +3892,7 @@ default: return retrieve_other(cxt, 0); /* Let it croak */ } - SEEN(sv, 0); /* Don't bless yet */ + SEEN(sv, 0, 0); /* Don't bless yet */ /* * Whilst flags tell us to recurse, do so. @@ -3957,9 +4033,17 @@ READ_I32(tag); tag = ntohl(tag); svh = av_fetch(cxt->aseen, tag, FALSE); - if (!svh) - CROAK(("Object #%"IVdf" should have been retrieved already", - (IV) tag)); + if (!svh) { + if (tag == cxt->where_is_undef) { + /* av_fetch uses PL_sv_undef internally, hence this + somewhat gruesome hack. */ + xsv = &PL_sv_undef; + svh = &xsv; + } else { + CROAK(("Object #%"IVdf" should have been retrieved already", + (IV) tag)); + } + } xsv = *svh; ary[i] = SvREFCNT_inc(xsv); } @@ -4129,7 +4213,7 @@ */ rv = NEWSV(10002, 0); - SEEN(rv, cname); /* Will return if rv is null */ + SEEN(rv, cname, 0); /* Will return if rv is null */ sv = retrieve(cxt, 0); /* Retrieve