[perl5.git] / lib / charnames.t

#!./perl
use strict;

my @WARN;

BEGIN {
    unless(grep /blib/, @INC) {
	chdir 't' if -d 't';
	@INC = '../lib';
	require './test.pl';
    }
    $SIG{__WARN__} = sub { push @WARN, @_ };
}

require File::Spec;

$| = 1;

plan(85);

use charnames ':full';

is("Here\N{EXCLAMATION MARK}?", "Here!?");

{
    use bytes;			# TEST -utf8 can switch utf8 on

    my $res = eval <<'EOE';
use charnames ":full";
"Here: \N{CYRILLIC SMALL LETTER BE}!";
1
EOE

    like($@, "above 0xFF");
    is($res, undef);

    $res = eval <<'EOE';
use charnames 'cyrillic';
"Here: \N{Be}!";
1
EOE
    like($@, "CYRILLIC CAPITAL LETTER BE.*above 0xFF");
}

my $encoded_be;
my $encoded_alpha;
my $encoded_bet;
my $encoded_deseng;

# If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt
if (ord('A') == 65) { # as on ASCII or UTF-8 machines
    $encoded_be = "\320\261";
    $encoded_alpha = "\316\261";
    $encoded_bet = "\327\221";
    $encoded_deseng = "\360\220\221\215";
}
else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since
       # UTF-EBCDIC is codepage specific)
    $encoded_be = "\270\102\130";
    $encoded_alpha = "\264\130";
    $encoded_bet = "\270\125\130";
    $encoded_deseng = "\336\102\103\124";
}

sub to_bytes {
    unpack"U0a*", shift;
}

{
  use charnames ':full';

  is(to_bytes("\N{CYRILLIC SMALL LETTER BE}"), $encoded_be);

  use charnames qw(cyrillic greek :short);

  is(to_bytes("\N{be},\N{alpha},\N{hebrew:bet}"),
                                    "$encoded_be,$encoded_alpha,$encoded_bet");
}

{
    use charnames ':full';
    is("\x{263a}", "\N{WHITE SMILING FACE}");
    cmp_ok(length("\x{263a}"), '==', 1);
    cmp_ok(length("\N{WHITE SMILING FACE}"), '==', 1);
    is(sprintf("%vx", "\x{263a}"), "263a");
    is(sprintf("%vx", "\N{WHITE SMILING FACE}"), "263a");
    is(sprintf("%vx", "\xFF\N{WHITE SMILING FACE}"), "ff.263a");
    is(sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}"), "ff.263a");
}

{
    use charnames qw(:full);
    use utf8;

    my $x = "\x{221b}";
    my $named = "\N{CUBE ROOT}";

    cmp_ok(ord($x), '==', ord($named));
}

{
    use charnames qw(:full);
    use utf8;
    is("\x{100}\N{CENT SIGN}", "\x{100}"."\N{CENT SIGN}");
}

{
    use charnames ':full';

    is(to_bytes("\N{DESERET SMALL LETTER ENG}"), $encoded_deseng);
}

{
    # 20001114.001

    no utf8; # naked Latin-1

    use charnames ':full';
    my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}";
    is($text, latin1_to_native("\xc4"));

    # I'm not sure that this tests anything different from the above.
    cmp_ok(ord($text), '==', ord(latin1_to_native("\xc4")));
}

{
    is(charnames::viacode(0x1234), "ETHIOPIC SYLLABLE SEE");

    # Unused Hebrew.
    ok(! defined charnames::viacode(0x0590));
}

