summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorKarl Williamson <khw@cpan.org>2014-04-23 20:33:12 -0600
committerKarl Williamson <khw@cpan.org>2014-05-30 10:00:51 -0600
commit36897d6498ecb95fe6bf65c28b19473476e54b34 (patch)
treeaedafc700ef037b44a3042cdefb7bcbfcc9bc75d /lib
parentcd209d9d0a3b8eec779c744b3a98c9101e3f1a21 (diff)
downloadperl-36897d6498ecb95fe6bf65c28b19473476e54b34.tar.gz
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.
Diffstat (limited to 'lib')
-rw-r--r--lib/_charnames.pm31
-rw-r--r--lib/charnames.pm2
2 files changed, 16 insertions, 17 deletions
diff --git a/lib/_charnames.pm b/lib/_charnames.pm
index 8955b6fa87..4806b8fccf 100644
--- 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 97cafed73e..d33b7877d2 100644
--- 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