[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 (file)
--- 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 (file)
--- 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 (file)
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.");