From 3e6618b7a3a573729d121d2ba204ea2164d47107 Mon Sep 17 00:00:00 2001 From: Nick Ing-Simmons Date: Fri, 1 Feb 2002 18:20:46 +0000 Subject: Integrate mainline p4raw-id: //depot/perlio@14517 --- t/io/utf8.t | 51 +++++++++++++++++++++++++++-- t/lib/warnings/pp_sys | 21 ------------ t/lib/warnings/utf8 | 91 ++++++++++++++++++++++++++++++++++++++++++++++----- t/op/inccode.t | 10 +++++- t/op/lc.t | 25 +++++++++++--- t/op/stat.t | 37 ++++++++++++++++++++- t/run/switches.t | 35 ++++++++++++++++++-- 7 files changed, 229 insertions(+), 41 deletions(-) (limited to 't') diff --git a/t/io/utf8.t b/t/io/utf8.t index e8caf722f2..337bd52144 100755 --- a/t/io/utf8.t +++ b/t/io/utf8.t @@ -12,7 +12,7 @@ BEGIN { no utf8; # needed for use utf8 not griping about the raw octets $| = 1; -print "1..26\n"; +print "1..31\n"; open(F,"+>:utf8",'a'); print F chr(0x100).'£'; @@ -186,7 +186,7 @@ if (ord('A') == 193) { close F; unlink('a'); -open F, ">a"; +open F, ">:utf8", "a"; @a = map { chr(1 << ($_ << 2)) } 0..5; # 0x1, 0x10, .., 0x100000 unshift @a, chr(0); # ... and a null byte in front just for fun print F @a; @@ -216,6 +216,52 @@ for (@a) { close F; print "ok 26\n"; +{ + # Check that warnings are on on I/O, and that they can be muffled. + + local $SIG{__WARN__} = sub { $@ = shift }; + + undef $@; + open F, ">a"; + print F chr(0x100); + close(F); + + print $@ =~ /Wide character in print/ ? "ok 27\n" : "not ok 27\n"; + + undef $@; + open F, ">:utf8", "a"; + print F chr(0x100); + close(F); + + print defined $@ ? "not ok 28\n" : "ok 28\n"; + + undef $@; + open F, ">a"; + binmode(F, ":utf8"); + print F chr(0x100); + close(F); + + print defined $@ ? "not ok 29\n" : "ok 29\n"; + + no warnings 'utf8'; + + undef $@; + open F, ">a"; + print F chr(0x100); + close(F); + + print defined $@ ? "not ok 30\n" : "ok 30\n"; + + use warnings 'utf8'; + + undef $@; + open F, ">a"; + print F chr(0x100); + close(F); + + print $@ =~ /Wide character in print/ ? "ok 31\n" : "not ok 31\n"; +} + # sysread() and syswrite() tested in lib/open.t since Fnctl is used END { @@ -223,4 +269,3 @@ END { 1 while unlink "b"; } - diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys index e30637b0d4..4b9c8b1a96 100644 --- a/t/lib/warnings/pp_sys +++ b/t/lib/warnings/pp_sys @@ -83,9 +83,6 @@ flock STDIN, 8; flock $a, 8; - The stat preceding lstat() wasn't an lstat %s [pp_stat] - lstat(STDIN); - warn(warn_nl, "stat"); [pp_stat] -T on closed filehandle %s @@ -347,24 +344,6 @@ stat "abc\ndef"; EXPECT Unsuccessful stat on filename containing newline at - line 3. ######## -# pp_sys.c [pp_stat] -use Config; -BEGIN { - if ($^O eq 'd_lstat') { - print < 43); +plan(tests => 44); my @tempfiles = (); @@ -172,3 +172,11 @@ ok( ! ref $INC{'Toto.pm'}, q/ val Toto.pm isn't a ref in %INC/ ); is( $INC{'Toto.pm'}, 'xyz', ' val Toto.pm is correct in %INC' ); pop @INC; + +my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm'; +{ + local @INC; + @INC = sub { $filename = 'seen'; return undef; }; + eval { require $filename; }; + is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' ); +} diff --git a/t/op/lc.t b/t/op/lc.t index 091df87dee..1fbb3e1afb 100644 --- a/t/op/lc.t +++ b/t/op/lc.t @@ -82,14 +82,31 @@ ok(lc($b) eq "\x{101}\x{101}aa", 'lc'); # \x{149} is LATIN SMALL LETTER N PRECEDED BY APOSTROPHE, its uppercase is # \x{2BC}\x{E4} or MODIFIER LETTER APOSTROPHE and N. -ok("\U\x{DF}ab\x{149}cd" eq "SSAB\x{2BC}NCD", - "multicharacter uppercase"); +# In EBCDIC \x{DF} is LATIN SMALL LETTER Y WITH DIAERESIS, +# and it's uppercase is \x{178}, LATIN CAPITAL LETTER Y WITH DIAERESIS. + +if (ord("A") == 193) { # EBCDIC + ok("\U\x{DF}aB\x{149}cD" eq "\x{178}AB\x{2BC}NCD", + "multicharacter uppercase"); +} elsif (ord("A") == 65) { + ok("\U\x{DF}aB\x{149}cD" eq "SSAB\x{2BC}NCD", + "multicharacter uppercase"); +} else { + ok(0, "what is your encoding?"); +} # The \x{DF} is its own lowercase, ditto for \x{149}. # There are no single character -> multiple characters lowercase mappings. -ok("\L\x{DF}AB\x{149}CD" eq "\x{DF}ab\x{149}cd", - "multicharacter lowercase"); +if (ord("A") == 193) { # EBCDIC + ok("\LaB\x{149}cD" eq "ab\x{149}cd", + "multicharacter lowercase"); +} elsif (ord("A") == 65) { + ok("\L\x{DF}aB\x{149}cD" eq "\x{DF}ab\x{149}cd", + "multicharacter lowercase"); +} else { + ok(0, "what is your encoding?"); +} # titlecase is used for \u / ucfirst. diff --git a/t/op/stat.t b/t/op/stat.t index c3bbe8362d..ad87c25b0b 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -9,7 +9,7 @@ BEGIN { use Config; use File::Spec; -plan tests => 69; +plan tests => 75; my $Perl = which_perl(); @@ -106,6 +106,8 @@ SKIP: { # Check if you are on a tmpfs of some sort. Building in /tmp sometimes # has this problem. Also building on the ClearCase VOBS filesystem may # cause this failure. +# Darwins UFS doesn't have a ctime concept, and thus is +# expected to fail this test. DIAG } } @@ -376,3 +378,36 @@ unlink $tmpfile or print "# unlink failed: $!\n"; # bug id 20011101.069 my @r = \stat("."); is(scalar @r, 13, 'stat returns full 13 elements'); + +SKIP: { + skip "No lstat", 2 unless $Config{d_lstat}; + + stat $0; + eval { lstat _ }; + like( $@, qr/^The stat preceding lstat\(\) wasn't an lstat/, + 'lstat _ croaks after stat' ); + eval { -l _ }; + like( $@, qr/^The stat preceding -l _ wasn't an lstat/, + '-l _ croaks after stat' ); + + eval { lstat STDIN }; + like( $@, qr/^You can't use lstat\(\) on a filehandle/, + 'lstat FILEHANDLE croaks' ); + eval { -l STDIN }; + like( $@, qr/^You can't use -l on a filehandle/, + '-l FILEHANDLE croaks' ); + + # bug id 20020124.004 + # If we have d_lstat, we should have symlink() + my $linkname = 'dolzero'; + symlink $0, $linkname or die "# Can't symlink $0: $!"; + lstat $linkname; + -T _; + eval { lstat _ }; + like( $@, qr/^The stat preceding lstat\(\) wasn't an lstat/, + 'lstat croaks after -T _' ); + eval { -l _ }; + like( $@, qr/^The stat preceding -l _ wasn't an lstat/, + '-l _ croaks after -T _' ); + unlink $linkname or print "# unlink $linkname failed: $!\n"; +} diff --git a/t/run/switches.t b/t/run/switches.t index f920f37ca7..996ad5d4c6 100644 --- a/t/run/switches.t +++ b/t/run/switches.t @@ -9,10 +9,11 @@ BEGIN { require "./test.pl"; -plan(tests => 14); +plan(tests => 19); # due to a bug in VMS's piping which makes it impossible for runperl() -# to emulate echo -n, these tests almost totally fail. +# to emulate echo -n (ie. stdin always winds up with a newline), these +# tests almost totally fail. $TODO = "runperl() unable to emulate echo -n due to pipe bug" if $^O eq 'VMS'; my $r; @@ -169,3 +170,33 @@ SWTESTPM is( $r, '', '-m with import parameters' ); push @tmpfiles, $filename; } + +# Tests for -V + +{ + local $TODO = ''; # these ones should work on VMS + + # basic perl -V should generate significant output. + # we don't test actual format since it could change + like( runperl( switches => ['-V'] ), qr/(\n.*){20}/, + '-V generates 20+ lines' ); + + # lookup a known config var + chomp( $r=runperl( switches => ['-V:osname'] ) ); + is( $r, "osname='$^O';", 'perl -V:osname'); + + # lookup a nonexistent var + chomp( $r=runperl( switches => ['-V:this_var_makes_switches_test_fail'] ) ); + is( $r, "this_var_makes_switches_test_fail='UNKNOWN';", + 'perl -V:unknown var'); + + # regexp lookup + # platforms that don't like this quoting can either skip this test + # or fix test.pl _quote_args + $r = runperl( switches => ['"-V:i\D+size"'] ); + # should be unlike( $r, qr/^$|not found|UNKNOWN/ ); + like( $r, qr/^(?!.*(not found|UNKNOWN))./, 'perl -V:re got a result' ); + + # make sure each line we got matches the re + ok( !( grep !/^i\D+size=/, split /^/, $r ), '-V:re correct' ); +} -- cgit v1.2.1