X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fcharnames.t;h=49917c5ad68ce82c5c23c8390a8b85519d44bb02;hb=6a0e9e729887ef408896cb941e158abe23871017;hp=a8a063f096363d82c062cdced068b9b4b7676779;hpb=52ea3e69a0eb35af2d24bda5dabccf9b9600bfe4;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/charnames.t b/lib/charnames.t index a8a063f..49917c5 100644 --- a/lib/charnames.t +++ b/lib/charnames.t @@ -6,13 +6,16 @@ BEGIN { unless(grep /blib/, @INC) { chdir 't' if -d 't'; @INC = '../lib'; + require './test.pl'; } $SIG{__WARN__} = sub { push @WARN, @_ }; } +require File::Spec; + $| = 1; -print "1..34\n"; +print "1..74\n"; use charnames ':full'; @@ -95,7 +98,7 @@ sub to_bytes { { use charnames qw(:full); use utf8; - + my $x = "\x{221b}"; my $named = "\N{CUBE ROOT}"; @@ -119,7 +122,7 @@ sub to_bytes { } { - # 20001114.001 + # 20001114.001 no utf8; # naked Latin-1 @@ -137,13 +140,14 @@ sub to_bytes { print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE"; print "ok 17\n"; - print "not " if defined charnames::viacode(0x0590); # unused Hebrew + # Unused Hebrew. + print "not " if defined charnames::viacode(0x0590); print "ok 18\n"; } { print "not " unless - sprintf "%04X\n", charnames::vianame("GOTHIC LETTER AHSA") eq "10330"; + sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")) eq "10330"; print "ok 19\n"; print "not " if @@ -158,7 +162,7 @@ sub to_bytes { print "ok 21\n"; print "not " unless - sprintf "%04X\n", charnames::vianame("GOTHIC LETTER AHSA") eq "10330"; + sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")) eq "10330"; print "ok 22\n"; } @@ -172,36 +176,369 @@ print "ok 24\n"; print "not " unless "\N{NULL}" eq "\c@"; print "ok 25\n"; -print "not " unless "\N{LINE FEED (LF)}" eq "\n"; -print "ok 26\n"; +if ($^O eq 'MacOS') +{ + print "not " unless "\N{CARRIAGE RETURN (CR)}" eq "\n"; + print "ok 26\n"; -print "not " unless "\N{LINE FEED}" eq "\n"; -print "ok 27\n"; + print "not " unless "\N{CARRIAGE RETURN}" eq "\n"; + print "ok 27\n"; + + print "not " unless "\N{CR}" eq "\n"; + print "ok 28\n"; +} +else +{ + print "not " unless "\N{LINE FEED (LF)}" eq "\n"; + print "ok 26\n"; + + print "not " unless "\N{LINE FEED}" eq "\n"; + print "ok 27\n"; + + print "not " unless "\N{LF}" eq "\n"; + print "ok 28\n"; +} -print "not " unless "\N{LF}" eq "\n"; -print "ok 28\n"; +my $nel = ord("A") == 193 ? qr/^(?:\x15|\x25)$/ : qr/^\x85$/; -print "not " unless "\N{BYTE ORDER MARK}" eq chr(0xFFFE); +print "not " unless "\N{NEXT LINE (NEL)}" =~ $nel; print "ok 29\n"; -print "not " unless "\N{BOM}" eq chr(0xFFFE); +print "not " unless "\N{NEXT LINE}" =~ $nel; print "ok 30\n"; +print "not " unless "\N{NEL}" =~ $nel; +print "ok 31\n"; + +print "not " unless "\N{BYTE ORDER MARK}" eq chr(0xFEFF); +print "ok 32\n"; + +print "not " unless "\N{BOM}" eq chr(0xFEFF); +print "ok 33\n"; + { use warnings 'deprecated'; print "not " unless "\N{HORIZONTAL TABULATION}" eq "\t"; - print "ok 31\n"; + print "ok 34\n"; print "not " unless grep { /"HORIZONTAL TABULATION" is deprecated/ } @WARN; - print "ok 32\n"; + print "ok 35\n"; no warnings 'deprecated'; print "not " unless "\N{VERTICAL TABULATION}" eq "\013"; - print "ok 33\n"; + print "ok 36\n"; print "not " if grep { /"VERTICAL TABULATION" is deprecated/ } @WARN; - print "ok 34\n"; + print "ok 37\n"; +} + +print "not " unless charnames::viacode(0xFEFF) eq "ZERO WIDTH NO-BREAK SPACE"; +print "ok 38\n"; + +{ + use warnings; + print "not " unless ord("\N{BOM}") == 0xFEFF; + print "ok 39\n"; } +print "not " unless ord("\N{ZWNJ}") == 0x200C; +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"; + +{ + print "not " unless + 0x3093 == charnames::vianame("HIRAGANA LETTER N"); + print "ok 43\n"; + + print "not " unless + 0x0397 == charnames::vianame("GREEK CAPITAL LETTER ETA"); + print "ok 44\n"; +} + +print "not " if defined charnames::viacode(0x110000); +print "ok 45\n"; + +print "not " if grep { /you asked for U+110000/ } @WARN; +print "ok 46\n"; + + +# ---- Alias extensions + +my $tmpfile = "tmp0000"; +my $alifile = File::Spec->catfile(File::Spec->updir, qw(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", ; + } + +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 = 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]+$//; + 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; + } + +# [perl #30409] charnames.pm clobbers default variable +$_ = 'foobar'; +eval "use charnames ':full';"; +print "not " unless $_ eq 'foobar'; +print "ok 74\n"; + +__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 +$