From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Fri, 20 Sep 2002 17:22:45 +0000 (+0300)
Subject: perl #17453
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2d92f8a00cb1e1f5a01e5a2057563ce78851c792;p=p5sagit%2Fp5-mst-13.2.git

perl #17453
   Message-ID: <20020920142245.GG280265@lyta.hut.fi>

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

diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index 1839d21..50b2d6d 100644
--- a/lib/utf8_heavy.pl
+++ b/lib/utf8_heavy.pl
@@ -28,7 +28,7 @@ sub SWASHNEW {
     ## ranges.
     ##
     ## To make the parsing of $type clear, this code takes the a rather
-    ## unorthadox approach of last'ing out of the block once we have the
+    ## unorthodox approach of last'ing out of the block once we have the
     ## info we need. Were this to be a subroutine, the 'last' would just
     ## be a 'return'.
     ##
@@ -50,7 +50,9 @@ sub SWASHNEW {
             ##
             ## 'Block=' is replaced by 'In'.
             ##
-            $type =~ s/^Is(?:\s+|[-_])?//i
+            my $wasIs;
+
+            ($wasIs = $type =~ s/^Is(?:\s+|[-_])?//i)
               or
             $type =~ s/^Category\s*=\s*//i
               or
@@ -85,20 +87,17 @@ sub SWASHNEW {
 	    ## It could be a user-defined property.
 	    ##
 
-	    if ($type =~ /^I[ns](\w+)$/) {
-                my @caller = caller(1);
-
-                if (defined $caller[0]) {
-                    my $prop = $caller[0] . "::" . $type;
-
-                    if (exists &{$prop}) {
-                        no strict 'refs';
+	    my $caller = caller(1);
 
-                        $list = &{$prop};
-                        last GETFILE;
-                    }
-                }
-            }
+	    if (defined $caller && $type =~ /^(?:\w+)$/) {
+		my $prop = $caller . "::" . ( $wasIs ? "Is" : "" ) . $type;
+		if (exists &{$prop}) {
+		    no strict 'refs';
+		    
+		    $list = &{$prop};
+		    last GETFILE;
+		}
+	    }
 
             ##
             ## Last attempt -- see if it's a "To" name (e.g. "ToLower")
diff --git a/t/op/pat.t b/t/op/pat.t
index ed02ae3..ed61015 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..928\n";
+print "1..932\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -2929,4 +2929,26 @@ print(("a$x" =~ qr/a(??{$a})/ ? '' : 'not '),
       "ok $test - postponed interpolation of qr// preserves utf8 # TODO\n");
 ++$test;
 
-# last test 928
+print "# more user-defined character properties\n";
+
+sub IsSyriac1 {
+    return <<'END';
+0712	072C
+0730	074A
+END
+}
+
+print "\x{0712}" =~ /\p{IsSyriac1}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+print "\x{072F}" =~ /\P{IsSyriac1}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+
+sub Syriac1 {
+    return <<'END';
+0712	072C
+0730	074A
+END
+}
+
+print "\x{0712}" =~ /\p{Syriac1}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+print "\x{072F}" =~ /\P{Syriac1}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+
+# last test 932