Change 18053 by merijn@merijn-l1 on 2002/10/24 08:20:09 charnames pragma extended with :alias for customized unicode naming aliases Mon, 21 Oct 2002; "H.Merijn Brand" <[EMAIL PROTECTED]>
Affected files ... .... //depot/perl/lib/charnames.pm#36 edit .... //depot/perl/lib/charnames.t#21 edit Differences ... ==== //depot/perl/lib/charnames.pm#36 (text) ==== Index: perl/lib/charnames.pm --- perl/lib/charnames.pm#35~16891~ Thu May 30 07:07:30 2002 +++ perl/lib/charnames.pm Thu Oct 24 01:20:09 2002 @@ -2,7 +2,7 @@ use strict; use warnings; use Carp; -our $VERSION = '1.01'; +our $VERSION = '1.02'; use bytes (); # for $bytes::hint_bits $charnames::hint_bits = 0x20000; @@ -38,20 +38,44 @@ 'PARTIAL LINE UP' => 'PARTIAL LINE BACKWARD', ); +my %alias3 = ( + # User defined aliasses. Even more convenient :) + ); my $txt; +sub alias (@) +{ + @_ or return %alias3; + my $alias = ref $_[0] ? $_[0] : { @_ }; + @alias3{keys %$alias} = values %$alias; +} # alias + +sub alias_file ($) +{ + my $arg = shift; + my $file = -f $arg ? $arg : "unicore/${arg}_alias.pl"; + if (my @alias = do $file) { + alias (@alias); + return (1); + } + 0; +} # alias_file + # This is not optimized in any way yet sub charnames { my $name = shift; if (exists $alias1{$name}) { - $name = $alias1{$name}; + $name = $alias1{$name}; } - if (exists $alias2{$name}) { - require warnings; - warnings::warnif('deprecated', qq{Unicode character name "$name" is deprecated, use "$alias2{$name}" instead}); - $name = $alias2{$name}; + elsif (exists $alias2{$name}) { + require warnings; + warnings::warnif('deprecated', qq{Unicode character name "$name" is deprecated, +use "$alias2{$name}" instead}); + $name = $alias2{$name}; + } + elsif (exists $alias3{$name}) { + $name = $alias3{$name}; } my $ord; @@ -59,72 +83,70 @@ my $fname; if ($name eq "BYTE ORDER MARK") { - $fname = $name; - $ord = 0xFEFF; + $fname = $name; + $ord = 0xFEFF; } else { - ## Suck in the code/name list as a big string. - ## Lines look like: - ## "0052\t\tLATIN CAPITAL LETTER R\n" - $txt = do "unicore/Name.pl" unless $txt; - - ## @off will hold the index into the code/name string of the start and - ## end of the name as we find it. - - ## If :full, look for the the name exactly - if ($^H{charnames_full} and $txt =~ /\t\t\Q$name\E$/m) { + ## Suck in the code/name list as a big string. + ## Lines look like: + ## "0052\t\tLATIN CAPITAL LETTER R\n" + $txt = do "unicore/Name.pl" unless $txt; + + ## @off will hold the index into the code/name string of the start and + ## end of the name as we find it. + + ## If :full, look for the the name exactly + if ($^H{charnames_full} and $txt =~ /\t\t\Q$name\E$/m) { + @off = ($-[0], $+[0]); + } + + ## If we didn't get above, and :short allowed, look for the short name. + ## The short name is like "greek:Sigma" + unless (@off) { + if ($^H{charnames_short} and $name =~ /^(.+?):(.+)/s) { + my ($script, $cname) = ($1, $2); + my $case = $cname =~ /[[:upper:]]/ ? "CAPITAL" : "SMALL"; + if ($txt =~ m/\t\t\U$script\E (?:$case )?LETTER \U\Q$cname\E$/m) { @off = ($-[0], $+[0]); + } } + } - ## If we didn't get above, and :short allowed, look for the short name. - ## The short name is like "greek:Sigma" - unless (@off) { - if ($^H{charnames_short} and $name =~ /^(.+?):(.+)/s) { - my ($script, $cname) = ($1,$2); - my $case = ( $cname =~ /[[:upper:]]/ ? "CAPITAL" : "SMALL"); - if ($txt =~ m/\t\t\U$script\E (?:$case )?LETTER \U\Q$cname\E$/m) { - @off = ($-[0], $+[0]); - } - } - } - - ## If we still don't have it, check for the name among the loaded - ## scripts. - if (not @off) - { - my $case = ( $name =~ /[[:upper:]]/ ? "CAPITAL" : "SMALL"); - for my $script ( @{$^H{charnames_scripts}} ) - { - if ($txt =~ m/\t\t$script (?:$case )?LETTER \U\Q$name\E$/m) { - @off = ($-[0], $+[0]); - last; - } - } - } - - ## If we don't have it by now, give up. - unless (@off) { - carp "Unknown charname '$name'"; - return "\x{FFFD}"; + ## If we still don't have it, check for the name among the loaded + ## scripts. + if (not @off) { + my $case = $name =~ /[[:upper:]]/ ? "CAPITAL" : "SMALL"; + for my $script (@{$^H{charnames_scripts}}) { + if ($txt =~ m/\t\t$script (?:$case )?LETTER \U\Q$name\E$/m) { + @off = ($-[0], $+[0]); + last; + } } - - ## - ## Now know where in the string the name starts. - ## The code, in hex, is before that. - ## - ## The code can be 4-6 characters long, so we've got to sort of - ## go look for it, just after the newline that comes before $off[0]. - ## - ## This would be much easier if unicore/Name.pl had info in - ## a name/code order, instead of code/name order. - ## - ## The +1 after the rindex() is to skip past the newline we're finding, - ## or, if the rindex() fails, to put us to an offset of zero. - ## - my $hexstart = rindex($txt, "\n", $off[0]) + 1; - - ## we know where it starts, so turn into number - - ## the ordinal for the char. - $ord = hex substr($txt, $hexstart, $off[0] - $hexstart); + } + + ## If we don't have it by now, give up. + unless (@off) { + carp "Unknown charname '$name'"; + return "\x{FFFD}"; + } + + ## + ## Now know where in the string the name starts. + ## The code, in hex, is before that. + ## + ## The code can be 4-6 characters long, so we've got to sort of + ## go look for it, just after the newline that comes before $off[0]. + ## + ## This would be much easier if unicore/Name.pl had info in + ## a name/code order, instead of code/name order. + ## + ## The +1 after the rindex() is to skip past the newline we're finding, + ## or, if the rindex() fails, to put us to an offset of zero. + ## + my $hexstart = rindex($txt, "\n", $off[0]) + 1; + + ## we know where it starts, so turn into number - + ## the ordinal for the char. + $ord = hex substr($txt, $hexstart, $off[0] - $hexstart); } if ($^H & $bytes::hint_bits) { # "use bytes" in effect? @@ -132,22 +154,21 @@ return chr $ord if $ord <= 255; my $hex = sprintf "%04x", $ord; if (not defined $fname) { - $fname = substr $txt, $off[0] + 2, $off[1] - $off[0] - 2; + $fname = substr $txt, $off[0] + 2, $off[1] - $off[0] - 2; } croak "Character 0x$hex with name '$fname' is above 0xFF"; } no warnings 'utf8'; # allow even illegal characters return pack "U", $ord; -} +} # charnames sub import { shift; ## ignore class name - if (not @_) - { - carp("`use charnames' needs explicit imports list"); + if (not @_) { + carp("`use charnames' needs explicit imports list"); } $^H |= $charnames::hint_bits; $^H{charnames} = \&charnames ; @@ -155,8 +176,25 @@ ## ## fill %h keys with our @_ args. ## - my %h; - @h{@_} = (1) x @_; + my ($promote, %h, @args) = (0); + while (@_ and $_ = shift) { + if ($_ eq ":alias" && @_) { + my $alias = shift; + if (ref $alias) { + ref $alias eq "HASH" or + die "Only HASH reference supported as argument to :alias"; + alias ($alias); + next; + } + if ($alias =~ m{:(\w+)$} and $1 ne "full" && $1 ne "short") { + alias_file ($1) and $promote = 1, next; + } + alias_file ($alias) and next; + } + push @args, $_; + } + @args == 0 && $promote and @args = (":full"); + @h{@args} = (1) x @args; $^H{charnames_full} = delete $h{':full'}; $^H{charnames_short} = delete $h{':short'}; @@ -166,18 +204,16 @@ ## If utf8? warnings are enabled, and some scripts were given, ## see if at least we can find one letter of each script. ## - if (warnings::enabled('utf8') && @{$^H{charnames_scripts}}) - { - $txt = do "unicore/Name.pl" unless $txt; - - for my $script (@{$^H{charnames_scripts}}) - { - if (not $txt =~ m/\t\t$script (?:CAPITAL |SMALL )?LETTER /) { - warnings::warn('utf8', "No such script: '$script'"); - } + if (warnings::enabled('utf8') && @{$^H{charnames_scripts}}) { + $txt = do "unicore/Name.pl" unless $txt; + + for my $script (@{$^H{charnames_scripts}}) { + if (not $txt =~ m/\t\t$script (?:CAPITAL |SMALL )?LETTER /) { + warnings::warn('utf8', "No such script: '$script'"); } + } } -} +} # import require Unicode::UCD; # for Unicode::UCD::_getcode() @@ -185,73 +221,73 @@ sub viacode { - if (@_ != 1) { - carp "charnames::viacode() expects one argument"; - return () - } + if (@_ != 1) { + carp "charnames::viacode() expects one argument"; + return () + } - my $arg = shift; - my $code = Unicode::UCD::_getcode($arg); + my $arg = shift; + my $code = Unicode::UCD::_getcode($arg); - my $hex; + my $hex; - if (defined $code) { - $hex = sprintf "%04X", $arg; - } else { - carp("unexpected arg \"$arg\" to charnames::viacode()"); - return; - } + if (defined $code) { + $hex = sprintf "%04X", $arg; + } else { + carp("unexpected arg \"$arg\" to charnames::viacode()"); + return; + } - if ($code > 0x10FFFF) { - carp sprintf "Unicode characters only allocated up to U+10FFFF (you asked for U+%X)", $hex; - return; - } + if ($code > 0x10FFFF) { + carp sprintf "Unicode characters only allocated up to U+10FFFF (you asked for +U+%X)", $hex; + return; + } - return $viacode{$hex} if exists $viacode{$hex}; + return $viacode{$hex} if exists $viacode{$hex}; - $txt = do "unicore/Name.pl" unless $txt; + $txt = do "unicore/Name.pl" unless $txt; - if ($txt =~ m/^$hex\t\t(.+)/m) { - return $viacode{$hex} = $1; - } else { - return; - } -} + if ($txt =~ m/^$hex\t\t(.+)/m) { + return $viacode{$hex} = $1; + } else { + return; + } +} # viacode my %vianame; sub vianame { - if (@_ != 1) { - carp "charnames::vianame() expects one name argument"; - return () - } + if (@_ != 1) { + carp "charnames::vianame() expects one name argument"; + return () + } - my $arg = shift; + my $arg = shift; - return chr hex $1 if $arg =~ /^U\+([0-9a-fA-F]+)$/; + return chr hex $1 if $arg =~ /^U\+([0-9a-fA-F]+)$/; - return $vianame{$arg} if exists $vianame{$arg}; + return $vianame{$arg} if exists $vianame{$arg}; - $txt = do "unicore/Name.pl" unless $txt; + $txt = do "unicore/Name.pl" unless $txt; - my $pos = index $txt, "\t\t$arg\n"; - if ($[ <= $pos) { - my $posLF = rindex $txt, "\n", $pos; - (my $code = substr $txt, $posLF + 1, 6) =~ tr/\t//d; - return $vianame{$arg} = hex $code; - - # If $pos is at the 1st line, $posLF must be $[ - 1 (not found); - # then $posLF + 1 equals to $[ (at the beginning of $txt). - # Otherwise $posLF is the position of "\n"; - # then $posLF + 1 must be the position of the next to "\n" - # (the beginning of the line). - # substr($txt, $posLF + 1, 6) may be "0000\t\t", "00A1\t\t", - # "10300\t", "100000", etc. So we can get the code via removing TAB. - } else { - return; - } -} + my $pos = index $txt, "\t\t$arg\n"; + if ($[ <= $pos) { + my $posLF = rindex $txt, "\n", $pos; + (my $code = substr $txt, $posLF + 1, 6) =~ tr/\t//d; + return $vianame{$arg} = hex $code; + + # If $pos is at the 1st line, $posLF must be $[ - 1 (not found); + # then $posLF + 1 equals to $[ (at the beginning of $txt). + # Otherwise $posLF is the position of "\n"; + # then $posLF + 1 must be the position of the next to "\n" + # (the beginning of the line). + # substr($txt, $posLF + 1, 6) may be "0000\t\t", "00A1\t\t", + # "10300\t", "100000", etc. So we can get the code via removing TAB. + } else { + return; + } +} # vianame 1; @@ -272,20 +308,25 @@ use charnames qw(cyrillic greek); print "\N{sigma} is Greek sigma, and \N{be} is Cyrillic b.\n"; + use charnames ":full", ":alias" => { + e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE", + }; + print "\N{e_ACUTE} is a small letter e with an acute.\n"; + print charnames::viacode(0x1234); # prints "ETHIOPIC SYLLABLE SEE" printf "%04X", charnames::vianame("GOTHIC LETTER AHSA"); # prints "10330" =head1 DESCRIPTION -Pragma C<use charnames> supports arguments C<:full>, C<:short> and -script names. If C<:full> is present, for expansion of +Pragma C<use charnames> supports arguments C<:full>, C<:short>, script +names and customized aliases. If C<:full> is present, for expansion of C<\N{CHARNAME}> string C<CHARNAME> is first looked in the list of standard Unicode names of chars. If C<:short> is present, and C<CHARNAME> has the form C<SCRIPT:CNAME>, then C<CNAME> is looked up as a letter in script C<SCRIPT>. If pragma C<use charnames> is used with script name arguments, then for C<\N{CHARNAME}> the name C<CHARNAME> is looked up as a letter in the given scripts (in the -specified order). +specified order). Customized aliases are explained in L</CUSTOM ALIASES>. For lookup of C<CHARNAME> inside a given script C<SCRIPTNAME> this pragma looks for the names @@ -343,6 +384,43 @@ } } +=head1 CUSTOM ALIASES + +This version of charnames supports three mechanisms of adding local +or customized aliases to standard Unicode naming conventions (:full) + +=head2 Anonymous hashes + + use charnames ":full", ":alias" => { + e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE", + }; + my $str = "\N{e_ACUTE}"; + +=head2 Alias file + + use charnames ":full", ":alias" => "pro"; + + will try to read "unicore/pro_alias.pl" from the @INC path. This + file should return a list in plain perl: + + ( + A_GRAVE => "LATIN CAPITAL LETTER A WITH GRAVE", + A_CIRCUM => "LATIN CAPITAL LETTER A WITH CIRCUMFLEX", + A_DIAERES => "LATIN CAPITAL LETTER A WITH DIAERESIS", + A_TILDE => "LATIN CAPITAL LETTER A WITH TILDE", + A_BREVE => "LATIN CAPITAL LETTER A WITH BREVE", + A_RING => "LATIN CAPITAL LETTER A WITH RING ABOVE", + A_MACRON => "LATIN CAPITAL LETTER A WITH MACRON", + ); + +=head2 Alias shortcut + + use charnames ":alias" => ":pro"; + + works exactly the same as the alias pairs, only this time, + ":full" is inserted automatically as first argument (if no + other argument is given). + =head1 charnames::viacode(code) Returns the full name of the character indicated by the numeric code. @@ -354,7 +432,7 @@ Returns undef if no name is known for the code. -This works only for the standard names, and does not yet apply +This works only for the standard names, and does not yet apply to custom translators. Notice that the name returned for of U+FEFF is "ZERO WIDTH NO-BREAK @@ -371,7 +449,7 @@ Returns undef if the name is unknown. -This works only for the standard names, and does not yet apply +This works only for the standard names, and does not yet apply to custom translators. =head1 ALIASES ==== //depot/perl/lib/charnames.t#21 (text) ==== Index: perl/lib/charnames.t --- perl/lib/charnames.t#20~16891~ Thu May 30 07:07:30 2002 +++ perl/lib/charnames.t Thu Oct 24 01:20:09 2002 @@ -12,7 +12,7 @@ $| = 1; -print "1..46\n"; +print "1..69\n"; use charnames ':full'; @@ -264,3 +264,250 @@ print "not " if grep { /you asked for U+110000/ } @WARN; print "ok 46\n"; + + +# ---- Alias extensions + +my $tmpfile = "tmp0000"; +my $alifile = "../lib/unicore/xyzzy_alias.pl"; +my $i = 0; +1 while -e ++$tmpfile; +END { if ($tmpfile) { 1 while unlink $tmpfile; } } + +my @prgs; +{ local $/ = undef; + @prgs = split "\n########\n", <DATA>; + } + +my $i = 46; +for (@prgs) { + my ($code, $exp) = ((split m/\nEXPECT\n/), '$'); + my ($prog, $fil) = ((split m/\nFILE\n/, $code), ""); + open my $tmp, "> $tmpfile" or die "Could not open $tmpfile: $!"; + print $tmp $prog, "\n"; + close $tmp or die "Could not close $tmpfile: $!"; + if ($fil) { + $fil .= "\n"; + open my $ali, "> $alifile" or die "Could not open $alifile: $!"; + print $ali $fil; + close $ali or die "Could not close $alifile: $!"; + } + my $res = + $^O eq "MSWin32" ? `.\\perl -I../lib $switch $tmpfile 2>&1` : + $^O eq "NetWare" ? `perl -I../lib $switch $tmpfile 2>&1` : + $^O eq "MacOS" ? `$^X -I::lib -MMac::err=unix $switch $tmpfile` : + `./perl -I. -I../lib $switch $tmpfile 2>&1`; + my $status = $?; + $res =~ s/[\r\n]+$//; + $res =~ s/tmp\d+/-/g; # fake $prog from STDIN + $res =~ s/\n%[A-Z]+-[SIWEF]-.*$// # clip off DCL status msg + if $^O eq "VMS"; + $exp =~ s/[\r\n]+$//; + if ($^O eq "MacOS") { + $exp =~ s{(\./)?abc\.pm}{:abc.pm}g; + $exp =~ s{./abc} {:abc}g; + } + my $pfx = ($res =~ s/^PREFIX\n//); + my $rexp = qr{^$exp}; + if ($res =~ s/^SKIPPED\n//) { + print "$results\n"; + } + elsif (($pfx and $res !~ /^\Q$expected/) or + (!$pfx and $res !~ $rexp)) { + print STDERR + "PROG:\n$prog\n", + "FILE:\n$fil", + "EXPECTED:\n$exp\n", + "GOT:\n$res\n"; + print "not "; + } + print "ok ", ++$i, "\n"; + 1 while unlink $tmpfile; + $fil or next; + 1 while unlink $alifile; + } + +__END__ +# wrong type of alias (missing colon) +use charnames "alias"; +"Here: \N{e_ACUTE}!\n"; +EXPECT +Unknown charname 'e_ACUTE' at +######## +# alias without an argument +use charnames ":alias"; +"Here: \N{e_ACUTE}!\n"; +EXPECT +Unknown charname 'e_ACUTE' at +######## +# alias with hashref but no :full +use charnames ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" }; +"Here: \N{e_ACUTE}!\n"; +EXPECT +Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at +######## +# alias with hashref but with :short +use charnames ":short", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" }; +"Here: \N{e_ACUTE}!\n"; +EXPECT +Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at +######## +# alias with hashref to :full OK +use charnames ":full", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" }; +"Here: \N{e_ACUTE}!\n"; +EXPECT +$ +######## +# alias with hashref to :short but using :full +use charnames ":full", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" }; +"Here: \N{e_ACUTE}!\n"; +EXPECT +Unknown charname 'LATIN:e WITH ACUTE' at +######## +# alias with hashref to :short OK +use charnames ":short", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" }; +"Here: \N{e_ACUTE}!\n"; +EXPECT +$ +######## +# alias with bad hashref +use charnames ":short", ":alias" => "e_ACUTE"; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +EXPECT +Odd number of elements in anonymous hash at +######## +# alias with arrayref +use charnames ":short", ":alias" => [ e_ACUTE => "LATIN:e WITH ACUTE" ]; +"Here: \N{e_ACUTE}!\n"; +EXPECT +Only HASH reference supported as argument to :alias at +######## +# alias with bad hashref +use charnames ":short", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE", "a_ACUTE" }; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +EXPECT +Use of uninitialized value in string eq at +######## +# alias with hashref two aliases +use charnames ":short", ":alias" => { + e_ACUTE => "LATIN:e WITH ACUTE", + a_ACUTE => "", + }; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +EXPECT +Unknown charname '' at +######## +# alias with hashref two aliases +use charnames ":short", ":alias" => { + e_ACUTE => "LATIN:e WITH ACUTE", + a_ACUTE => "LATIN:a WITH ACUTE", + }; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +EXPECT +$ +######## +# alias with hashref using mixed aliasses +use charnames ":short", ":alias" => { + e_ACUTE => "LATIN:e WITH ACUTE", + a_ACUTE => "LATIN SMALL LETTER A WITH ACUT", + }; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +EXPECT +Unknown charname 'LATIN SMALL LETTER A WITH ACUT' at +######## +# alias with hashref using mixed aliasses +use charnames ":short", ":alias" => { + e_ACUTE => "LATIN:e WITH ACUTE", + a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE", + }; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +EXPECT +Unknown charname 'LATIN SMALL LETTER A WITH ACUTE' at +######## +# alias with hashref using mixed aliasses +use charnames ":full", ":alias" => { + e_ACUTE => "LATIN:e WITH ACUTE", + a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE", + }; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +EXPECT +Unknown charname 'LATIN:e WITH ACUTE' at +######## +# alias with nonexisting file +use charnames ":full", ":alias" => "xyzzy"; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +EXPECT +Odd number of elements in anonymous hash at +######## +# alias with bad file +use charnames ":full", ":alias" => "xyzzy"; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +FILE +#!perl +0; +EXPECT +Odd number of elements in anonymous hash at +######## +# alias with file with empty list +use charnames ":full", ":alias" => "xyzzy"; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +FILE +#!perl +(); +EXPECT +Unknown charname 'e_ACUTE' at +######## +# alias with file OK but file has :short aliasses +use charnames ":full", ":alias" => "xyzzy"; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +FILE +#!perl +( e_ACUTE => "LATIN:e WITH ACUTE", + a_ACUTE => "LATIN:a WITH ACUTE", + ); +EXPECT +Unknown charname 'LATIN:e WITH ACUTE' at +######## +# alias with :short and file OK +use charnames ":short", ":alias" => "xyzzy"; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +FILE +#!perl +( e_ACUTE => "LATIN:e WITH ACUTE", + a_ACUTE => "LATIN:a WITH ACUTE", + ); +EXPECT +$ +######## +# alias with :short and file OK has :long aliasses +use charnames ":short", ":alias" => "xyzzy"; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +FILE +#!perl +( e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE", + a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE", + ); +EXPECT +Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at +######## +# alias with file implicit :full but file has :short aliasses +use charnames ":alias" => ":xyzzy"; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +FILE +#!perl +( e_ACUTE => "LATIN:e WITH ACUTE", + a_ACUTE => "LATIN:a WITH ACUTE", + ); +EXPECT +Unknown charname 'LATIN:e WITH ACUTE' at +######## +# alias with file implicit :full and file has :long aliasses +use charnames ":alias" => ":xyzzy"; +"Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; +FILE +#!perl +( e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE", + a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE", + ); +EXPECT +$ End of Patch.