A bug reported in perl-unicode by Terry Jones, fixed

by Andreas Koenig, and add a test.

p4raw-id: //depot/perl@20232

diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm
index 51d37b5..a723869 100644 (file)
--- a/lib/Unicode/UCD.pm
+++ b/lib/Unicode/UCD.pm
@@ -5,6 +5,8 @@ use warnings;
 
 our $VERSION = '0.2';
 
+use Storable qw(dclone);
+
 require Exporter;
 
 our @ISA = qw(Exporter);
@@ -320,7 +322,7 @@ sub charblock {
        _search(\@BLOCKS, 0, $#BLOCKS, $code);
     } else {
        if (exists $BLOCKS{$arg}) {
-           return $BLOCKS{$arg};
+           return dclone $BLOCKS{$arg};
        } else {
            return;
        }
@@ -385,7 +387,7 @@ sub charscript {
        _search(\@SCRIPTS, 0, $#SCRIPTS, $code);
     } else {
        if (exists $SCRIPTS{$arg}) {
-           return $SCRIPTS{$arg};
+           return dclone $SCRIPTS{$arg};
        } else {
            return;
        }
@@ -407,7 +409,7 @@ See also L</Blocks versus Scripts>.
 
 sub charblocks {
     _charblocks() unless %BLOCKS;
-    return \%BLOCKS;
+    return dclone \%BLOCKS;
 }
 
 =head2 charscripts
@@ -425,7 +427,7 @@ See also L</Blocks versus Scripts>.
 
 sub charscripts {
     _charscripts() unless %SCRIPTS;
-    return \%SCRIPTS;
+    return dclone \%SCRIPTS;
 }
 
 =head2 Blocks versus Scripts
@@ -709,7 +711,7 @@ sub casespec {
 
     _casespec() unless %CASESPEC;
 
-    return $CASESPEC{$code};
+    return ref $CASESPEC{$code} ? dclone $CASESPEC{$code} : $CASESPEC{$code};
 }
 
 =head2 Unicode::UCD::UnicodeVersion

diff --git a/lib/Unicode/UCD.t b/lib/Unicode/UCD.t
index 4d952df..c134935 100644 (file)
--- a/lib/Unicode/UCD.t
+++ b/lib/Unicode/UCD.t
@@ -12,7 +12,7 @@ use strict;
 use Unicode::UCD;
 use Test::More;
 
-BEGIN { plan tests => 176 };
+BEGIN { plan tests => 178 };
 
 use Unicode::UCD 'charinfo';
 
@@ -299,3 +299,13 @@ is(Unicode::UCD::_getcode('123x'),    undef, "_getcode(123x)");
 is(Unicode::UCD::_getcode('x123'),    undef, "_getcode(x123)");
 is(Unicode::UCD::_getcode('0x123x'),  undef, "_getcode(x123)");
 is(Unicode::UCD::_getcode('U+123x'),  undef, "_getcode(x123)");
+
+{
+    my $r1 = charscript('Latin');
+    my $n1 = @$r1;
+    is($n1, 26, "26 ranges in Latin script (Unicode 4.0.0)");
+    shift @$r1 while @$r1;
+    my $r2 = charscript('Latin');
+    is(@$r2, $n1, "modifying results should not mess up internal caches");
+}
+