From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 13 Mar 2004 15:13:28 +0000 (+0000)
Subject: Four Storable patches towards Storable 2.11 :
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dfd914092bc0efff7a5ad67a7b5cadfabbc009a6;p=p5sagit%2Fp5-mst-13.2.git
Four Storable patches towards Storable 2.11 :
Subject: Re: [perl #27616] Storable can't freeze restricted hashes in canonical order
Date: Sat, 13 Mar 2004 15:13:28 +0000
Message-ID: <20040313151327.GS701@plum.flirble.org>
Date: Sat, 13 Mar 2004 20:23:45 +0000
Message-ID: <20040313202345.GX701@plum.flirble.org>
Date: Sat, 13 Mar 2004 22:20:07 +0000
Message-ID: <20040313222007.GZ701@plum.flirble.org>
Date: Sat, 13 Mar 2004 23:03:46 +0000
Message-ID: <20040313230345.GB701@plum.flirble.org>
p4raw-id: //depot/perl@22498
---
diff --git a/ext/Storable/ChangeLog b/ext/Storable/ChangeLog
index 72951dd..38450ff 100644
--- a/ext/Storable/ChangeLog
+++ b/ext/Storable/ChangeLog
@@ -1,3 +1,14 @@
+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
+ 4. These changes allow a space optimisation for restricted hashes.
+
Sat Jan 24 16:22:32 IST 2004 Abhijit Menon-Sen <ams@wiw.org>
Version 2.10
diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm
index 8ec8e1e..3d66d78 100644
--- a/ext/Storable/Storable.pm
+++ b/ext/Storable/Storable.pm
@@ -21,7 +21,7 @@ package Storable; @ISA = qw(Exporter DynaLoader);
use AutoLoader;
use vars qw($canonical $forgive_me $VERSION);
-$VERSION = '2.10';
+$VERSION = '2.11';
*AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr...
#
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 5b3868b..a98cdc5 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -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[] = {BYTEORDER_BYTES_56, 0};
* 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_t *cxt, int optype, int is_tainted)
? 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_t *cxt)
av_undef(aseen);
sv_free((SV *) aseen);
}
+ cxt->where_is_undef = -1;
if (cxt->aclass) {
AV *aclass = cxt->aclass;
@@ -2186,15 +2191,44 @@ static int store_hash(stcxt_t *cxt, HV *hv)
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.
@@ -2215,12 +2249,9 @@ static int store_hash(stcxt_t *cxt, HV *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;
@@ -2306,6 +2337,18 @@ static int store_hash(stcxt_t *cxt, HV *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.
*/
@@ -2315,14 +2358,6 @@ static int store_hash(stcxt_t *cxt, HV *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);
@@ -3267,7 +3302,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)));
@@ -3299,6 +3366,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));
@@ -3824,7 +3892,7 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname)
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.
@@ -3965,9 +4033,17 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname)
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);
}
@@ -4137,7 +4213,7 @@ static SV *retrieve_ref(stcxt_t *cxt, char *cname)
*/
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 */
@@ -4194,7 +4270,7 @@ static SV *retrieve_overloaded(stcxt_t *cxt, char *cname)
*/
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 */
@@ -4240,7 +4316,7 @@ static SV *retrieve_tied_array(stcxt_t *cxt, char *cname)
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 */
@@ -4269,7 +4345,7 @@ static SV *retrieve_tied_hash(stcxt_t *cxt, char *cname)
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 */
@@ -4297,7 +4373,7 @@ static SV *retrieve_tied_scalar(stcxt_t *cxt, char *cname)
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 */
@@ -4334,7 +4410,7 @@ static SV *retrieve_tied_key(stcxt_t *cxt, char *cname)
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 */
@@ -4366,7 +4442,7 @@ static SV *retrieve_tied_idx(stcxt_t *cxt, char *cname)
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 */
@@ -4403,7 +4479,7 @@ static SV *retrieve_lscalar(stcxt_t *cxt, char *cname)
*/
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.
@@ -4449,7 +4525,7 @@ static SV *retrieve_scalar(stcxt_t *cxt, char *cname)
*/
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.
@@ -4561,7 +4637,7 @@ static SV *retrieve_integer(stcxt_t *cxt, char *cname)
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)));
@@ -4590,7 +4666,7 @@ static SV *retrieve_netint(stcxt_t *cxt, char *cname)
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)));
@@ -4612,7 +4688,7 @@ static SV *retrieve_double(stcxt_t *cxt, char *cname)
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)));
@@ -4638,7 +4714,7 @@ static SV *retrieve_byte(stcxt_t *cxt, char *cname)
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)));
@@ -4658,7 +4734,7 @@ static SV *retrieve_undef(stcxt_t *cxt, char *cname)
TRACEME(("retrieve_undef"));
sv = newSV(0);
- SEEN(sv, cname);
+ SEEN(sv, cname, 0);
return sv;
}
@@ -4674,7 +4750,13 @@ static SV *retrieve_sv_undef(stcxt_t *cxt, char *cname)
TRACEME(("retrieve_sv_undef"));
- SEEN(sv, cname);
+ /* 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. */
+ if (cxt->where_is_undef == -1) {
+ cxt->where_is_undef = cxt->tagnum;
+ }
+ SEEN(sv, cname, 1);
return sv;
}
@@ -4689,7 +4771,7 @@ static SV *retrieve_sv_yes(stcxt_t *cxt, char *cname)
TRACEME(("retrieve_sv_yes"));
- SEEN(sv, cname);
+ SEEN(sv, cname, 1);
return sv;
}
@@ -4704,8 +4786,7 @@ static SV *retrieve_sv_no(stcxt_t *cxt, char *cname)
TRACEME(("retrieve_sv_no"));
- cxt->tagnum--; /* undo the tagnum increment in retrieve_l?scalar */
- SEEN(sv, cname);
+ SEEN(sv, cname, 1);
return sv;
}
@@ -4734,7 +4815,7 @@ static SV *retrieve_array(stcxt_t *cxt, char *cname)
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
@@ -4786,7 +4867,7 @@ static SV *retrieve_hash(stcxt_t *cxt, char *cname)
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 */
@@ -4872,7 +4953,7 @@ static SV *retrieve_flag_hash(stcxt_t *cxt, char *cname)
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 */
@@ -5000,7 +5081,7 @@ static SV *retrieve_code(stcxt_t *cxt, char *cname)
*/
tagnum = cxt->tagnum;
sv = newSViv(0);
- SEEN(sv, cname);
+ SEEN(sv, cname, 0);
/*
* Retrieve the source of the code reference
@@ -5117,7 +5198,7 @@ static SV *old_retrieve_array(stcxt_t *cxt, char *cname)
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
@@ -5179,7 +5260,7 @@ static SV *old_retrieve_hash(stcxt_t *cxt, char *cname)
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 */
diff --git a/ext/Storable/t/blessed.t b/ext/Storable/t/blessed.t
index af8dd49..5b971c2 100644
--- a/ext/Storable/t/blessed.t
+++ b/ext/Storable/t/blessed.t
@@ -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;
+ }
+}
diff --git a/ext/Storable/t/restrict.t b/ext/Storable/t/restrict.t
index 58c1004..d5c4bd6 100644
--- a/ext/Storable/t/restrict.t
+++ b/ext/Storable/t/restrict.t
@@ -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 (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 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";
+ }
}
}
}