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

5 files changed, 227 insertions, 75 deletions

diff --git a/ext/Storable/ChangeLog b/ext/Storable/ChangeLog
index 72951ddb3a..38450ff87f 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 8ec8e1e58b..3d66d78a98 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 5b3868b8f7..a98cdc5bc8 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 af8dd49885..5b971c26fa 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 58c10042c6..d5c4bd6a05 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";
+      }
     }
   }
 }