From: Abhijit Menon-Sen <ams@wiw.org>
Date: Fri, 5 Sep 2003 18:43:46 +0000 (+0000)
Subject: 1. Work around the bug fixed by #20587 (because it's in 5.8.0).
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fcaa57e7f91cda946b2f56c966b0368e91277889;p=p5sagit%2Fp5-mst-13.2.git

1. Work around the bug fixed by #20587 (because it's in 5.8.0).
2. Compensate for PL_sv_placeholder <= 5.8.1.
3. Clean up non-backwards-compatible tests.
4. Prepare for the 2.08 CPAN release.

p4raw-id: //depot/perl@21051
---

diff --git a/ext/Storable/ChangeLog b/ext/Storable/ChangeLog
index f4edf0c..b91e4f5 100644
--- a/ext/Storable/ChangeLog
+++ b/ext/Storable/ChangeLog
@@ -1,3 +1,15 @@
+Sat Sep  6 01:08:20 IST 2003   Abhijit Menon-Sen <ams@wiw.org>
+
+    Version 2.08
+
+        This release works around a 5.8.0 bug which caused hashes to not
+        be marked as having key flags even though an HEK had HEK_WASUTF8
+        set. (Note that the only reasonable solution is to silently drop
+        the flag from the affected key.)
+
+        Users of RT 3 who were seeing assertion failures should upgrade.
+        (Perl 5.8.1 will have the bug fixed.)
+
 Mon May  5 10:24:16 IST 2003   Abhijit Menon-Sen <ams@wiw.org>
 
     Version 2.07
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index b714b17..ce8185c 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -783,6 +783,10 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 #define STORABLE_BIN_WRITE_MINOR	6
 #endif /* (PATCHLEVEL <= 6) */
 
+#if (PATCHLEVEL <= 8 || (PATCHLEVEL == 8 && SUBVERSION < 1))
+#define PL_sv_placeholder PL_sv_undef
+#endif
+
 /*
  * Useful store shortcuts...
  */
@@ -2249,7 +2253,13 @@ static int store_hash(stcxt_t *cxt, HV *hv)
                             PUTMARK(flags);
                             TRACEME(("(#%d) key '%s' flags %x %u", i, keyval, flags, *keyval));
                         } else {
-                            assert (flags == 0);
+                            /* This is a workaround for a bug in 5.8.0
+                               that causes the HEK_WASUTF8 flag to be
+                               set on an HEK without the hash being
+                               marked as having key flags. We just
+                               cross our fingers and drop the flag.
+                               AMS 20030901 */
+                            assert (flags == 0 || flags == SHV_K_WASUTF8);
                             TRACEME(("(#%d) key '%s'", i, keyval));
                         }
 			WLEN(keylen);
@@ -2340,7 +2350,13 @@ static int store_hash(stcxt_t *cxt, HV *hv)
                             PUTMARK(flags);
                             TRACEME(("(#%d) key '%s' flags %x", i, key, flags));
                         } else {
-                            assert (flags == 0);
+                            /* This is a workaround for a bug in 5.8.0
+                               that causes the HEK_WASUTF8 flag to be
+                               set on an HEK without the hash being
+                               marked as having key flags. We just
+                               cross our fingers and drop the flag.
+                               AMS 20030901 */
+                            assert (flags == 0 || flags == SHV_K_WASUTF8);
                             TRACEME(("(#%d) key '%s'", i, key));
                         }
                         if (flags & SHV_K_ISSV) {
diff --git a/ext/Storable/t/freeze.t b/ext/Storable/t/freeze.t
index bf557df..d69e3b4 100644
--- a/ext/Storable/t/freeze.t
+++ b/ext/Storable/t/freeze.t
@@ -137,8 +137,15 @@ ok 18, !$@;
 thaw $frozen;			# used to segfault here
 ok 19, 1;
 
-$a = []; $#$a = 2; $a->[1] = undef;
-$b = thaw freeze $a;
-@a = map { ~~ exists $a->[$_] } 0 .. $#$a;
-@b = map { ~~ exists $b->[$_] } 0 .. $#$b;
-ok 20, "@a" eq "@b";
+if ($] >= 5.006) {
+    eval '
+        $a = []; $#$a = 2; $a->[1] = undef;
+        $b = thaw freeze $a;
+        @a = map { ~~ exists $a->[$_] } 0 .. $#$a;
+        @b = map { ~~ exists $b->[$_] } 0 .. $#$b;
+        ok 20, "@a" eq "@b";
+    ';
+}
+else {
+    print "ok 20 # skipped (no av_exists)\n";
+}
diff --git a/ext/Storable/t/malice.t b/ext/Storable/t/malice.t
index 0b667d9..955dcf1 100644
--- a/ext/Storable/t/malice.t
+++ b/ext/Storable/t/malice.t
@@ -51,7 +51,7 @@ use Test::More;
 # present in files, but not in things store()ed to memory
 $fancy = ($] > 5.007 ? 2 : 0);
 
-plan tests => 368 + length ($byteorder) * 4 + $fancy * 8;
+plan tests => 368 + length ($byteorder) * 4 + $fancy * 8 + 1;
 
 use Storable qw (store retrieve freeze thaw nstore nfreeze);
 
@@ -324,3 +324,15 @@ test_things($contents, \&store_and_retrieve, 'file', 1);
 # And now try almost everything again with a Storable string
 $stored = nfreeze \%hash;
 test_things($stored, \&freeze_and_thaw, 'string', 1);
+
+# Test that the bug fixed by #20587 doesn't affect us under some older
+# Perl. AMS 20030901
+{
+    chop(my $a = chr(0xDF).chr(256));
+    my %a = (chr(0xDF) => 1);
+    $a{$a}++;
+    freeze \%a;
+    # If we were built with -DDEBUGGING, the assert() should have killed
+    # us, which will probably alert the user that something went wrong.
+    ok(1);
+}
diff --git a/ext/Storable/t/utf8hash.t b/ext/Storable/t/utf8hash.t
index 05d9272..eeb80eb 100644
--- a/ext/Storable/t/utf8hash.t
+++ b/ext/Storable/t/utf8hash.t
@@ -8,8 +8,11 @@ sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
 	@INC = ('.', '../lib');
-	use vars qw($MacPerl::Architecture);
-	push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+        if ($^O eq 'MacOS') {
+            # Look, I'm using this fully-qualified variable more than once!
+            my $arch = $MacPerl::Architecture;
+            push @INC, "::lib:${MacPerl::Architecture}:";
+        }
     } else {
 	unshift @INC, 't';
     }