X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fcharnames.t;h=144c82621bb4adabe20bdf11f6e1e518b49c27d4;hb=6b8a2794cd62dd8d195b1d5c2699448cfd2be2c8;hp=8472abf981bf91d1c610bad0084b2c2c2397682d;hpb=35c0985d87e203a100f5c5fc6518bee6a2e2fd9d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/charnames.t b/lib/charnames.t index 8472abf..144c826 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..69\n"; +print "1..81\n"; use charnames ':full'; @@ -58,7 +61,7 @@ else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since } sub to_bytes { - pack"a*", shift; + unpack"U0a*", shift; } { @@ -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 @@ -173,28 +176,14 @@ print "ok 24\n"; print "not " unless "\N{NULL}" eq "\c@"; print "ok 25\n"; -if ($^O eq 'MacOS') -{ - print "not " unless "\N{CARRIAGE RETURN (CR)}" eq "\n"; - print "ok 26\n"; +print "not " unless "\N{LINE FEED (LF)}" eq "\n"; +print "ok 26\n"; - print "not " unless "\N{CARRIAGE RETURN}" eq "\n"; - print "ok 27\n"; +print "not " unless "\N{LINE FEED}" 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$/; @@ -265,24 +254,25 @@ print "ok 45\n"; print "not " if grep { /you asked for U+110000/ } @WARN; print "ok 46\n"; +print "not " unless "NULL" eq charnames::viacode(0); +print "ok 47\n"; + # ---- Alias extensions -my $tmpfile = "tmp0000"; -my $alifile = "../lib/unicore/xyzzy_alias.pl"; +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; +my $i = 47; 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: $!"; @@ -292,21 +282,15 @@ for (@prgs) { 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 $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//) { @@ -322,23 +306,86 @@ for (@prgs) { 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 75\n"; + +# 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. + +my $names = do "unicore/Name.pl"; +print defined $names ? "ok 76\n" : "not ok 76\n"; +if (ord('A') == 65) { # as on ASCII or UTF-8 machines + my $non_ascii = $names =~ tr/\0-\177//c; + print $non_ascii ? "not ok 77 # $non_ascii\n" : "ok 77\n"; +} else { + print "ok 77\n"; +} + +# Verify that charnames propagate to eval("") +my $evaltry = eval q[ "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}" ]; +if ($@) { + print "# $@not ok 78\nnot ok 79\n"; +} else { + print "ok 78\n"; + print "not " unless $evaltry eq "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}"; + print "ok 79\n"; +} + +# Verify that db includes the normative NameAliases.txt names +print "not " unless "\N{U+1D0C5}" eq "\N{BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA VASIS}"; +print "ok 80\n"; + +# [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; + print $res eq "foo-foo-1--2-3" ? "" : "not ", + "ok 81 - \$^H{foo} correct after /\\N{bar}/i (res=$res)\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 +Unknown charname 'e_ACUTE' at ######## # alias without an argument use charnames ":alias"; "Here: \N{e_ACUTE}!\n"; EXPECT -Unknown charname 'e_ACUTE' at +: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" }; @@ -374,7 +421,7 @@ $ use charnames ":short", ":alias" => "e_ACUTE"; "Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; EXPECT -Odd number of elements in anonymous hash at +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" ]; @@ -386,7 +433,7 @@ Only HASH reference supported as argument to :alias at 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 +Use of uninitialized value ######## # alias with hashref two aliases use charnames ":short", ":alias" => { @@ -437,7 +484,19 @@ Unknown charname 'LATIN:e WITH ACUTE' at use charnames ":full", ":alias" => "xyzzy"; "Here: \N{e_ACUTE}\N{a_ACUTE}!\n"; EXPECT -Odd number of elements in anonymous hash at +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"; @@ -446,7 +505,7 @@ FILE #!perl 0; EXPECT -Odd number of elements in anonymous hash at +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";