Storable can't freeze restricted hashes in canonical order #7171
Comments
From @nwc10Created by @nwc10/home/nick/snap5.9.x-22493/bin/perl5.9.1 -MHash::Util=lock_keys -MStorable=freeze -e '$Storable::canonical=1; %a = (bang=>1); lock_keys %a; delete $a{bang}; freeze \%a' Which is due to this hash fetch failing (line 2194-ish of Storable.xs): Better regression tests and a fix following soon. (we were only testing dclone Mmmm. I wonder how many people are actually storing them... Nicholas Clark Perl Info |
From @nwc10On Sat, Mar 13, 2004 at 01:22:15PM -0000, Nicholas Clark wrote:
Appended patch will fix this bug. Now back to Beau's bug. Nicholas Clark Inline Patch--- Storable.xs.orig 2004-01-24 10:49:49.000000000 +0000
+++ Storable.xs 2004-03-13 15:05:13.000000000 +0000
@@ -2186,15 +2186,39 @@ static int store_hash(stcxt_t *cxt, HV *
qsort((char *) AvARRAY(av), len, sizeof(SV *), sortcmp);
for (i = 0; i < len; i++) {
+#ifdef HAS_RESTRICTED_HASHES
+ int placeholders = HvPLACEHOLDERS(hv);
+#endif
unsigned char flags;
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;
+ }
+ val = &PL_sv_placeholder;
+#else
+ return 1;
+#endif
+ }
/*
* Store value first.
--- t/restrict.t.orig 2004-02-28 03:45:11.000000000 +0000
+++ t/restrict.t 2004-03-13 15:08:13.000000000 +0000
@@ -35,10 +35,10 @@ sub BEGIN {
}
-use Storable qw(dclone);
+use Storable qw(dclone freeze thaw);
use Hash::Util qw(lock_hash unlock_value);
-print "1..50\n";
+print "1..100\n";
my %hash = (question => '?', answer => 42, extra => 'junk', undef => undef);
lock_hash %hash;
@@ -56,9 +56,15 @@ sub me_second {
package main;
+sub freeze_thaw {
+ my $temp = freeze $_[0];
+ return thaw $temp;
+}
+
sub testit {
my $hash = shift;
- my $copy = dclone $hash;
+ my $cloner = shift;
+ my $copy = &$cloner($hash);
my @in_keys = sort keys %$hash;
my @out_keys = sort keys %$copy;
@@ -96,27 +102,29 @@ sub testit {
}
for $Storable::canonical (0, 1) {
- print "# \$Storable::canonical = $Storable::canonical\n";
- testit (\%hash);
- my $object = \%hash;
- # bless {}, "Restrict_Test";
-
- my %hash2;
- $hash2{"k$_"} = "v$_" for 0..16;
- lock_hash %hash2;
- for (0..16) {
- unlock_value %hash2, "k$_";
- delete $hash2{"k$_"};
- }
- my $copy = dclone \%hash2;
+ for my $cloner (\&dclone, \&freeze_thaw) {
+ print "# \$Storable::canonical = $Storable::canonical\n";
+ testit (\%hash, $cloner);
+ my $object = \%hash;
+ # bless {}, "Restrict_Test";
+
+ my %hash2;
+ $hash2{"k$_"} = "v$_" for 0..16;
+ lock_hash %hash2;
+ for (0..16) {
+ unlock_value %hash2, "k$_";
+ delete $hash2{"k$_"};
+ }
+ my $copy = &$cloner(\%hash2);
- for (0..16) {
- my $k = "k$_";
- eval { $copy->{$k} = undef } ;
- unless (ok ++$test, !$@, "Can assign to reserved key '$k'?") {
- my $diag = $@;
- $diag =~ s/\n.*\z//s;
- print "# \$\@: $diag\n";
+ for (0..16) {
+ my $k = "k$_";
+ eval { $copy->{$k} = undef } ;
+ unless (ok ++$test, !$@, "Can assign to reserved key '$k'?") {
+ my $diag = $@;
+ $diag =~ s/\n.*\z//s;
+ print "# \$\@: $diag\n";
+ }
}
}
} |
From beau@beaucox.comOn Saturday 13 March 2004 05:13 am, Nicholas Clark wrote:
I am truly honored to have a bug named after me ;) But really, if you need any 'grunt' work (traces, Aloha => Beau; |
|
The RT System itself - Status changed from 'new' to 'open' |
From @nwc10On Sat, Mar 13, 2004 at 06:21:16AM -1000, Beau E. Cox wrote:
Thanks for the offer, but I think that I understand what's going on sub STORABLE_freeze { like this: Object #1 should have been retrieved already at blib/lib/Storable.pm (autosplit into blib/lib/auto/Storable/thaw.al) line 363, at t/blessed.t line 131 It's the same bug - the bug is that it's not possible (currently) to correctly Given that there are 7 sets of namespaces in perl Nicholas Clark |
From @nwc10On Sat, Mar 13, 2004 at 03:13:28PM +0000, Nicholas Clark wrote:
OK. Then you need this patch to make it possible to store references [strictly you don't need this patch, but it fixes a related bug and makes Nicholas Clark Inline Patch--- t/blessed.t.orig 2002-11-25 11:57:21.000000000 +0000
+++ t/blessed.t 2004-03-13 19:46:21.000000000 +0000
@@ -25,7 +25,15 @@ sub ok;
use Storable qw(freeze thaw);
-print "1..12\n";
+%::immortals
+ = (u => \undef,
+ 'y' => \(1 == 1),
+ n => \(1 == 0)
+);
+
+my $test = 12;
+my $tests = $test + 2 * 6 * keys %::immortals;
+print "1..$tests\n";
package SHORT_NAME;
@@ -106,3 +114,47 @@ ok 10, $good;
ok 11, ref $y eq 'Foobar';
ok 12, $$$y->[0] == 1;
}
+
+package RETURNS_IMMORTALS;
+
+sub make { my $self = shift; bless [@_], $self }
+
+sub STORABLE_freeze {
+ # Some reference some number of times.
+ my $self = shift;
+ my ($what, $times) = @$self;
+ return ("$what$times", ($::immortals{$what}) x $times);
+}
+
+sub STORABLE_thaw {
+ my $self = shift;
+ my $cloning = shift;
+ my ($x, @refs) = @_;
+ my ($what, $times) = $x =~ /(.)(\d+)/;
+ die "'$x' didn't match" unless defined $times;
+ main::ok ++$test, @refs == $times;
+ my $expect = $::immortals{$what};
+ die "'$x' did not give a reference" unless ref $expect;
+ my $fail;
+ foreach (@refs) {
+ $fail++ if $_ != $expect;
+ }
+ main::ok ++$test, !$fail;
+}
+
+package main;
+
+# $Storable::DEBUGME = 1;
+my $count;
+foreach $count (1..3) {
+ my $immortal;
+ foreach $immortal (keys %::immortals) {
+ print "# $immortal x $count\n";
+ my $i = RETURNS_IMMORTALS->make ($immortal, $count);
+
+ my $f = freeze ($i);
+ ok ++$test, $f;
+ my $t = thaw $f;
+ ok ++$test, 1;
+ }
+}
--- Storable.xs.orig 2004-03-13 15:05:13.000000000 +0000
+++ Storable.xs 2004-03-13 20:07:18.000000000 +0000
@@ -288,6 +288,7 @@ typedef struct stcxt {
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 */
@@ -944,12 +945,14 @@ static const char byteorderstr_56[] = {B
* 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)); \
@@ -1337,6 +1340,7 @@ static void init_retrieve_context(stcxt_
? 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 */
@@ -1369,6 +1373,7 @@ static void clean_retrieve_context(stcxt
av_undef(aseen);
sv_free((SV *) aseen);
}
+ cxt->where_is_undef = -1;
if (cxt->aclass) {
AV *aclass = cxt->aclass;
@@ -3848,7 +3853,7 @@ static SV *retrieve_hook(stcxt_t *cxt, c
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.
@@ -3989,9 +3994,17 @@ static SV *retrieve_hook(stcxt_t *cxt, c
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);
}
@@ -4161,7 +4174,7 @@ static SV *retrieve_ref(stcxt_t *cxt, ch
*/
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 <object> */
if (!sv)
return (SV *) 0; /* Failed */
@@ -4218,7 +4231,7 @@ static SV *retrieve_overloaded(stcxt_t *
*/
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 <object> */
if (!sv)
return (SV *) 0; /* Failed */
@@ -4264,7 +4277,7 @@ static SV *retrieve_tied_array(stcxt_t *
TRACEME(("retrieve_tied_array (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname); /* Will return if tv is null */
+ SEEN(tv, cname, 0); /* Will return if tv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
@@ -4293,7 +4306,7 @@ static SV *retrieve_tied_hash(stcxt_t *c
TRACEME(("retrieve_tied_hash (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname); /* Will return if tv is null */
+ SEEN(tv, cname, 0); /* Will return if tv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
@@ -4321,7 +4334,7 @@ static SV *retrieve_tied_scalar(stcxt_t
TRACEME(("retrieve_tied_scalar (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname); /* Will return if rv is null */
+ SEEN(tv, cname, 0); /* Will return if rv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv) {
return (SV *) 0; /* Failed */
@@ -4358,7 +4371,7 @@ static SV *retrieve_tied_key(stcxt_t *cx
TRACEME(("retrieve_tied_key (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname); /* Will return if tv is null */
+ SEEN(tv, cname, 0); /* Will return if tv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
@@ -4390,7 +4403,7 @@ static SV *retrieve_tied_idx(stcxt_t *cx
TRACEME(("retrieve_tied_idx (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname); /* Will return if tv is null */
+ SEEN(tv, cname, 0); /* Will return if tv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
@@ -4427,7 +4440,7 @@ static SV *retrieve_lscalar(stcxt_t *cxt
*/
sv = NEWSV(10002, len);
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
/*
* WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation.
@@ -4473,7 +4486,7 @@ static SV *retrieve_scalar(stcxt_t *cxt,
*/
sv = NEWSV(10002, len);
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
/*
* WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation.
@@ -4585,7 +4598,7 @@ static SV *retrieve_integer(stcxt_t *cxt
READ(&iv, sizeof(iv));
sv = newSViv(iv);
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("integer %"IVdf, iv));
TRACEME(("ok (retrieve_integer at 0x%"UVxf")", PTR2UV(sv)));
@@ -4614,7 +4627,7 @@ static SV *retrieve_netint(stcxt_t *cxt,
sv = newSViv(iv);
TRACEME(("network integer (as-is) %d", iv));
#endif
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("ok (retrieve_netint at 0x%"UVxf")", PTR2UV(sv)));
@@ -4636,7 +4649,7 @@ static SV *retrieve_double(stcxt_t *cxt,
READ(&nv, sizeof(nv));
sv = newSVnv(nv);
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("double %"NVff, nv));
TRACEME(("ok (retrieve_double at 0x%"UVxf")", PTR2UV(sv)));
@@ -4662,7 +4675,7 @@ static SV *retrieve_byte(stcxt_t *cxt, c
TRACEME(("small integer read as %d", (unsigned char) siv));
tmp = (unsigned char) siv - 128;
sv = newSViv(tmp);
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("byte %d", tmp));
TRACEME(("ok (retrieve_byte at 0x%"UVxf")", PTR2UV(sv)));
@@ -4682,7 +4695,7 @@ static SV *retrieve_undef(stcxt_t *cxt,
TRACEME(("retrieve_undef"));
sv = newSV(0);
- SEEN(sv, cname);
+ SEEN(sv, cname, 0);
return sv;
}
@@ -4698,7 +4711,13 @@ static SV *retrieve_sv_undef(stcxt_t *cx
TRACEME(("retrieve_sv_undef"));
- SEEN(sv, cname);
+ ASSERT(cxt->where_is_undef == -1,
+ ("Saw undef before at %i", cxt->where_is_undef));
+ /* Special case PL_sv_undef, as av_fetch uses it internally to mark
+ deleted elements, and will return NULL (fetch failed) whenever it
+ is fetched. */
+ cxt->where_is_undef = cxt->tagnum;
+ SEEN(sv, cname, 1);
return sv;
}
@@ -4713,7 +4732,7 @@ static SV *retrieve_sv_yes(stcxt_t *cxt,
TRACEME(("retrieve_sv_yes"));
- SEEN(sv, cname);
+ SEEN(sv, cname, 1);
return sv;
}
@@ -4728,8 +4747,7 @@ static SV *retrieve_sv_no(stcxt_t *cxt,
TRACEME(("retrieve_sv_no"));
- cxt->tagnum--; /* undo the tagnum increment in retrieve_l?scalar */
- SEEN(sv, cname);
+ SEEN(sv, cname, 1);
return sv;
}
@@ -4758,7 +4776,7 @@ static SV *retrieve_array(stcxt_t *cxt,
RLEN(len);
TRACEME(("size = %d", len));
av = newAV();
- SEEN(av, cname); /* Will return if array not allocated nicely */
+ SEEN(av, cname, 0); /* Will return if array not allocated nicely */
if (len)
av_extend(av, len);
else
@@ -4810,7 +4828,7 @@ static SV *retrieve_hash(stcxt_t *cxt, c
RLEN(len);
TRACEME(("size = %d", len));
hv = newHV();
- SEEN(hv, cname); /* Will return if table not allocated properly */
+ SEEN(hv, cname, 0); /* Will return if table not allocated properly */
if (len == 0)
return (SV *) hv; /* No data follow if table empty */
hv_ksplit(hv, len); /* pre-extend hash to save multiple splits */
@@ -4896,7 +4914,7 @@ static SV *retrieve_flag_hash(stcxt_t *c
RLEN(len);
TRACEME(("size = %d, flags = %d", len, hash_flags));
hv = newHV();
- SEEN(hv, cname); /* Will return if table not allocated properly */
+ SEEN(hv, cname, 0); /* Will return if table not allocated properly */
if (len == 0)
return (SV *) hv; /* No data follow if table empty */
hv_ksplit(hv, len); /* pre-extend hash to save multiple splits */
@@ -5024,7 +5042,7 @@ static SV *retrieve_code(stcxt_t *cxt, c
*/
tagnum = cxt->tagnum;
sv = newSViv(0);
- SEEN(sv, cname);
+ SEEN(sv, cname, 0);
/*
* Retrieve the source of the code reference
@@ -5141,7 +5159,7 @@ static SV *old_retrieve_array(stcxt_t *c
RLEN(len);
TRACEME(("size = %d", len));
av = newAV();
- SEEN(av, 0); /* Will return if array not allocated nicely */
+ SEEN(av, 0, 0); /* Will return if array not allocated nicely */
if (len)
av_extend(av, len);
else
@@ -5203,7 +5221,7 @@ static SV *old_retrieve_hash(stcxt_t *cx
RLEN(len);
TRACEME(("size = %d", len));
hv = newHV();
- SEEN(hv, 0); /* Will return if table not allocated properly */
+ SEEN(hv, 0, 0); /* Will return if table not allocated properly */
if (len == 0)
return (SV *) hv; /* No data follow if table empty */
hv_ksplit(hv, len); /* pre-extend hash to save multiple splits */
--- Storable.pm.orig 2004-02-29 04:48:14.000000000 +0000
+++ Storable.pm 2004-03-13 20:14:00.000000000 +0000
@@ -21,7 +21,7 @@ package Storable; @ISA = qw(Exporter Dyn
use AutoLoader;
use vars qw($canonical $forgive_me $VERSION);
-$VERSION = '2.10';
+$VERSION = '2.11';
*AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr...
# |
From @nwc10On Sat, Mar 13, 2004 at 08:23:45PM +0000, Nicholas Clark wrote:
Actually really useful, as if it had not been there I'd've introduced a new With the appended Storable will pass all the (existing) tests on 5.8.0 Nicholas Clark Inline Patch--- ChangeLog.orig 2004-01-24 11:02:14.000000000 +0000
+++ ChangeLog 2004-03-13 22:03:54.000000000 +0000
@@ -1,3 +1,13 @@
+Sat Mar 13 20:11:03 GMT 2004 Nicholas Clark <nick@ccl4.org>
+
+ 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
+
Sat Jan 24 16:22:32 IST 2004 Abhijit Menon-Sen <ams@wiw.org>
Version 2.10
--- Storable.xs.orig 2004-03-13 20:07:18.000000000 +0000
+++ Storable.xs 2004-03-13 22:18:14.000000000 +0000
@@ -3296,7 +3296,39 @@ static int store(stcxt_t *cxt, SV *sv)
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)));
@@ -3328,6 +3360,7 @@ static int store(stcxt_t *cxt, SV *sv)
type = sv_type(sv);
+undef_special_case:
TRACEME(("storing 0x%"UVxf" tag #%d, type %d...",
PTR2UV(sv), cxt->tagnum, type));
@@ -4711,12 +4744,12 @@ static SV *retrieve_sv_undef(stcxt_t *cx
TRACEME(("retrieve_sv_undef"));
- ASSERT(cxt->where_is_undef == -1,
- ("Saw undef before at %i", cxt->where_is_undef));
/* Special case PL_sv_undef, as av_fetch uses it internally to mark
deleted elements, and will return NULL (fetch failed) whenever it
is fetched. */
- cxt->where_is_undef = cxt->tagnum;
+ if (cxt->where_is_undef == -1) {
+ cxt->where_is_undef = cxt->tagnum;
+ }
SEEN(sv, cname, 1);
return sv;
} |
From @chipdudeAccording to Nicholas Clark:
Larry, Andy, Chip, Malcolm, Sarathy, Jarkko, Hugo, Rafael ... eight. Darn. |
From sky@nanisky.comOn 13 Mar 2004, at 22:38, Chip Salzenberg wrote:
Nicholas? Arthur |
From @nwc10On Sat, Mar 13, 2004 at 10:39:58PM +0000, Arthur Bergman wrote:
Also without checking perlhist.pod Charles Bailey and Tim Bunce However, I think "mortal" is apt. :-) Nicholas Clark |
From @nwc10And the previous 3 changes allow a space optimisation for the storage of That's it. At least until Monday :-) Nicholas Clark Inline Patch--- ChangeLog.orig 2004-03-13 22:59:57.000000000 +0000
+++ ChangeLog 2004-03-13 23:00:58.000000000 +0000
@@ -7,6 +7,7 @@ Sat Mar 13 20:11:03 GMT 2004 Nicholas
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 <ams@wiw.org>
--- Storable.xs.orig 2004-03-13 22:59:58.000000000 +0000
+++ Storable.xs 2004-03-13 22:47:50.000000000 +0000
@@ -2194,7 +2194,7 @@ static int store_hash(stcxt_t *cxt, HV *
#ifdef HAS_RESTRICTED_HASHES
int placeholders = HvPLACEHOLDERS(hv);
#endif
- unsigned char flags;
+ unsigned char flags = 0;
char *keyval;
STRLEN keylen_tmp;
I32 keylen;
@@ -2219,7 +2219,12 @@ static int store_hash(stcxt_t *cxt, HV *
number of placeholders. */
return 1;
}
- val = &PL_sv_placeholder;
+ /* 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
@@ -2244,12 +2249,9 @@ static int store_hash(stcxt_t *cxt, HV *
/* 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;
@@ -2335,6 +2337,18 @@ static int store_hash(stcxt_t *cxt, HV *
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.
*/
@@ -2344,14 +2358,6 @@ static int store_hash(stcxt_t *cxt, HV *
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); |
From @chipdudeAccording to Nicholas Clark:
I was only going for the development-track pumpkings, just so the So we _have_ had Nine mortal pumpkings doomed to burn out: Larry, Andy, Charles, Chip, Malcolm, Sarathy, Jarkko, Nicholas, Hugo. |
From @rgsNicholas Clark wrote:
All four patches applied to blead as #22498, thanks. |
|
p5p@spam.wizbit.be - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#27616 (status was 'resolved')
Searchable as RT27616$
The text was updated successfully, but these errors were encountered: