X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fcharnames.t;h=f74453ded76fb6c7fa25b9521058816e7f3ffc82;hb=163ba113b958ebef4215df1e1b04445b4a85504f;hp=97663a7d1e4c7f823f911ee024808101bf857a2f;hpb=143a3e5ef1446bbe436a43486e7681c31b0c8407;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/charnames.t b/lib/charnames.t index 97663a7..f74453d 100644 --- a/lib/charnames.t +++ b/lib/charnames.t @@ -11,9 +11,11 @@ BEGIN { $SIG{__WARN__} = sub { push @WARN, @_ }; } +require File::Spec; + $| = 1; -print "1..73\n"; +print "1..79\n"; use charnames ':full'; @@ -59,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; } { @@ -174,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{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 (LF)}" eq "\n"; +print "ok 26\n"; - print "not " unless "\N{LINE FEED}" eq "\n"; - print "ok 27\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$/; @@ -269,11 +257,8 @@ print "ok 46\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; @@ -284,6 +269,7 @@ my $i = 46; 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: $!"; @@ -302,10 +288,6 @@ for (@prgs) { $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//) { @@ -321,11 +303,45 @@ 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 74\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 75\n" : "not ok 75\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 76 # $non_ascii\n" : "ok 76\n"; +} else { + print "ok 76\n"; +} + +# Verify that charnames propagate to eval("") +my $evaltry = eval q[ "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}" ]; +if ($@) { + print "# $@not ok 77\nnot ok 78\n"; +} else { + print "ok 77\n"; + print "not " unless $evaltry eq "Eval: \N{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}"; + print "ok 78\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 79\n"; + __END__ # unsupported pragma use charnames ":scoobydoo"; @@ -397,7 +413,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" => {