From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sun, 27 Jul 2003 17:34:23 +0000 (+0000)
Subject: A bug reported in perl-unicode by Terry Jones, fixed
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=741297c143a9798e7fc90a397d29caf47224b950;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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");
+}
+