From: Jonathan Steinert <unknown>
Date: Tue, 1 May 2007 05:18:52 +0000 (-0700)
Subject: [perl #42839] Swatch hash cache has key mismatch
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c49d5ed730376407060cbf826eab2369ab99bf61;p=p5sagit%2Fp5-mst-13.2.git

[perl #42839] Swatch hash cache has key mismatch
From: Jonathan Steinert (via RT) <perlbug-followup@perl.org>
Message-ID: <rt-3.6.HEAD-30557-1178021932-1416.42839-75-0@perl.org>

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

diff --git a/MANIFEST b/MANIFEST
index 729098a..3bbc319 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3849,6 +3849,7 @@ t/run/switchx.t			Test the -x switch
 t/TEST				The regression tester
 t/TestInit.pm			Preamble library for core tests
 t/test.pl			Simple testing library
+t/uni/cache.t			See if Unicode swash caching works
 t/uni/case.pl			See if Unicode casing works
 t/uni/chomp.t			See if Unicode chomp works
 t/uni/chr.t			See if Unicode chr works
diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index 8a2ba71..c7bf527 100644
--- a/lib/utf8_heavy.pl
+++ b/lib/utf8_heavy.pl
@@ -187,11 +187,12 @@ sub SWASHNEW {
 	    ## (exception: user-defined properties and mappings), so we
 	    ## have a filename, so now we load it if we haven't already.
 	    ## If we have, return the cached results. The cache key is the
-	    ## file to load.
+	    ## class and file to load.
 	    ##
-	    if ($Cache{$file} and ref($Cache{$file}) eq $class) {
+	    my $found = $Cache{$class, $file};
+	    if ($found and ref($found) eq $class) {
 		print STDERR "Returning cached '$file' for \\p{$type}\n" if DEBUG;
-		return $Cache{$class, $file};
+		return $found;
 	    }
 
 	    $list = do $file; die $@ if $@;
diff --git a/t/uni/cache.t b/t/uni/cache.t
new file mode 100644
index 0000000..c3f7634
--- /dev/null
+++ b/t/uni/cache.t
@@ -0,0 +1,21 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(../lib .);
+    require "test.pl";
+}
+
+plan tests => 1;
+
+my $count = 0;
+unshift @INC, sub {
+       $count++ if $_[1] eq 'unicore/lib/gc_sc/Hira.pl';
+};
+
+my $s = 'foo';
+
+$s =~ m/[\p{Hiragana}]/;
+$s =~ m/[\p{Hiragana}]/;
+$s =~ m/[\p{Hiragana}]/;
+$s =~ m/[\p{Hiragana}]/;
+
+is($count, 1, "Swatch hash caching kept us from reloading swatch hash.");