This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Clean up viacode, accept large aliases
authorKarl Williamson <khw@khw-desktop.(none)>
Thu, 1 Jul 2010 22:22:14 +0000 (16:22 -0600)
committerJesse Vincent <jesse@bestpractical.com>
Sun, 4 Jul 2010 20:43:44 +0000 (21:43 +0100)
This changes viacode to accept aliases that the user has defined beyond
the Unicode range.

lib/charnames.pm
lib/charnames.t

index ba580f8..0b1b99d 100644 (file)
@@ -683,24 +683,29 @@ sub viacode {
     return;
   }
 
-  # checking the length first is slightly faster
-  if (length($hex) > 5 && CORE::hex($hex) > 0x10FFFF) {
-    carp "Unicode characters only allocated up to U+10FFFF (you asked for U+$hex)";
-    return;
-  }
-
   return $viacode{$hex} if exists $viacode{$hex};
 
-  $txt = do "unicore/Name.pl" unless $txt;
+  # If the code point is above the max in the table, there's no point
+  # looking through it.  Checking the length first is slightly faster
+  if (length($hex) <= 5 || CORE::hex($hex) <= 0x10FFFF) {
+    $txt = do "unicore/Name.pl" unless $txt;
 
-  # Return the official name, if exists
-  if ($txt =~ m/^$hex\t\t(.+)/m) {
-    $viacode{$hex} = $1;
-    return $1;
+    # Return the official name, if exists.  It's unclear to me (khw) at
+    # this juncture if it is better to return a user-defined override, so
+    # leaving it as is for now.
+    if ($txt =~ m/^$hex\t\t(.+)/m) {
+        $viacode{$hex} = $1;
+        return $1;
+    }
   }
 
   # See if there is a user name for it, before giving up completely.
-  return if ! exists $inverse_user_aliases{$hex};
+  if (! exists $inverse_user_aliases{$hex}) {
+    if (CORE::hex($hex) > 0x10FFFF) {
+        carp "Unicode characters only allocated up to U+10FFFF (you asked for U+$hex)";
+    }
+    return;
+  }
 
   $viacode{$hex} = $inverse_user_aliases{$hex};
   return $inverse_user_aliases{$hex};
index 38a3c61..fa132e8 100644 (file)
@@ -65,6 +65,7 @@ EOE
     is ("\N{mychar3}", chr(0x100000), "Verify that can define U+... alias");
     is (charnames::viacode(0x100000), "mychar3", "And that can get the alias back");
     is ("\N{mylarge}", chr(0x111000), "Verify that can define alias beyond Unicode");
+    is (charnames::viacode(0x111000), "mylarge", "And that can get the alias back");
     is (charnames::viacode(0x80), "myctrl", "Verify that can name a nameless control");
 
 }