charnames: Eliminate need to sync code in two places

This refactors the code so that it doesn't have to be kept in sync
with other code.

diff --git a/lib/_charnames.pm b/lib/_charnames.pm
index 8955b6f..4806b8f 100644 (file)
--- a/lib/_charnames.pm
+++ b/lib/_charnames.pm
@@ -7,7 +7,7 @@ package _charnames;
 use strict;
 use warnings;
 use File::Spec;
-our $VERSION = '1.39';
+our $VERSION = '1.41';
 use unicore::Name;    # mktables-generated algorithmically-defined names
 
 use bytes ();          # for $bytes::hint_bits
@@ -169,14 +169,20 @@ sub alias (@) # Set up a single alias
         $^H{charnames_inverse_ords}{sprintf("%05X", $value)} = $name;
     }
     else {
-        # This regex needs to be sync'd with the code in toke.c that checks
-        # for the same thing
-        if ($name !~ / ^
-                       \p{_Perl_Charname_Begin}
-                       \p{_Perl_Charname_Continue}*
-                       $ /x) {
-
-          push @errors, $name;
+        my $ok_portion = "";
+        $ok_portion = $1 if $name =~ / ^ (
+                                            \p{_Perl_Charname_Begin}
+                                            \p{_Perl_Charname_Continue}*
+                                         ) /x;
+
+        # If the name was fully correct, the above should have matched all of
+        # it.
+        if (length $ok_portion < length $name) {
+          my $first_bad = substr($name, length($ok_portion), 1);
+          push @errors, "Invalid character in charnames alias definition; "
+                        . "marked by <-- HERE in '$ok_portion$first_bad<-- HERE "
+                        . substr($name, length($ok_portion) + 1)
+                        . "'";
         }
         else {
           $^H{charnames_name_aliases}{$name} = $value;
@@ -199,13 +205,6 @@ sub alias (@) # Set up a single alias
   # We find and output all errors from this :alias definition, rather than
   # failing on the first one, so fewer runs are needed to get it to compile
   if (@errors) {
-    foreach my $name (@errors) {
-      my $ok = "";
-      my $nbsp = chr utf8::unicode_to_native(0xa0);
-      $ok = $1 if $name =~ / ^ ( \p{Alpha} [-\p{XPosixWord} ():$nbsp]* ) /x;
-      my $first_bad = substr($name, length($ok), 1);
-      $name = "Invalid character in charnames alias definition; marked by <-- HERE in '$ok$first_bad<-- HERE " . substr($name, length($ok) + 1) . "'";
-    }
     croak join "\n", @errors;
   }
 

diff --git a/lib/charnames.pm b/lib/charnames.pm
index 97cafed..d33b787 100644 (file)
--- a/lib/charnames.pm
+++ b/lib/charnames.pm
@@ -1,7 +1,7 @@
 package charnames;
 use strict;
 use warnings;
-our $VERSION = '1.40';
+our $VERSION = '1.41';
 use unicore::Name;    # mktables-generated algorithmically-defined names
 use _charnames ();    # The submodule for this where most of the work gets done
 

diff --git a/toke.c b/toke.c
index 2d4064f..c1a3bd9 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2865,8 +2865,9 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
      * look to see that the first character is legal.  Then loop through the
      * rest checking that each is a continuation */
 
-    /* This code needs to be sync'ed with a regex in _charnames.pm which does
-     * the same thing */
+    /* This code makes the reasonable assumption that the only Latin1-range
+     * characters that begin a character name alias are alphabetic, otherwise
+     * would have to create a isCHARNAME_BEGIN macro */
 
     if (! UTF) {
         if (! isALPHAU(*s)) {