Provide the \N{U+HHHH} syntax before we forget.

p4raw-id: //depot/perl@16302

3 files changed, 25 insertions, 6 deletions

diff --git a/lib/charnames.pm b/lib/charnames.pm
index 3f69662e3a..d9cf7fa4e9 100644
--- a/lib/charnames.pm
+++ b/lib/charnames.pm
@@ -229,6 +229,8 @@ sub vianame
 
     my $arg = shift;
 
+    return chr hex $1 if $arg =~ /^U\+([0-9a-fA-F]+)$/;
+
     return $vianame{$arg} if exists $vianame{$arg};
 
     $txt = do "unicore/Name.pl" unless $txt;
@@ -291,11 +293,14 @@ use variables inside the C<\N{...}>.  If you want similar run-time
 functionality, use charnames::vianame().
 
 For the C0 and C1 control characters (U+0000..U+001F, U+0080..U+009F)
-as of Unicode 3.1, there are no official Unicode names but you can
-use instead the ISO 6429 names (LINE FEED, ESCAPE, and so forth).
-In Unicode 3.2 some naming changes will happen since ISO 6429 has been
-updated.  Also note that the U+UU80, U+0081, U+0084, and U+0099
-do not have names even in ISO 6429.
+as of Unicode 3.1, there are no official Unicode names but you can use
+instead the ISO 6429 names (LINE FEED, ESCAPE, and so forth).  In
+Unicode 3.2 (as of Perl 5.8) some naming changes take place ISO 6429
+has been updated, see L</ALIASES>.  Also note that the U+UU80, U+0081,
+U+0084, and U+0099 do not have names even in ISO 6429.
+
+Since the Unicode standard uses "U+HHHH", so can you: "\N{U+263a}"
+is the Unicode smiley face, or "\N{WHITE SMILING FACE}".
 
 =head1 CUSTOM TRANSLATORS
 
diff --git a/lib/charnames.t b/lib/charnames.t
index 3c92d04248..669f6e813d 100644
--- a/lib/charnames.t
+++ b/lib/charnames.t
@@ -12,7 +12,7 @@ BEGIN {
 
 $| = 1;
 
-print "1..41\n";
+print "1..42\n";
 
 use charnames ':full';
 
@@ -232,3 +232,7 @@ print "ok 40\n";
 
 print "not " unless ord("\N{ZWJ}") == 0x200D;
 print "ok 41\n";
+
+print "not " unless "\N{U+263A}" eq "\N{WHITE SMILING FACE}";
+print "ok 42\n";
+
diff --git a/toke.c b/toke.c
index 7d37b39bf4..5635e2cb43 100644
--- a/toke.c
+++ b/toke.c
@@ -1540,6 +1540,16 @@ S_scan_const(pTHX_ char *start)
 			e = s - 1;
 			goto cont_scan;
 		    }
+		    if (e > s + 2 && s[1] == 'U' && s[2] == '+') {
+		        /* \N{U+...} */
+		        I32 flags = PERL_SCAN_ALLOW_UNDERSCORES |
+			  PERL_SCAN_DISALLOW_PREFIX;
+		        s += 3;
+			len = e - s;
+			uv = grok_hex(s, &len, &flags, NULL);
+			s = e + 1;
+			goto NUM_ESCAPE_INSERT;
+		    }
 		    res = newSVpvn(s + 1, e - s - 1);
 		    res = new_constant( Nullch, 0, "charnames",
 					res, Nullsv, "\\N{...}" );