{
    is(sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")), "10330");
    ok (! defined charnames::vianame("NONE SUCH"));
}

{
    # check that caching at least hasn't broken anything

    is(charnames::viacode(0x1234), "ETHIOPIC SYLLABLE SEE");

    is(sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")), "10330");

}

is("\N{CHARACTER TABULATION}", "\t");

is("\N{ESCAPE}", "\e");
is("\N{NULL}", "\c@");
is("\N{LINE FEED (LF)}", "\n");
is("\N{LINE FEED}", "\n");
is("\N{LF}", "\n");

my $nel = latin1_to_native("\x85");
$nel = qr/^$nel$/;

like("\N{NEXT LINE (NEL)}", $nel);
like("\N{NEXT LINE}", $nel);
like("\N{NEL}", $nel);
is("\N{BYTE ORDER MARK}", chr(0xFEFF));
is("\N{BOM}", chr(0xFEFF));

{
    use warnings 'deprecated';

    is("\N{HORIZONTAL TABULATION}", "\t");

    ok(grep { /"HORIZONTAL TABULATION" is deprecated/ } @WARN);

    no warnings 'deprecated';

    is("\N{VERTICAL TABULATION}", "\013");

    ok(! grep { /"VERTICAL TABULATION" is deprecated/ } @WARN);
}

is(charnames::viacode(0xFEFF), "ZERO WIDTH NO-BREAK SPACE");

{
    use warnings;
    cmp_ok(ord("\N{BOM}"), '==', 0xFEFF);
}

cmp_ok(ord("\N{ZWNJ}"), '==', 0x200C);

cmp_ok(ord("\N{ZWJ}"), '==', 0x200D);

is("\N{U+263A}", "\N{WHITE SMILING FACE}");

{
    cmp_ok( 0x3093, '==', charnames::vianame("HIRAGANA LETTER N"));
    cmp_ok(0x0397, '==', charnames::vianame("GREEK CAPITAL LETTER ETA"));
}

ok(! defined charnames::viacode(0x110000));
ok(! grep { /you asked for U+110000/ } @WARN);

is(charnames::viacode(0), "NULL");
is(charnames::viacode("BE"), "VULGAR FRACTION THREE QUARTERS");
is(charnames::viacode("U+00000000000FEED"), "ARABIC LETTER WAW ISOLATED FORM");


# ---- Alias extensions

my $alifile = File::Spec->catfile(File::Spec->updir, qw(lib unicore xyzzy_alias.pl));

my @prgs;
{
    local $/ = undef;
    @prgs = split "\n########\n", <DATA>;
}

for (@prgs) {
    my ($code, $exp) = ((split m/\nEXPECT\n/), '$');
    my ($prog, $fil) = ((split m/\nFILE\n/, $code), "");
    my $tmpfile = tempfile();
    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 $switch = "";
    my $res = runperl( switches => $switch,
                       progfile => $tmpfile,
                       stderr => 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]+$//;
    my $pfx = ($res =~ s/^PREFIX\n//);
    my $rexp = qr{^$exp};
    my $expected = "";      # Unsure why this is here, as was never initialized

    SKIP: {
        skip $res, 1, if $res =~ s/^SKIPPED\n//;
        if (($pfx and $res !~ /^\Q$expected/) or
            (!$pfx and $res !~ $rexp))
        {
            fail("PROG:\n$prog\nFILE:\n${fil}EXPECTED:\n$exp\nGOT:\n$res");
        } else {
            pass("");
        }
    }
    $fil or next;
    1 while unlink $alifile;
}

# [perl #30409] charnames.pm clobbers default variable
$_ = 'foobar';
eval "use charnames ':full';";
is($_, 'foobar');

# Unicode slowdown noted by Phil Pennock, traced to a bug fix in index
# SADAHIRO Tomoyuki's suggestion is to ensure that the UTF-8ness of both
# arguments are indentical before calling index.
# To do this can take advantage of the fact that unicore/Name.pl is 7 bit
# (or at least should be). So assert that that it's true here.  EBCDIC
# may be a problem (khw).

my $names = do "unicore/Name.pl";
ok(defined $names);
my $non_ascii = native_to_latin1($names) =~ tr/\0-\177//c;
ok(! $non_ascii, "Make sure all names are ASCII-only");

# Verify that charnames propagate to eval("")
my $evaltry = eval q[ "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}" ];
if ($@) {
    fail('charnames failed to propagate to eval("")');
    fail('next test also fails to make the same number of tests');
} else {
    pass('charnames propagated to eval("")');
    is($evaltry, "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}");
}

# Verify that db includes the normative NameAliases.txt names
is("\N{U+1D0C5}", "\N{BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA VASIS}");

# [perl #73174] use of \N{FOO} used to reset %^H

{
    use charnames ":full";
    my $res;
    BEGIN { $^H{73174} = "foo" }
    BEGIN { $res = ($^H{73174} // "") }
    # forces loading of utf8.pm, which used to reset %^H
    $res .= '-1' if ":" =~ /\N{COLON}/i;
    BEGIN { $res .= '-' . ($^H{73174} // "") }
    $res .= '-' . ($^H{73174} // "");
    $res .= '-2' if ":" =~ /\N{COLON}/;
    $res .= '-3' if ":" =~ /\N{COLON}/i;
    is($res, "foo-foo-1--2-3");
}

__END__
# unsupported pragma
use charnames ":scoobydoo";
"Here: \N{e_ACUTE}!\n";
EXPECT
unsupported special ':scoobydoo' in charnames at
########
# 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
:alias needs an argument in charnames at
########
# reversed sequence
use charnames ":alias" => ":full";
"Here: \N{e_ACUTE}!\n";
EXPECT
:alias cannot use existing pragma :full \(reversed order\?\) 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
unicore/e_ACUTE_alias.pl cannot be used as alias file for charnames 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
########
# 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
unicore/xyzzy_alias.pl cannot be used as alias file for charnames at
########
# alias with bad file name
use charnames ":full", ":alias" => "xy 7-";
"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
EXPECT
Charnames alias files can only have identifier characters at
########
# alias with non_absolute (existing) file name (which it should /not/ use)
use charnames ":full", ":alias" => "perl";
"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
EXPECT
unicore/perl_alias.pl cannot be used as alias file for charnames at
########
# alias with bad file
use charnames ":full", ":alias" => "xyzzy";
"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
FILE
#!perl
0;
EXPECT
unicore/xyzzy_alias.pl did not return a \(valid\) list of alias pairs 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
$
Commit	Line	Data
423cee85	1	#!./perl
a0d8d8c5	2	use strict;
423cee85	3
52ea3e69 JH	4	my @WARN;
52ea3e69 JH	5
423cee85 JH	6	BEGIN {
	7	unless(grep /blib/, @INC) {
	8	chdir 't' if -d 't';
20822f61	9	@INC = '../lib';
143a3e5e	10	require './test.pl';
423cee85	11	}
52ea3e69	12	$SIG{__WARN__} = sub { push @WARN, @_ };
423cee85 JH	13	}
423cee85 JH	14
63c6dcc1 JH	15	require File::Spec;
63c6dcc1 JH	16
423cee85	17	$\| = 1;
822ebcc8	18
c8002005	19	plan(85);
423cee85 JH	20
	21	use charnames ':full';
	22
a0d8d8c5	23	is("Here\N{EXCLAMATION MARK}?", "Here!?");
423cee85	24
c82a54e6	25	{
a0d8d8c5	26	use bytes; # TEST -utf8 can switch utf8 on
c82a54e6	27
a0d8d8c5	28	my $res = eval <<'EOE';
423cee85	29	use charnames ":full";
4a2d328f	30	"Here: \N{CYRILLIC SMALL LETTER BE}!";
423cee85 JH	31	1
423cee85 JH	32	EOE
423cee85	33
a0d8d8c5 KW	34	like($@, "above 0xFF");
	35	is($res, undef);
	36
	37	$res = eval <<'EOE';
423cee85	38	use charnames 'cyrillic';
4a2d328f	39	"Here: \N{Be}!";
423cee85 JH	40	1
423cee85 JH	41	EOE
a0d8d8c5	42	like($@, "CYRILLIC CAPITAL LETTER BE.*above 0xFF");
c82a54e6	43	}
423cee85	44
a0d8d8c5 KW	45	my $encoded_be;
	46	my $encoded_alpha;
	47	my $encoded_bet;
	48	my $encoded_deseng;
	49
423cee85	50	# If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt
210db7fc PP	51	if (ord('A') == 65) { # as on ASCII or UTF-8 machines
	52	$encoded_be = "\320\261";
	53	$encoded_alpha = "\316\261";
	54	$encoded_bet = "\327\221";
	55	$encoded_deseng = "\360\220\221\215";
	56	}
	57	else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since
	58	# UTF-EBCDIC is codepage specific)
	59	$encoded_be = "\270\102\130";
	60	$encoded_alpha = "\264\130";
	61	$encoded_bet = "\270\125\130";
	62	$encoded_deseng = "\336\102\103\124";
	63	}
c5cc3500 GS	64
c5cc3500 GS	65	sub to_bytes {
f337b084	66	unpack"U0a*", shift;
c5cc3500 GS	67	}
c5cc3500 GS	68
423cee85 JH	69	{
423cee85 JH	70	use charnames ':full';
423cee85	71
a0d8d8c5	72	is(to_bytes("\N{CYRILLIC SMALL LETTER BE}"), $encoded_be);
423cee85 JH	73
	74	use charnames qw(cyrillic greek :short);
	75
a0d8d8c5 KW	76	is(to_bytes("\N{be},\N{alpha},\N{hebrew:bet}"),
a0d8d8c5 KW	77	"$encoded_be,$encoded_alpha,$encoded_bet");
423cee85	78	}
e1992b6d GS	79
	80	{
	81	use charnames ':full';
a0d8d8c5 KW	82	is("\x{263a}", "\N{WHITE SMILING FACE}");
	83	cmp_ok(length("\x{263a}"), '==', 1);
	84	cmp_ok(length("\N{WHITE SMILING FACE}"), '==', 1);
	85	is(sprintf("%vx", "\x{263a}"), "263a");
	86	is(sprintf("%vx", "\N{WHITE SMILING FACE}"), "263a");
	87	is(sprintf("%vx", "\xFF\N{WHITE SMILING FACE}"), "ff.263a");
	88	is(sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}"), "ff.263a");
e1992b6d	89	}
c00525d4 SP	90
c00525d4 SP	91	{
a0d8d8c5 KW	92	use charnames qw(:full);
a0d8d8c5 KW	93	use utf8;
51cf30b6	94
c00525d4 SP	95	my $x = "\x{221b}";
	96	my $named = "\N{CUBE ROOT}";
	97
a0d8d8c5	98	cmp_ok(ord($x), '==', ord($named));
c00525d4 SP	99	}
c00525d4 SP	100
f9a63242	101	{
a0d8d8c5 KW	102	use charnames qw(:full);
	103	use utf8;
	104	is("\x{100}\N{CENT SIGN}", "\x{100}"."\N{CENT SIGN}");
f9a63242 JH	105	}
f9a63242 JH	106
b896c7a5	107	{
a0d8d8c5	108	use charnames ':full';
b896c7a5	109
a0d8d8c5	110	is(to_bytes("\N{DESERET SMALL LETTER ENG}"), $encoded_deseng);
4765795a	111	}
b896c7a5	112
4765795a	113	{
a0d8d8c5 KW	114	# 20001114.001
	115
	116	no utf8; # naked Latin-1
	117
	118	use charnames ':full';
	119	my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}";
	120	is($text, latin1_to_native("\xc4"));
	121
	122	# I'm not sure that this tests anything different from the above.
	123	cmp_ok(ord($text), '==', ord(latin1_to_native("\xc4")));
b896c7a5 A	124	}
b896c7a5 A	125
daf0d493	126	{
a0d8d8c5	127	is(charnames::viacode(0x1234), "ETHIOPIC SYLLABLE SEE");
daf0d493	128
a23c04e4	129	# Unused Hebrew.
a0d8d8c5	130	ok(! defined charnames::viacode(0x0590));
daf0d493 JH	131	}
	132
	133	{
a0d8d8c5 KW	134	is(sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")), "10330");
a0d8d8c5 KW	135	ok (! defined charnames::vianame("NONE SUCH"));
daf0d493	136	}
4e2cda5d JH	137
	138	{
	139	# check that caching at least hasn't broken anything
	140
a0d8d8c5	141	is(charnames::viacode(0x1234), "ETHIOPIC SYLLABLE SEE");
4e2cda5d	142
a0d8d8c5	143	is(sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")), "10330");
4e2cda5d JH	144
4e2cda5d JH	145	}
301a3cda	146
a0d8d8c5	147	is("\N{CHARACTER TABULATION}", "\t");
a2e77dd4	148
a0d8d8c5 KW	149	is("\N{ESCAPE}", "\e");
	150	is("\N{NULL}", "\c@");
	151	is("\N{LINE FEED (LF)}", "\n");
	152	is("\N{LINE FEED}", "\n");
	153	is("\N{LF}", "\n");
52ea3e69	154
a0d8d8c5 KW	155	my $nel = latin1_to_native("\x85");
a0d8d8c5 KW	156	$nel = qr/^$nel$/;
52ea3e69	157
a0d8d8c5 KW	158	like("\N{NEXT LINE (NEL)}", $nel);
	159	like("\N{NEXT LINE}", $nel);
	160	like("\N{NEL}", $nel);
	161	is("\N{BYTE ORDER MARK}", chr(0xFEFF));
	162	is("\N{BOM}", chr(0xFEFF));
51e9e896	163
52ea3e69 JH	164	{
	165	use warnings 'deprecated';
	166
a0d8d8c5	167	is("\N{HORIZONTAL TABULATION}", "\t");
52ea3e69	168
a0d8d8c5	169	ok(grep { /"HORIZONTAL TABULATION" is deprecated/ } @WARN);
822ebcc8	170
52ea3e69 JH	171	no warnings 'deprecated';
52ea3e69 JH	172
a0d8d8c5	173	is("\N{VERTICAL TABULATION}", "\013");
52ea3e69	174
a0d8d8c5	175	ok(! grep { /"VERTICAL TABULATION" is deprecated/ } @WARN);
52ea3e69	176	}
822ebcc8	177
a0d8d8c5	178	is(charnames::viacode(0xFEFF), "ZERO WIDTH NO-BREAK SPACE");
a23c04e4	179
872c91ae JH	180	{
872c91ae JH	181	use warnings;
a0d8d8c5	182	cmp_ok(ord("\N{BOM}"), '==', 0xFEFF);
872c91ae JH	183	}
872c91ae JH	184
a0d8d8c5	185	cmp_ok(ord("\N{ZWNJ}"), '==', 0x200C);
24b5d5cc	186
a0d8d8c5	187	cmp_ok(ord("\N{ZWJ}"), '==', 0x200D);
dbc0d4f2	188
a0d8d8c5	189	is("\N{U+263A}", "\N{WHITE SMILING FACE}");
dbc0d4f2	190
51b0dbc4	191	{
a0d8d8c5 KW	192	cmp_ok( 0x3093, '==', charnames::vianame("HIRAGANA LETTER N"));
a0d8d8c5 KW	193	cmp_ok(0x0397, '==', charnames::vianame("GREEK CAPITAL LETTER ETA"));
51b0dbc4 TS	194	}
51b0dbc4 TS	195
a0d8d8c5 KW	196	ok(! defined charnames::viacode(0x110000));
a0d8d8c5 KW	197	ok(! grep { /you asked for U+110000/ } @WARN);
e10d7780	198
c8002005 KW	199	is(charnames::viacode(0), "NULL");
	200	is(charnames::viacode("BE"), "VULGAR FRACTION THREE QUARTERS");
	201	is(charnames::viacode("U+00000000000FEED"), "ARABIC LETTER WAW ISOLATED FORM");
	202
35c0985d MB	203
	204	# ---- Alias extensions
	205
63c6dcc1	206	my $alifile = File::Spec->catfile(File::Spec->updir, qw(lib unicore xyzzy_alias.pl));
35c0985d MB	207
35c0985d MB	208	my @prgs;
a0d8d8c5 KW	209	{
a0d8d8c5 KW	210	local $/ = undef;
35c0985d	211	@prgs = split "\n########\n", <DATA>;
a0d8d8c5	212	}
35c0985d	213
35c0985d MB	214	for (@prgs) {
	215	my ($code, $exp) = ((split m/\nEXPECT\n/), '$');
	216	my ($prog, $fil) = ((split m/\nFILE\n/, $code), "");
f89542f7	217	my $tmpfile = tempfile();
35c0985d MB	218	open my $tmp, "> $tmpfile" or die "Could not open $tmpfile: $!";
	219	print $tmp $prog, "\n";
	220	close $tmp or die "Could not close $tmpfile: $!";
	221	if ($fil) {
	222	$fil .= "\n";
	223	open my $ali, "> $alifile" or die "Could not open $alifile: $!";
	224	print $ali $fil;
	225	close $ali or die "Could not close $alifile: $!";
a0d8d8c5 KW	226	}
	227	my $switch = "";
	228	my $res = runperl( switches => $switch,
143a3e5e CB	229	progfile => $tmpfile,
143a3e5e CB	230	stderr => 1 );
35c0985d MB	231	my $status = $?;
	232	$res =~ s/[\r\n]+$//;
	233	$res =~ s/tmp\d+/-/g; # fake $prog from STDIN
	234	$res =~ s/\n%[A-Z]+-[SIWEF]-.*$// # clip off DCL status msg
	235	if $^O eq "VMS";
	236	$exp =~ s/[\r\n]+$//;
35c0985d MB	237	my $pfx = ($res =~ s/^PREFIX\n//);
35c0985d MB	238	my $rexp = qr{^$exp};
a0d8d8c5 KW	239	my $expected = ""; # Unsure why this is here, as was never initialized
	240
	241	SKIP: {
	242	skip $res, 1, if $res =~ s/^SKIPPED\n//;
	243	if (($pfx and $res !~ /^\Q$expected/) or
	244	(!$pfx and $res !~ $rexp))
	245	{
	246	fail("PROG:\n$prog\nFILE:\n${fil}EXPECTED:\n$exp\nGOT:\n$res");
	247	} else {
	248	pass("");
	249	}
	250	}
35c0985d MB	251	$fil or next;
35c0985d MB	252	1 while unlink $alifile;
a0d8d8c5	253	}
35c0985d	254
e5c3f898 MG	255	# [perl #30409] charnames.pm clobbers default variable
	256	$_ = 'foobar';
	257	eval "use charnames ':full';";
a0d8d8c5	258	is($_, 'foobar');
e5c3f898	259
c776535e NC	260	# Unicode slowdown noted by Phil Pennock, traced to a bug fix in index
	261	# SADAHIRO Tomoyuki's suggestion is to ensure that the UTF-8ness of both
	262	# arguments are indentical before calling index.
	263	# To do this can take advantage of the fact that unicore/Name.pl is 7 bit
e5d6fe1e KW	264	# (or at least should be). So assert that that it's true here. EBCDIC
e5d6fe1e KW	265	# may be a problem (khw).
c776535e NC	266
c776535e NC	267	my $names = do "unicore/Name.pl";
a0d8d8c5 KW	268	ok(defined $names);
	269	my $non_ascii = native_to_latin1($names) =~ tr/\0-\177//c;
	270	ok(! $non_ascii, "Make sure all names are ASCII-only");
c776535e	271
eb915052 RGS	272	# Verify that charnames propagate to eval("")
	273	my $evaltry = eval q[ "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}" ];
	274	if ($@) {
a0d8d8c5 KW	275	fail('charnames failed to propagate to eval("")');
a0d8d8c5 KW	276	fail('next test also fails to make the same number of tests');
eb915052	277	} else {
a0d8d8c5 KW	278	pass('charnames propagated to eval("")');
a0d8d8c5 KW	279	is($evaltry, "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}");
eb915052	280	}
c776535e	281
ae6979a8	282	# Verify that db includes the normative NameAliases.txt names
a0d8d8c5	283	is("\N{U+1D0C5}", "\N{BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA VASIS}");
ae6979a8	284
ec34a119 DM	285	# [perl #73174] use of \N{FOO} used to reset %^H
	286
	287	{
	288	use charnames ":full";
	289	my $res;
	290	BEGIN { $^H{73174} = "foo" }
	291	BEGIN { $res = ($^H{73174} // "") }
	292	# forces loading of utf8.pm, which used to reset %^H
	293	$res .= '-1' if ":" =~ /\N{COLON}/i;
	294	BEGIN { $res .= '-' . ($^H{73174} // "") }
	295	$res .= '-' . ($^H{73174} // "");
	296	$res .= '-2' if ":" =~ /\N{COLON}/;
	297	$res .= '-3' if ":" =~ /\N{COLON}/i;
a0d8d8c5	298	is($res, "foo-foo-1--2-3");
ec34a119 DM	299	}
ec34a119 DM	300
35c0985d	301	__END__
51cf30b6 MB	302	# unsupported pragma
	303	use charnames ":scoobydoo";
	304	"Here: \N{e_ACUTE}!\n";
	305	EXPECT
	306	unsupported special ':scoobydoo' in charnames at
	307	########
35c0985d MB	308	# wrong type of alias (missing colon)
	309	use charnames "alias";
	310	"Here: \N{e_ACUTE}!\n";
	311	EXPECT
51cf30b6	312	Unknown charname 'e_ACUTE' at
35c0985d MB	313	########
	314	# alias without an argument
	315	use charnames ":alias";
	316	"Here: \N{e_ACUTE}!\n";
	317	EXPECT
51cf30b6 MB	318	:alias needs an argument in charnames at
	319	########
	320	# reversed sequence
	321	use charnames ":alias" => ":full";
	322	"Here: \N{e_ACUTE}!\n";
	323	EXPECT
	324	:alias cannot use existing pragma :full \(reversed order\?\) at
35c0985d MB	325	########
	326	# alias with hashref but no :full
	327	use charnames ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
	328	"Here: \N{e_ACUTE}!\n";
	329	EXPECT
	330	Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
	331	########
	332	# alias with hashref but with :short
	333	use charnames ":short", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
	334	"Here: \N{e_ACUTE}!\n";
	335	EXPECT
	336	Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
	337	########
	338	# alias with hashref to :full OK
	339	use charnames ":full", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
	340	"Here: \N{e_ACUTE}!\n";
	341	EXPECT
	342	$
	343	########
	344	# alias with hashref to :short but using :full
	345	use charnames ":full", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" };
	346	"Here: \N{e_ACUTE}!\n";
	347	EXPECT
	348	Unknown charname 'LATIN:e WITH ACUTE' at
	349	########
	350	# alias with hashref to :short OK
	351	use charnames ":short", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" };
	352	"Here: \N{e_ACUTE}!\n";
	353	EXPECT
	354	$
	355	########
	356	# alias with bad hashref
	357	use charnames ":short", ":alias" => "e_ACUTE";
	358	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	359	EXPECT
51cf30b6	360	unicore/e_ACUTE_alias.pl cannot be used as alias file for charnames at
35c0985d MB	361	########
	362	# alias with arrayref
	363	use charnames ":short", ":alias" => [ e_ACUTE => "LATIN:e WITH ACUTE" ];
	364	"Here: \N{e_ACUTE}!\n";
	365	EXPECT
	366	Only HASH reference supported as argument to :alias at
	367	########
	368	# alias with bad hashref
	369	use charnames ":short", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE", "a_ACUTE" };
	370	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	371	EXPECT
29489e7c	372	Use of uninitialized value
35c0985d MB	373	########
	374	# alias with hashref two aliases
	375	use charnames ":short", ":alias" => {
	376	e_ACUTE => "LATIN:e WITH ACUTE",
	377	a_ACUTE => "",
	378	};
	379	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	380	EXPECT
	381	Unknown charname '' at
	382	########
	383	# alias with hashref two aliases
	384	use charnames ":short", ":alias" => {
	385	e_ACUTE => "LATIN:e WITH ACUTE",
	386	a_ACUTE => "LATIN:a WITH ACUTE",
	387	};
	388	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	389	EXPECT
	390	$
	391	########
	392	# alias with hashref using mixed aliasses
	393	use charnames ":short", ":alias" => {
	394	e_ACUTE => "LATIN:e WITH ACUTE",
	395	a_ACUTE => "LATIN SMALL LETTER A WITH ACUT",
	396	};
	397	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	398	EXPECT
	399	Unknown charname 'LATIN SMALL LETTER A WITH ACUT' at
	400	########
	401	# alias with hashref using mixed aliasses
	402	use charnames ":short", ":alias" => {
	403	e_ACUTE => "LATIN:e WITH ACUTE",
	404	a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
	405	};
	406	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	407	EXPECT
	408	Unknown charname 'LATIN SMALL LETTER A WITH ACUTE' at
	409	########
	410	# alias with hashref using mixed aliasses
	411	use charnames ":full", ":alias" => {
	412	e_ACUTE => "LATIN:e WITH ACUTE",
	413	a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
	414	};
	415	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	416	EXPECT
	417	Unknown charname 'LATIN:e WITH ACUTE' at
	418	########
	419	# alias with nonexisting file
	420	use charnames ":full", ":alias" => "xyzzy";
	421	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	422	EXPECT
51cf30b6 MB	423	unicore/xyzzy_alias.pl cannot be used as alias file for charnames at
	424	########
	425	# alias with bad file name
	426	use charnames ":full", ":alias" => "xy 7-";
	427	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	428	EXPECT
	429	Charnames alias files can only have identifier characters at
	430	########
	431	# alias with non_absolute (existing) file name (which it should /not/ use)
	432	use charnames ":full", ":alias" => "perl";
	433	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	434	EXPECT
	435	unicore/perl_alias.pl cannot be used as alias file for charnames at
35c0985d MB	436	########
	437	# alias with bad file
	438	use charnames ":full", ":alias" => "xyzzy";
	439	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	440	FILE
	441	#!perl
	442	0;
	443	EXPECT
51cf30b6	444	unicore/xyzzy_alias.pl did not return a \(valid\) list of alias pairs at
35c0985d MB	445	########
	446	# alias with file with empty list
	447	use charnames ":full", ":alias" => "xyzzy";
	448	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	449	FILE
	450	#!perl
	451	();
	452	EXPECT
	453	Unknown charname 'e_ACUTE' at
	454	########
	455	# alias with file OK but file has :short aliasses
	456	use charnames ":full", ":alias" => "xyzzy";
	457	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	458	FILE
	459	#!perl
	460	( e_ACUTE => "LATIN:e WITH ACUTE",
	461	a_ACUTE => "LATIN:a WITH ACUTE",
	462	);
	463	EXPECT
	464	Unknown charname 'LATIN:e WITH ACUTE' at
	465	########
	466	# alias with :short and file OK
	467	use charnames ":short", ":alias" => "xyzzy";
	468	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	469	FILE
	470	#!perl
	471	( e_ACUTE => "LATIN:e WITH ACUTE",
	472	a_ACUTE => "LATIN:a WITH ACUTE",
	473	);
	474	EXPECT
	475	$
	476	########
	477	# alias with :short and file OK has :long aliasses
	478	use charnames ":short", ":alias" => "xyzzy";
	479	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	480	FILE
	481	#!perl
	482	( e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
	483	a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
	484	);
	485	EXPECT
	486	Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
	487	########
	488	# alias with file implicit :full but file has :short aliasses
	489	use charnames ":alias" => ":xyzzy";
	490	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	491	FILE
	492	#!perl
	493	( e_ACUTE => "LATIN:e WITH ACUTE",
	494	a_ACUTE => "LATIN:a WITH ACUTE",
	495	);
	496	EXPECT
	497	Unknown charname 'LATIN:e WITH ACUTE' at
	498	########
	499	# alias with file implicit :full and file has :long aliasses
	500	use charnames ":alias" => ":xyzzy";
	501	"Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
	502	FILE
	503	#!perl
	504	( e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
	505	a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
	506	);
	507	EXPECT
	508	$