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 (file)
--- 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 (executable)
--- 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