fix for charnames above FFFF

Message-ID: <m366i44ll2.fsf@ak-71.mind.de>

p4raw-id: //depot/perl@8873

2 files changed, 15 insertions, 3 deletions

diff --git a/lib/charnames.pm b/lib/charnames.pm
index 934fafddd5..0d663082c7 100644
--- a/lib/charnames.pm
+++ b/lib/charnames.pm
@@ -33,8 +33,10 @@ sub charnames {
     }
   }
   die "Unknown charname '$name'" unless @off;
-  
-  my $ord = hex substr $txt, $off[0] - 4, 4;
+
+  my $hexlen = 0;
+  $hexlen++ while substr($txt, $off[0] - $hexlen - 1, 1) =~ /[0-9a-f]/;
+  my $ord = hex substr $txt, $off[0] - $hexlen, $hexlen;
   if ($^H & $bytes::hint_bits) {	# "use bytes" in effect?
     use bytes;
     return chr $ord if $ord <= 255;
diff --git a/t/lib/charnames.t b/t/lib/charnames.t
index 388f533f13..6a8a8be32d 100644
--- a/t/lib/charnames.t
+++ b/t/lib/charnames.t
@@ -8,7 +8,7 @@ BEGIN {
 }
 
 $| = 1;
-print "1..14\n";
+print "1..15\n";
 
 use charnames ':full';
 
@@ -42,6 +42,7 @@ EOE
 $encoded_be = "\320\261";
 $encoded_alpha = "\316\261";
 $encoded_bet = "\327\221";
+$encoded_deseng = "\360\220\221\215";
 
 sub to_bytes {
     pack"a*", shift;
@@ -96,3 +97,12 @@ sub to_bytes {
    print "ok 14\n";
 }
 
+{
+  use charnames ':full';
+
+  print "not "
+      unless to_bytes("\N{DESERET SMALL LETTER ENG}") eq $encoded_deseng;
+  print "ok 15\n";
+
+}
+