This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add qr/\p{Name=...}/
authorKarl Williamson <khw@cpan.org>
Wed, 5 Feb 2020 20:32:26 +0000 (13:32 -0700)
committerKarl Williamson <khw@cpan.org>
Wed, 12 Feb 2020 23:25:53 +0000 (16:25 -0700)
This accomplishes the same thing as \N{...}, but only for regex
patterns, using loose matching and only the official Unicode names.

This commit includes a comparison of the two approaches, added to
perlunicode.  But the real reason to do this is as a way station to
being able to specify wild card lookup on the name property, coming in a
later commit.

I chose to not include user-defined aliases nor :short character names
at this time.  I thought that there might be unforeseen consequences of
using them.  It's better to later relax a requirement than to try to
restrict it.

16 files changed:
charclass_invlists.h
lib/_charnames.pm
lib/charnames.pm
lib/charnames.t
lib/unicore/mktables
lib/unicore/uni_keywords.pl
pod/perldelta.pod
pod/perlre.pod
pod/perlretut.pod
pod/perlunicode.pod
pod/perlunicook.pod
pod/perluniintro.pod
regcharclass.h
regcomp.c
t/re/pat_advanced.t
uni_keywords.h

index 5f1efcc..3e3cb41 100644 (file)
@@ -419812,7 +419812,7 @@ static const U8 WB_table[24][24] = {
  * 0fea35394151afefbb4121b6380db1b480be6f9bafb4eba3382dc292dcf68526 lib/unicore/extracted/DLineBreak.txt
  * 6d4a8c945dd7db83ed617cbb7d937de7f4ecf016ff22970d846e996a7c9a2a5d lib/unicore/extracted/DNumType.txt
  * 5b7c14380d5cceeaffcfbc18db1ed936391d2af2d51f5a41f1a17b692c77e59b lib/unicore/extracted/DNumValues.txt
- * b546595bd9f4946e2997179652ff9a0d3ceef7833fbcc37524c1abf74363e73d lib/unicore/mktables
+ * a036e08a847a84068d32cfa018aa8514881cdd70eacb8ad1dab2c80d43ef667b lib/unicore/mktables
  * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version
  * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
  * 6bbad21de0848e0236b02f34f5fa0edd3cdae9ba8173cc9469a5513936b9e728 regen/mk_PL_charclass.pl
index c6169d1..600317b 100644 (file)
@@ -6,7 +6,7 @@
 package _charnames;
 use strict;
 use warnings;
-our $VERSION = '1.45';
+our $VERSION = '1.46';
 use unicore::Name;    # mktables-generated algorithmically-defined names
 
 use bytes ();          # for $bytes::hint_bits
@@ -263,8 +263,9 @@ my %dummy_H = (
               );
 
 
-sub lookup_name ($$$) {
-  my ($name, $wants_ord, $runtime) = @_;
+sub lookup_name ($$$;$) {
+  my ($name, $wants_ord, $runtime, $regex_loose) = @_;
+  $regex_loose //= 0;
 
   # Lookup the name or sequence $name in the tables.  If $wants_ord is false,
   # returns the string equivalent of $name; if true, returns the ordinal value
@@ -281,7 +282,7 @@ sub lookup_name ($$$) {
   my $result;       # The string result
   my $save_input;
 
-  if ($runtime) {
+  if ($runtime && ! $regex_loose) {
 
     my $hints_ref = (caller($runtime))[10];
 
@@ -307,16 +308,16 @@ sub lookup_name ($$$) {
     $^H{charnames_short} = $hints_ref->{charnames_short};
   }
 
-  my $loose = $^H{charnames_loose};
+  my $loose = $regex_loose || $^H{charnames_loose};
   my $lookup_name;  # Input name suitably modified for grepping for in the
                     # table
 
   # User alias should be checked first or else can't override ours, and if we
   # were to add any, could conflict with theirs.
-  if (exists $^H{charnames_ord_aliases}{$name}) {
+  if (! $regex_loose && exists $^H{charnames_ord_aliases}{$name}) {
     $result = $^H{charnames_ord_aliases}{$name};
   }
-  elsif (exists $^H{charnames_name_aliases}{$name}) {
+  elsif (! $regex_loose && exists $^H{charnames_name_aliases}{$name}) {
     $name = $^H{charnames_name_aliases}{$name};
     $save_input = $lookup_name = $name;  # Cache the result for any error
                                          # message
@@ -422,7 +423,7 @@ sub lookup_name ($$$) {
       # the other way around slows down finding these immensely.
       # Algorithmically determinables are not placed in the cache because
       # that uses up memory, and finding these again is fast.
-      if (($loose || $^H{charnames_full})
+      if (   ($loose || $^H{charnames_full})
           && (defined (my $ord = charnames::name_to_code_point_special($lookup_name, $loose))))
       {
         $result = chr $ord;
@@ -464,6 +465,10 @@ sub lookup_name ($$$) {
           @off = ($-[0] + 1, $+[0]);    # The 1 is for the tab
           $cache_ref = ($loose) ? \%loose_names_cache : \%full_names_cache;
         }
+        elsif ($regex_loose) {
+          # Currently don't allow :short when this is set
+          return;
+        }
         else {
 
           # Here, didn't look for, or didn't find the name.
@@ -572,9 +577,11 @@ sub lookup_name ($$$) {
 
     # Here, wants string output.  If utf8 is acceptable, just return what
     # we've got; otherwise attempt to convert it to non-utf8 and return that.
-    my $in_bytes = ($runtime)
-                   ? (caller $runtime)[8] & $bytes::hint_bits
-                   : $^H & $bytes::hint_bits;
+    my $in_bytes =     ! $regex_loose   # \p{name=} doesn't currently care if
+                                        # in bytes or not
+                   && (($runtime)
+                       ? (caller $runtime)[8] & $bytes::hint_bits
+                       : $^H & $bytes::hint_bits);
     return $result if (! $in_bytes || utf8::downgrade($result, 1)) # The 1 arg
                                                   # means don't die on failure
   }
@@ -617,6 +624,15 @@ sub charnames {
   return lookup_name($_[0], 0, 0);
 }
 
+sub _loose_regcomp_lookup {
+  # For use only by regcomp.c to compile \p{name=...}
+  # khw thinks it best to not do :short matching, and only official names.
+  # But that is only a guess, and if demand warrants, could be changed
+  return lookup_name($_[0], 0, 1,
+                     1  # Always use :loose matching
+                    );
+}
+
 sub import
 {
   shift; ## ignore class name
index e22c719..9f4a968 100644 (file)
@@ -1,7 +1,7 @@
 package charnames;
 use strict;
 use warnings;
-our $VERSION = '1.45';
+our $VERSION = '1.46';
 use unicore::Name;    # mktables-generated algorithmically-defined names
 use _charnames ();    # The submodule for this where most of the work gets done
 
index 31e9cdc..b5fe7ed 100644 (file)
@@ -137,6 +137,10 @@ sub test_vianame ($$$) {
         use charnames ":full";
         $all_pass &= is(charnames::string_vianame($name), chr($i), "Verify string_vianame(\"$name\") is chr(0x$hex)");
     }
+
+    # \p{name=} is always loose matching
+    $all_pass &= like(chr($i), qr/^\p{name=$loose_name}$/, "Verify /\p{name=$loose_name}/ matches chr(0x$hex)");
+
     return $all_pass;
 }
 
@@ -217,6 +221,9 @@ sub test_vianame ($$$) {
     cmp_ok($warning_count, '==', scalar @WARN, "Verify vianame doesn't warn on unknown names");
     ok (! defined charnames::string_vianame("MORE NONE SUCH"), "Verify string_vianame returns undef for an undefined name");
     cmp_ok($warning_count, '==', scalar @WARN, "Verify string_vianame doesn't warn on unknown names");
+    eval "qr/\\p{name=MORE NONE SUCH}/";
+    like($@, qr/Can't find Unicode property definition "name=MORE NONE SUCH"/,
+            '\p{name=} returns an appropriate error message on an undefined name');
 
     use bytes;
     is(charnames::vianame("GOTHIC LETTER AHSA"), 0x10330, "Verify vianame \\N{name} is unaffected by 'use bytes'");
@@ -229,6 +236,8 @@ sub test_vianame ($$$) {
     ok(! defined charnames::string_vianame("GOTHIC LETTER AHSA"), "Verify string_vianame(\"GOTHIC LETTER AHSA\") is undefined under 'use bytes'");
     ok($warning_count == scalar @WARN - 1 && $WARN[-1] =~ /above 0xFF/, "Verify string_vianame gives appropriate warning for previous test");
     $warning_count = @WARN;
+    eval "qr/\\p{name=GOTHIC LETTER AHSA}/";
+    is($@, "", '\p{name=...} is unaffect by "use bytes"');
     is(charnames::string_vianame("U+FF"), chr(utf8::unicode_to_native(0xFF)), "Verify string_vianame(\"U+FF\") is chr(0xFF) under 'use bytes'");
     cmp_ok($warning_count, '==', scalar @WARN, "Verify string_vianame doesn't warn on legal inputs under 'use bytes'");
     is(charnames::string_vianame("LATIN SMALL LETTER Y WITH DIAERESIS"), chr(utf8::unicode_to_native(0xFF)), "Verify string_vianame(\"LATIN SMALL LETTER Y WITH DIAERESIS\") is chr(native 0xFF) under 'use bytes'");
@@ -793,16 +802,28 @@ is("\N{U+1D0C5}", "\N{BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA VASIS}", 'V
     is("\N{mychar1}", "e", "Outer block: verify that \\N{mychar1} works");
     is(charnames::vianame("mychar1"), ord("e"), "Outer block: verify that vianame(mychar1) works");
     is(charnames::string_vianame("mychar1"), "e", "Outer block: verify that string_vianame(mychar1) works");
+    eval "qr/\\p{name=mychar1}/";
+    like($@, qr/Can't find Unicode property definition "name=mychar1"/,
+            '\p{name=} returns an appropriate error message on an alias');
     is("\N{mychar2}", "A", "Outer block: verify that \\N{mychar2} works");
     is(charnames::vianame("mychar2"), ord("A"), "Outer block: verify that vianame(mychar2) works");
     is(charnames::string_vianame("mychar2"), "A", "Outer block: verify that string_vianame(mychar2) works");
+    eval "qr/\\p{name=mychar2}/";
+    like($@, qr/Can't find Unicode property definition "name=mychar2"/,
+            '\p{name=} returns an appropriate error message on an alias');
     is("\N{myprivate1}", "\x{E8000}", "Outer block: verify that \\N{myprivate1} works");
     cmp_ok(charnames::vianame("myprivate1"), "==", 0xE8000, "Outer block: verify that vianame(myprivate1) works");
     is(charnames::string_vianame("myprivate1"), chr(0xE8000), "Outer block: verify that string_vianame(myprivate1) works");
+    eval "qr/\\p{name=myprivate1}/";
+    like($@, qr/Can't find Unicode property definition "name=myprivate1"/,
+            '\p{name=} returns an appropriate error message on an alias');
     is(charnames::viacode(0xE8000), "myprivate1", "Outer block: verify that myprivate1 viacode works");
     is("\N{myprivate2}", "\x{100000}", "Outer block: verify that \\N{myprivate2} works");
     cmp_ok(charnames::vianame("myprivate2"), "==", 0x100000, "Outer block: verify that vianame(myprivate2) works");
     is(charnames::string_vianame("myprivate2"), chr(0x100000), "Outer block: verify that string_vianame(myprivate2) works");
+    eval "qr/\\p{name=myprivate2}/";
+    like($@, qr/Can't find Unicode property definition "name=myprivate2"/,
+            '\p{name=} returns an appropriate error message on an alias');
     is(charnames::viacode(0x100000), "myprivate2", "Outer block: verify that myprivate2 viacode works");
     is("\N{BE}", "\N{KATAKANA LETTER BE}", "Outer block: verify that \\N uses the correct script ");
     cmp_ok(charnames::vianame("BE"), "==", ord("\N{KATAKANA LETTER BE}"), "Outer block: verify that vianame uses the correct script");
@@ -810,6 +831,9 @@ is("\N{U+1D0C5}", "\N{BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA VASIS}", 'V
     is("\N{Hiragana: BE}", $hiragana_be, "Outer block: verify that :short works with \\N");
     cmp_ok(charnames::vianame("Hiragana: BE"), "==", ord($hiragana_be), "Outer block: verify that :short works with vianame");
     cmp_ok(charnames::string_vianame("Hiragana: BE"), "==", $hiragana_be, "Outer block: verify that :short works with string_vianame");
+    eval "qr/\\p{name=Hiragana: BE}/";
+    like($@, qr/Can't find Unicode property definition "name=Hiragana: BE"/,
+            '\p{name=} returns an appropriate error message on :short attempt');
 
     {
         use charnames ":full",
@@ -967,7 +991,7 @@ is("\N{U+1D0C5}", "\N{BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA VASIS}", 'V
 
     # We will look at the data grouped in "blocks" of the following
     # size.
-    my $block_size_bits = 7;   # above 16 is not sensible
+    my $block_size_bits = 8;   # above 16 is not sensible
     my $block_size = 2**$block_size_bits;
 
     # There are the regular names, like "SPACE", plus the ones
@@ -976,7 +1000,7 @@ is("\N{U+1D0C5}", "\N{BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA VASIS}", 'V
     # of the character.  The percentage of each type to test is
     # fuzzily independently settable.  This breaks down when the block size is
     # 1 or is large enough that both types of names occur in the same block
-    my $percentage_of_regular_names = ($run_slow_tests) ? 100 : 13;
+    my $percentage_of_regular_names = ($run_slow_tests) ? 100 : 10;
     my $percentage_of_algorithmic_names = (100 / $block_size); # 1 test/block
 
     # If wants everything tested, do so by changing the block size to 1 so
@@ -1247,6 +1271,9 @@ is("\N{U+1D0C5}", "\N{BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA VASIS}", 'V
                         $all_pass &= ok(! defined charnames::vianame("CJK UNIFIED IDEOGRAPH-$hex"), "Verify vianame(\"CJK UNIFIED IDEOGRAPH-$hex\") is undefined");
                     } else {
                         $all_pass &= ok(! defined charnames::string_vianame("CJK UNIFIED IDEOGRAPH-$hex"), "Verify string_vianame(\"CJK UNIFIED IDEOGRAPH-$hex\") is undefined");
+                        eval "qr/\\p{name=CJK UNIFIED IDEOGRAPH-$hex}/";
+                        $all_pass &= like($@, qr/Can't find Unicode property definition "name=CJK UNIFIED IDEOGRAPH-$hex\"/,
+                                                "Verify string_vianame(\"CJK UNIFIED IDEOGRAPH-$hex\") is undefined");
                     }
                 }
             }
index 40ac545..4edd70d 100644 (file)
@@ -17163,6 +17163,13 @@ END
     push @match_properties, format_pod_line($indent_info_column,
                                             '\p{Is_*}',
                                             "\\p{*} $text");
+    push @match_properties, format_pod_line($indent_info_column,
+            '\p{Name=*}',
+            "Combination of Name and Name_Alias properties; has special"
+          . " loose matching rules, for which see Unicode UAX #44");
+    push @match_properties, format_pod_line($indent_info_column,
+                                            '\p{Na=*}',
+                                            '\p{Name=*}');
 
     # Sort the properties array for output.  It is sorted alphabetically
     # except numerically for numeric properties, and only output unique lines.
@@ -17670,11 +17677,11 @@ Also, Case_Folding is accessible through the C</i> modifier in regular
 expressions, the C<\\F> transliteration escape, and the C<L<fc|perlfunc/fc>>
 operator.
 
-And, the Name and Name_Aliases properties are accessible through the C<\\N{}>
-interpolation in double-quoted strings and regular expressions; and functions
-C<charnames::viacode()>, C<charnames::vianame()>, and
-C<charnames::string_vianame()> (which require a C<use charnames ();> to be
-specified.
+Besides being able to say C<\p{Name=...}>, the Name and Name_Aliases
+properties are accessible through the C<\\N{}> interpolation in double-quoted
+strings and regular expressions; and functions C<charnames::viacode()>,
+C<charnames::vianame()>, and C<charnames::string_vianame()> (which require a
+C<use charnames ();> to be specified.
 
 Finally, most properties related to decomposition are accessible via
 L<Unicode::Normalize>.
index 649cc07..f1bbd52 100644 (file)
 # 0fea35394151afefbb4121b6380db1b480be6f9bafb4eba3382dc292dcf68526 lib/unicore/extracted/DLineBreak.txt
 # 6d4a8c945dd7db83ed617cbb7d937de7f4ecf016ff22970d846e996a7c9a2a5d lib/unicore/extracted/DNumType.txt
 # 5b7c14380d5cceeaffcfbc18db1ed936391d2af2d51f5a41f1a17b692c77e59b lib/unicore/extracted/DNumValues.txt
-# b546595bd9f4946e2997179652ff9a0d3ceef7833fbcc37524c1abf74363e73d lib/unicore/mktables
+# a036e08a847a84068d32cfa018aa8514881cdd70eacb8ad1dab2c80d43ef667b lib/unicore/mktables
 # 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version
 # 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
 # 6bbad21de0848e0236b02f34f5fa0edd3cdae9ba8173cc9469a5513936b9e728 regen/mk_PL_charclass.pl
index 562473e..07c5c73 100644 (file)
@@ -47,6 +47,13 @@ that aren't part of the strict UCD (Unicode character database).  These
 two are used for examining inputs for security purposes.  Details on
 their usage is at L<https://www.unicode.org/reports/tr39/proposed.html>.
 
+=head2 It is now possible to write C<qr/\p{Name=...}/>, or C<\p{Na=...}>
+
+The Unicode Name property is now accessible in regular expression
+patterns using the above syntaxes, as an alternative to C<\N{...}>.
+A comparison of the two methods is given in
+L<perlunicode/Comparison of \N{...} and \p{name=...}>.
+
 =head1 Security
 
 XXX Any security-related notices go here.  In particular, any security
index 68e18c9..8c0d204 100644 (file)
@@ -465,7 +465,7 @@ Use of C</x> means that if you want real
 whitespace or C<"#"> characters in the pattern (outside a bracketed character
 class, which is unaffected by C</x>), then you'll either have to
 escape them (using backslashes or C<\Q...\E>) or encode them using octal,
-hex, or C<\N{}> escapes.
+hex, or C<\N{}> or C<\p{name=...}> escapes.
 It is ineffective to try to continue a comment onto the next line by
 escaping the C<\n> with a backslash or C<\Q>.
 
index 78050a1..72e23d0 100644 (file)
@@ -2005,6 +2005,17 @@ Consortium, L<https://www.unicode.org/charts/charindex.html>; explanatory
 material with links to other resources at
 L<https://www.unicode.org/standard/where>.
 
+Starting in Perl v5.32, an alternative to C<\N{...}> for full names is
+available, and that is to say
+
+ /\p{Name=greek small letter sigma}/
+
+The casing of the character name is irrelevant when used in C<\p{}>, as
+are most spaces, underscores and hyphens.  (A few outlier characters
+cause problems with ignoring all of them always.  The details (which you
+can look up when you get more proficient, and if ever needed) are in
+L<https://www.unicode.org/reports/tr44/tr44-24.html#UAX44-LM2>).
+
 The answer to requirement 2) is that a regexp (mostly)
 uses Unicode characters.  The "mostly" is for messy backward
 compatibility reasons, but starting in Perl 5.14, any regexp compiled in
index ed20878..5a7938d 100644 (file)
@@ -460,15 +460,20 @@ Upper/lower case differences in property names and values are irrelevant;
 thus C<\p{Upper}> means the same thing as C<\p{upper}> or even C<\p{UpPeR}>.
 Similarly, you can add or subtract underscores anywhere in the middle of a
 word, so that these are also equivalent to C<\p{U_p_p_e_r}>.  And white space
-is irrelevant adjacent to non-word characters, such as the braces and the equals
-or colon separators, so C<\p{   Upper  }> and C<\p{ Upper_case : Y }> are
-equivalent to these as well.  In fact, white space and even
-hyphens can usually be added or deleted anywhere.  So even C<\p{ Up-per case = Yes}> is
-equivalent.  All this is called "loose-matching" by Unicode.  The few places
-where stricter matching is used is in the middle of numbers, and in the Perl
-extension properties that begin or end with an underscore.  Stricter matching
-cares about white space (except adjacent to non-word characters),
-hyphens, and non-interior underscores.
+is generally irrelevant adjacent to non-word characters, such as the
+braces and the equals or colon separators, so C<\p{   Upper  }> and
+C<\p{ Upper_case : Y }> are equivalent to these as well.  In fact, white
+space and even hyphens can usually be added or deleted anywhere.  So
+even C<\p{ Up-per case = Yes}> is equivalent.  All this is called
+"loose-matching" by Unicode.  The "name" property has some restrictions
+on this due to a few outlier names.  Full details are given in
+L<https://www.unicode.org/reports/tr44/tr44-24.html#UAX44-LM2>.
+
+The few places where stricter matching is
+used is in the middle of numbers, the "name" property, and in the Perl
+extension properties that begin or end with an underscore.  Stricter
+matching cares about white space (except adjacent to non-word
+characters), hyphens, and non-interior underscores.
 
 You can also use negation in both C<\p{}> and C<\P{}> by introducing a caret
 (C<^>) between the first brace and the property name: C<\p{^Tamil}> is
@@ -922,6 +927,60 @@ L<perlrecharclass/POSIX Character Classes>.
 
 =back
 
+=head2 Comparison of C<\N{...}> and C<\p{name=...}>
+
+Starting in Perl 5.32, you can specify a character by its name in
+regular expression patterns using C<\p{name=...}>.  This is in addition
+to the longstanding method of using C<\N{...}>.  The following
+summarizes the differences between these two:
+
+                       \N{...}       \p{Name=...}
+ can interpolate    only with eval       yes            [1]
+ custom names            yes             no             [2]
+ name aliases            yes             yes            [3]
+ named sequences         yes           not yet          [4]
+ name value parsing     exact       Unicode loose       [5]
+
+=over
+
+=item [1]
+
+The ability to interpolate means you can do something like
+
+ qr/\p{na=latin capital letter $which}/
+
+and specify C<$which> elsewhere.
+
+=item [2]
+
+You can create your own names for characters, and override official
+ones when using C<\N{...}>.  See L<charnames/CUSTOM ALIASES>.
+
+=item [3]
+
+Some characters have multiple names (synonyms).
+
+=item [4]
+
+Some particular sequences of characters are given a single name, in
+addition to their individual ones.
+
+It is planned to add support for named sequences to the C<\p{...}> form
+before 5.32; in the meantime, an accurate but not fully informative
+message is generated if use of one of these is attempted.
+
+=item [5]
+
+Exact name value matching means you have to specify case, hyphens,
+underscores, and spaces precisely in the name you want.  Loose matching
+follows the Unicode rules
+L<https://www.unicode.org/reports/tr44/tr44-24.html#UAX44-LM2>,
+where these are mostly irrelevant.  Except for a few outlier character
+names, these are the same rules as are already used for any other
+C<\p{...}> property.
+
+=back
+
 =head2 Wildcards in Property Values
 
 Starting in Perl 5.30, it is possible to do do something like this:
index eb395f7..c709e0f 100644 (file)
@@ -152,6 +152,13 @@ that is, it disregards case, whitespace, and underscores:
 
  "\N{euro sign}"                        # :loose (from v5.16)
 
+Starting in v5.32, you can also use
+
+ qr/\p{name=euro sign}/
+
+to get official Unicode named characters in regular expressions.  Loose
+matching is always done for these.
+
 =head2 ℞ 9: Unicode named sequences
 
 These look just like character names but return multiple codepoints.
index fb799a4..14e8c51 100644 (file)
@@ -267,6 +267,11 @@ Similarly, they can be used in regular expression literals
  $smiley =~ /\N{WHITE SMILING FACE}/;
  $smiley =~ /\N{U+263a}/;
 
+or, starting in v5.32:
+
+ $smiley =~ /\p{Name=WHITE SMILING FACE}/;
+ $smiley =~ /\p{Name=whitesmilingface}/;
+
 At run-time you can use:
 
  use charnames ();
index 0afc307..e5f0745 100644 (file)
  * 0fea35394151afefbb4121b6380db1b480be6f9bafb4eba3382dc292dcf68526 lib/unicore/extracted/DLineBreak.txt
  * 6d4a8c945dd7db83ed617cbb7d937de7f4ecf016ff22970d846e996a7c9a2a5d lib/unicore/extracted/DNumType.txt
  * 5b7c14380d5cceeaffcfbc18db1ed936391d2af2d51f5a41f1a17b692c77e59b lib/unicore/extracted/DNumValues.txt
- * b546595bd9f4946e2997179652ff9a0d3ceef7833fbcc37524c1abf74363e73d lib/unicore/mktables
+ * a036e08a847a84068d32cfa018aa8514881cdd70eacb8ad1dab2c80d43ef667b lib/unicore/mktables
  * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version
  * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
  * f9a393e7add8c7c2728356473ce5b52246d51295b2da0c48fb6f0aa21799e2bb regen/regcharclass.pl
index 301a525..cd7484b 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -23204,8 +23204,8 @@ Perl_parse_uniprop_string(pTHX_
     char* lookup_name;          /* normalized name for lookup in our tables */
     unsigned lookup_len;        /* Its length */
     enum { Not_Strict = 0,      /* Some properties have stricter name */
-           Strict               /* normalization rules, which we decide */
-                                /* upon based on parsing */
+           Strict,              /* normalization rules, which we decide */
+           As_Is                /* upon based on parsing */
          } stricter = Not_Strict;
 
     /* nv= or numeric_value=, or possibly one of the cjk numeric properties
@@ -23536,6 +23536,93 @@ Perl_parse_uniprop_string(pTHX_
              * some constructs in their subpattern, like \A. */
         } /* End of is a wildcard subppattern */
 
+        /* \p{name=...} is handled specially.  Instead of using the normal
+         * mechanism involving charclass_invlists.h, it uses _charnames.pm
+         * which has the necessary (huge) data accessible to it, and which
+         * doesn't get loaded unless necessary.  The legal syntax for names is
+         * somewhat different than other properties due both to the vagaries of
+         * a few outlier official names, and the fact that only a few ASCII
+         * characters are permitted in them */
+        if (   memEQs(lookup_name, j - 1, "name")
+            || memEQs(lookup_name, j - 1, "na"))
+        {
+            dSP;
+            HV * table;
+            SV * character;
+            const char * error_msg;
+            CV* lookup_loose;
+            SV * character_name;
+            STRLEN character_len;
+            UV cp;
+
+            stricter = As_Is;
+
+            /* Since the RHS (after skipping initial space) is passed unchanged
+             * to charnames, and there are different criteria for what are
+             * legal characters in the name, just parse it here.  A character
+             * name must begin with an ASCII alphabetic */
+            if (! isALPHA(name[i])) {
+                goto failed;
+            }
+            lookup_name[j++] = name[i];
+
+            for (++i; i < name_len; i++) {
+                /* Official names can only be in the ASCII range, and only
+                 * certain characters */
+                if (! isASCII(name[i]) || ! isCHARNAME_CONT(name[i])) {
+                    goto failed;
+                }
+                lookup_name[j++] = name[i];
+            }
+
+            /* Finished parsing, save the name into an SV */
+            character_name = newSVpvn(lookup_name + equals_pos, j - equals_pos);
+
+            /* Make sure _charnames is loaded.  (The parameters give context
+             * for any errors generated */
+            table = load_charnames(character_name, name, name_len, &error_msg);
+            if (table == NULL) {
+                sv_catpv(msg, error_msg);
+                goto append_name_to_msg;
+            }
+
+            lookup_loose = get_cv("_charnames::_loose_regcomp_lookup", 0);
+            if (! lookup_loose) {
+                Perl_croak(aTHX_
+                       "panic: Can't find '_charnames::_loose_regcomp_lookup");
+            }
+
+            PUSHSTACKi(PERLSI_OVERLOAD);
+            ENTER ;
+            SAVETMPS;
+
+            PUSHMARK(SP) ;
+            XPUSHs(character_name);
+            PUTBACK;
+            call_sv(MUTABLE_SV(lookup_loose), G_SCALAR);
+
+            SPAGAIN ;
+
+            character = POPs;
+            SvREFCNT_inc_simple_void_NN(character);
+
+            PUTBACK ;
+            FREETMPS ;
+            LEAVE ;
+            POPSTACK;
+
+            if (! SvOK(character)) {
+                goto failed;
+            }
+
+            cp = valid_utf8_to_uvchr((U8 *) SvPVX(character), &character_len);
+            if (character_len < SvCUR(character)) {
+                goto failed;
+            }
+
+            prop_definition = add_cp_to_invlist(NULL, cp);
+            return prop_definition;
+        }
 
         /* Certain properties whose values are numeric need special handling.
          * They may optionally be prefixed by 'is'.  Ignore that prefix for the
index 8f26549..b913796 100644 (file)
@@ -934,6 +934,9 @@ sub run_tests {
         my $name = "foo\xDF";
         my $result = eval "'A${name}B'  =~ /^A\\N{$name}B\$/";
         ok !$@ && $result,  "Passthrough charname of non-ASCII, Latin1";
+        eval "qr/\\p{name=foo}/";
+        like($@, qr/Can't find Unicode property definition "name=foo"/,
+                '\p{name=} doesn\'t see a cumstom charnames translator');
         #
         # Why doesn't must_warn work here?
         #
index 48295be..a36d1bf 100644 (file)
@@ -7540,7 +7540,7 @@ MPH_VALt match_uniprop( const unsigned char * const key, const U16 key_len ) {
  * 0fea35394151afefbb4121b6380db1b480be6f9bafb4eba3382dc292dcf68526 lib/unicore/extracted/DLineBreak.txt
  * 6d4a8c945dd7db83ed617cbb7d937de7f4ecf016ff22970d846e996a7c9a2a5d lib/unicore/extracted/DNumType.txt
  * 5b7c14380d5cceeaffcfbc18db1ed936391d2af2d51f5a41f1a17b692c77e59b lib/unicore/extracted/DNumValues.txt
- * b546595bd9f4946e2997179652ff9a0d3ceef7833fbcc37524c1abf74363e73d lib/unicore/mktables
+ * a036e08a847a84068d32cfa018aa8514881cdd70eacb8ad1dab2c80d43ef667b lib/unicore/mktables
  * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version
  * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
  * 6bbad21de0848e0236b02f34f5fa0edd3cdae9ba8173cc9469a5513936b9e728 regen/mk_PL_charclass.pl