diff options
Diffstat (limited to 't/lib')
| -rwxr-xr-x | t/lib/anydbm.t | 5 | ||||
| -rwxr-xr-x | t/lib/b.t | 60 | ||||
| -rw-r--r-- | t/lib/charnames.t | 14 | ||||
| -rwxr-xr-x | t/lib/complex.t | 4 | ||||
| -rwxr-xr-x | t/lib/dprof.t | 6 | ||||
| -rwxr-xr-x | t/lib/dumper-ovl.t | 5 | ||||
| -rwxr-xr-x | t/lib/dumper.t | 5 | ||||
| -rwxr-xr-x | t/lib/english.t | 38 | ||||
| -rwxr-xr-x | t/lib/filefind.t | 31 | ||||
| -rwxr-xr-x | t/lib/ftmp-mktemp.t | 26 | ||||
| -rwxr-xr-x | t/lib/ftmp-posix.t | 13 | ||||
| -rwxr-xr-x | t/lib/ftmp-security.t | 45 | ||||
| -rwxr-xr-x | t/lib/ftmp-tempfile.t | 39 | ||||
| -rwxr-xr-x | t/lib/hostname.t | 5 | ||||
| -rwxr-xr-x | t/lib/ipc_sysv.t | 4 | ||||
| -rw-r--r-- | t/lib/peek.t | 2 | ||||
| -rwxr-xr-x | t/lib/selfloader.t | 200 | ||||
| -rw-r--r-- | t/lib/syslfs.t | 30 |
18 files changed, 435 insertions, 97 deletions
diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t index a7fca17811..e304766fc1 100755 --- a/t/lib/anydbm.t +++ b/t/lib/anydbm.t @@ -5,6 +5,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){ + print "1..0 # Skipping (no DB_File or [A-Z]DBM_File)\n"; + exit 0; + } } require AnyDBM_File; use Fcntl; @@ -31,7 +31,15 @@ print "not " if "{\n \$test /= 2 if ++\$test;\n}" ne $deparse->coderef2text(sub {++$test and $test/=2;}); ok; -my $a = `$^X -I../lib -MO=Deparse -anle 1 2>&1`; +my $a; +my $Is_VMS = $^O eq 'VMS'; +if ($Is_VMS) { + $^X = "MCR $^X"; + $a = `$^X "-I../lib" "-MO=Deparse" -anle "1"`; +} +else { + $a = `$^X -I../lib -MO=Deparse -anle 1 2>&1`; +} $a =~ s/-e syntax OK\n//g; $b = <<'EOF'; @@ -49,18 +57,33 @@ print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b; ok; #6 -$a = `$^X -I../lib -MO=Debug -e 1 2>&1`; +if ($Is_VMS) { + $a = `$^X "-I../lib" "-MO=Debug" -e "1"`; +} +else { + $a = `$^X -I../lib -MO=Debug -e 1 2>&1`; +} print "not " unless $a =~ /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s; ok; #7 -$a = `$^X -I../lib -MO=Terse -e 1 2>&1`; +if ($Is_VMS) { + $a = `$^X "-I../lib" "-MO=Terse" -e "1"`; +} +else { + $a = `$^X -I../lib -MO=Terse -e 1 2>&1`; +} print "not " unless $a =~ /\bLISTOP\b.*leave.*\bOP\b.*enter.*\bCOP\b.*nextstate.*\bOP\b.*null/s; ok; -$a = `$^X -I../lib -MO=Terse -ane "s/foo/bar/" 2>&1`; +if ($Is_VMS) { + $a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/"`; +} +else { + $a = `$^X -I../lib -MO=Terse -ane "s/foo/bar/" 2>&1`; +} $a =~ s/\(0x[^)]+\)//g; $a =~ s/\[[^\]]+\]//g; $a =~ s/-e syntax OK//; @@ -80,14 +103,29 @@ $b =~ s/\s+$//; print "# [$a] vs [$b]\nnot " if $a ne $b; ok; -chomp($a = `$^X -I../lib -MB::Stash -Mwarnings -e1`); +if ($Is_VMS) { + chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e "1"`); +} +else { + chomp($a = `$^X -I../lib -MB::Stash -Mwarnings -e1`); +} $a = join ',', sort split /,/, $a; -$a =~ s/-uWin32,//; -$b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,' - . '-umain,-uwarnings'; -print "# [$a] vs [$b]\nnot " if $a ne $b; -ok; +$a =~ s/-uWin32,// if $^O eq 'MSWin32'; +$a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2'; +if ($Config{static_ext} eq ' ') { + $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,' + . '-umain,-uwarnings'; + print "# [$a] vs [$b]\nnot " if $a ne $b; + ok; +} else { + print "ok $test # skipped: one or more static extensions\n"; $test++; +} -$a = `$^X -I../lib -MO=Showlex -e "my %one" 2>&1`; +if ($Is_VMS) { + $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one"`; +} +else { + $a = `$^X -I../lib -MO=Showlex -e "my %one" 2>&1`; +} print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s; ok; diff --git a/t/lib/charnames.t b/t/lib/charnames.t index 566baf35b0..2e6a818677 100644 --- a/t/lib/charnames.t +++ b/t/lib/charnames.t @@ -8,7 +8,7 @@ BEGIN { } $| = 1; -print "1..12\n"; +print "1..13\n"; use charnames ':full'; @@ -78,3 +78,15 @@ sub to_bytes { print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a"; print "ok 12\n"; } + +{ + use charnames qw(:full); + use utf8; + + my $x = "\x{221b}"; + my $named = "\N{CUBE ROOT}"; + + print "not " unless ord($x) == ord($named); + print "ok 13\n"; +} + diff --git a/t/lib/complex.t b/t/lib/complex.t index d4beb8bded..b659142af9 100755 --- a/t/lib/complex.t +++ b/t/lib/complex.t @@ -27,7 +27,7 @@ my @script = ( my $eps = 1e-13; if ($^O eq 'unicos') { # For some reason root() produces very inaccurate - $eps = 1e-11; # results in Cray UNICOS, and occasionally also + $eps = 1e-10; # results in Cray UNICOS, and occasionally also } # cos(), sin(), cosh(), sinh(). The division # of doubles is the current suspect. @@ -262,7 +262,7 @@ EOS $test++; push @script, <<EOS; print "# j = \$j\n"; - print "not " unless "\$j" =~ /^-0\\.5\\+0.86602540\\d+i\$/; + print "not " unless "\$j" =~ /^-0(?:\\.5(?:0000\\d+)?|\\.49999\\d+)\\+0.86602540\\d+i\$/; print "ok $test\n"; \$j->display_format('style' => 'polar', 'polar_pretty_print' => 0); diff --git a/t/lib/dprof.t b/t/lib/dprof.t index 4d6f7823c3..fc5bd050cb 100755 --- a/t/lib/dprof.t +++ b/t/lib/dprof.t @@ -3,6 +3,11 @@ BEGIN { chdir( 't' ) if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bDevel\/DProf\b/){ + print "1..0 # Skip: Devel::DProf was not built\n"; + exit 0; + } } END { @@ -11,7 +16,6 @@ END { use Benchmark qw( timediff timestr ); use Getopt::Std 'getopts'; -use Config '%Config'; getopts('vI:p:'); # -v Verbose diff --git a/t/lib/dumper-ovl.t b/t/lib/dumper-ovl.t index 8c095e59be..b8c8719318 100755 --- a/t/lib/dumper-ovl.t +++ b/t/lib/dumper-ovl.t @@ -3,6 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib' if -d '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { + print "1..0 # Skip: Data::Dumper was not built\n"; + exit 0; + } } use Data::Dumper; diff --git a/t/lib/dumper.t b/t/lib/dumper.t index b9680bd5e6..7b5a611b7d 100755 --- a/t/lib/dumper.t +++ b/t/lib/dumper.t @@ -6,6 +6,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib' if -d '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { + print "1..0 # Skip: Data::Dumper was not built\n"; + exit 0; + } } use Data::Dumper; diff --git a/t/lib/english.t b/t/lib/english.t index dba68dbf94..6438d13176 100755 --- a/t/lib/english.t +++ b/t/lib/english.t @@ -1,9 +1,9 @@ #!./perl -print "1..16\n"; +print "1..22\n"; BEGIN { unshift @INC, '../lib' } -use English; +use English qw( -no_match_vars ) ; use Config; my $threads = $Config{'use5005threads'} || 0; @@ -17,13 +17,11 @@ sub foo { } &foo(1); -if ($threads) { - $_ = "ok 4\nok 5\nok 6\n"; -} else { - $ARG = "ok 4\nok 5\nok 6\n"; -} -/ok 5\n/; -print $PREMATCH, $MATCH, $POSTMATCH; +"abc" =~ /b/; + +print ! $PREMATCH ? "" : "not ", "ok 4\n" ; +print ! $MATCH ? "" : "not ", "ok 5\n" ; +print ! $POSTMATCH ? "" : "not ", "ok 6\n" ; $OFS = " "; $ORS = "\n"; @@ -43,5 +41,25 @@ print $GID == $( ? "ok 12\n" : "not ok 12\n"; print $EUID == $> ? "ok 13\n" : "not ok 13\n"; print $EGID == $) ? "ok 14\n" : "not ok 14\n"; -print $PROGRAM_NAME == $0 ? "ok 15\n" : "not ok 15\n"; +print $PROGRAM_NAME eq $0 ? "ok 15\n" : "not ok 15\n"; print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n"; + +package B ; + +use English ; + +"abc" =~ /b/; + +print $PREMATCH ? "" : "not ", "ok 17\n" ; +print $MATCH ? "" : "not ", "ok 18\n" ; +print $POSTMATCH ? "" : "not ", "ok 19\n" ; + +package C ; + +use English qw( -no_match_vars ) ; + +"abc" =~ /b/; + +print ! $PREMATCH ? "" : "not ", "ok 20\n" ; +print ! $MATCH ? "" : "not ", "ok 21\n" ; +print ! $POSTMATCH ? "" : "not ", "ok 22\n" ; diff --git a/t/lib/filefind.t b/t/lib/filefind.t index e9a2916738..ca12e742ce 100755 --- a/t/lib/filefind.t +++ b/t/lib/filefind.t @@ -19,6 +19,7 @@ finddepth(sub { print "ok 2\n" if $_ eq 'filefind.t'; }, "."); my $case = 2; +my $FastFileTests_OK = 0; END { unlink 'fa/fa_ord','fa/fsl','fa/faa/faa_ord', @@ -57,8 +58,15 @@ sub wanted { print "# '$_' => 1\n"; s#\.$## if ($^O eq 'VMS' && $_ ne '.'); Check( $Expect{$_} ); - delete $Expect{$_}; + if ( $FastFileTests_OK ) { + delete $Expect{$_} + unless ( $Expect_Dir{$_} && ! -d _ ); + } else { + delete $Expect{$_} + unless ( $Expect_Dir{$_} && ! -d $_ ); + } $File::Find::prune=1 if $_ eq 'faba'; + } sub dn_wanted { @@ -106,6 +114,9 @@ touch('fa/fab/faba/faba_ord'); %Expect = ('.' => 1, 'fsl' => 1, 'fa_ord' => 1, 'fab' => 1, 'fab_ord' => 1, 'faba' => 1, 'faa' => 1, 'faa_ord' => 1); delete $Expect{'fsl'} unless $symlink_exists; +%Expect_Dir = ('fa' => 1, 'faa' => 1, 'fab' => 1, 'faba' => 1, + 'fb' => 1, 'fba' => 1); +delete @Expect_Dir{'fb','fba'} unless $symlink_exists; File::Find::find( {wanted => \&wanted, },'fa' ); Check( scalar(keys %Expect) == 0 ); @@ -113,6 +124,9 @@ Check( scalar(keys %Expect) == 0 ); 'fa/fab/fab_ord' => 1, 'fa/fab/faba' => 1, 'fa/fab/faba/faba_ord' => 1, 'fa/faa' => 1, 'fa/faa/faa_ord' => 1); delete $Expect{'fa/fsl'} unless $symlink_exists; +%Expect_Dir = ('fa' => 1, 'fa/faa' => 1, '/fa/fab' => 1, 'fa/fab/faba' => 1, + 'fb' => 1, 'fb/fba' => 1); +delete @Expect_Dir{'fb','fb/fba'} unless $symlink_exists; File::Find::find( {wanted => \&wanted, no_chdir => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); @@ -122,6 +136,9 @@ Check( scalar(keys %Expect) == 0 ); './fa/fab/faba/faba_ord' => 1, './fa/faa' => 1, './fa/faa/faa_ord' => 1, './fb' => 1, './fb/fba' => 1, './fb/fba/fba_ord' => 1, './fb/fb_ord' => 1); delete $Expect{'./fa/fsl'} unless $symlink_exists; +%Expect_Dir = ('./fa' => 1, './fa/faa' => 1, '/fa/fab' => 1, './fa/fab/faba' => 1, + './fb' => 1, './fb/fba' => 1); +delete @Expect_Dir{'./fb','./fb/fba'} unless $symlink_exists; File::Find::finddepth( {wanted => \&dn_wanted },'.' ); Check( scalar(keys %Expect) == 0 ); @@ -130,13 +147,19 @@ Check( scalar(keys %Expect) == 0 ); './fa/fab/faba/faba_ord' => 1, './fa/faa' => 1, './fa/faa/faa_ord' => 1, './fb' => 1, './fb/fba' => 1, './fb/fba/fba_ord' => 1, './fb/fb_ord' => 1); delete $Expect{'./fa/fsl'} unless $symlink_exists; +%Expect_Dir = ('./fa' => 1, './fa/faa' => 1, '/fa/fab' => 1, './fa/fab/faba' => 1, + './fb' => 1, './fb/fba' => 1); +delete @Expect_Dir{'./fb','./fb/fba'} unless $symlink_exists; File::Find::finddepth( {wanted => \&d_wanted, no_chdir => 1 },'.' ); Check( scalar(keys %Expect) == 0 ); if ( $symlink_exists ) { + $FastFileTests_OK= 1; %Expect=('.' => 1, 'fa_ord' => 1, 'fsl' => 1, 'fb_ord' => 1, 'fba' => 1, 'fba_ord' => 1, 'fab' => 1, 'fab_ord' => 1, 'faba' => 1, 'faa' => 1, 'faa_ord' => 1); + %Expect_Dir = ('fa' => 1, 'fa/faa' => 1, '/fa/fab' => 1, 'fa/fab/faba' => 1, + 'fb' => 1, 'fb/fba' => 1); File::Find::find( {wanted => \&wanted, follow_fast => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); @@ -145,6 +168,8 @@ if ( $symlink_exists ) { 'fa/fsl/fba' => 1, 'fa/fsl/fba/fba_ord' => 1, 'fa/fab' => 1, 'fa/fab/fab_ord' => 1, 'fa/fab/faba' => 1, 'fa/fab/faba/faba_ord' => 1, 'fa/faa' => 1, 'fa/faa/faa_ord' => 1); + %Expect_Dir = ('fa' => 1, 'fa/faa' => 1, '/fa/fab' => 1, 'fa/fab/faba' => 1, + 'fb' => 1, 'fb/fba' => 1); File::Find::find( {wanted => \&wanted, follow_fast => 1, no_chdir => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); @@ -152,6 +177,8 @@ if ( $symlink_exists ) { 'fa/fsl/fba' => 1, 'fa/fsl/fba/fba_ord' => 1, 'fa/fab' => 1, 'fa/fab/fab_ord' => 1, 'fa/fab/faba' => 1, 'fa/fab/faba/faba_ord' => 1, 'fa/faa' => 1, 'fa/faa/faa_ord' => 1); + %Expect_Dir = ('fa' => 1, 'fa/faa' => 1, '/fa/fab' => 1, 'fa/fab/faba' => 1, + 'fb' => 1, 'fb/fba' => 1); File::Find::finddepth( {wanted => \&dn_wanted, follow_fast => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); @@ -160,6 +187,8 @@ if ( $symlink_exists ) { 'fa/fsl/fba' => 1, 'fa/fsl/fba/fba_ord' => 1, 'fa/fab' => 1, 'fa/fab/fab_ord' => 1, 'fa/fab/faba' => 1, 'fa/fab/faba/faba_ord' => 1, 'fa/faa' => 1, 'fa/faa/faa_ord' => 1); + %Expect_Dir = ('fa' => 1, 'fa/faa' => 1, '/fa/fab' => 1, 'fa/fab/faba' => 1, + 'fb' => 1, 'fb/fba' => 1); File::Find::finddepth( {wanted => \&d_wanted, follow_fast => 1, no_chdir => 1},'fa' ); Check( scalar(keys %Expect) == 0 ); diff --git a/t/lib/ftmp-mktemp.t b/t/lib/ftmp-mktemp.t index c660475709..35ab59cbb3 100755 --- a/t/lib/ftmp-mktemp.t +++ b/t/lib/ftmp-mktemp.t @@ -1,16 +1,16 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; -} +#!/usr/bin/perl -w # Test for mktemp family of commands in File::Temp # Use STANDARD safe level for these tests +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; + require Test; import Test; + plan(tests => 9); +} + use strict; -use Test; -BEGIN { plan tests => 9 } use File::Spec; use File::Path; @@ -50,6 +50,7 @@ ok($string, $line); # stat(filehandle) does not always equal the size of the stat(filename) # This must be due to caching. In particular this test writes 7 bytes # to the file which are not recognised by stat(filename) +# Simply waiting 3 seconds seems to be enough for the system to update if ($^O eq 'MSWin32') { sleep 3; @@ -69,8 +70,15 @@ print "# MKSTEMPS: File is $template -> $fname fileno=".fileno($fh)."\n"; # Check if the file exists ok( (-e $fname) ); -ok( unlink0($fh, $fname) ); +# This fails if you are running on NFS +# If this test fails simply skip it rather than doing a hard failure +my $status = unlink0($fh, $fname); +if ($status) { + ok($status); +} else { + skip("Skip test failed probably due to NFS",1) +} # MKDTEMP # Temp directory diff --git a/t/lib/ftmp-posix.t b/t/lib/ftmp-posix.t index f28785e87a..6802374b10 100755 --- a/t/lib/ftmp-posix.t +++ b/t/lib/ftmp-posix.t @@ -1,15 +1,14 @@ -#!./perl +#!/usr/bin/perl -w +# Test for File::Temp - POSIX functions BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + require Test; import Test; + plan(tests => 7); } -# Test for File::Temp - POSIX functions - use strict; -use Test; -BEGIN { plan tests => 7} use File::Temp qw/ :POSIX unlink0 /; ok(1); diff --git a/t/lib/ftmp-security.t b/t/lib/ftmp-security.t index 50e177958a..5f30f9651f 100755 --- a/t/lib/ftmp-security.t +++ b/t/lib/ftmp-security.t @@ -1,26 +1,31 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; -} - +#!/usr/bin/perl -w # Test for File::Temp - Security levels # Some of the security checking will not work on all platforms # Test a simple open in the cwd and tmpdir foreach of the # security levels -use strict; -use Test; -BEGIN { plan tests => 13} +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; + require Test; import Test; + plan(tests => 13); +} +use strict; use File::Spec; + +# Set up END block - this needs to happen before we load +# File::Temp since this END block must be evaluated after the +# END block configured by File::Temp +my @files; # list of files to remove +END { foreach (@files) { ok( !(-e $_) )} } + use File::Temp qw/ tempfile unlink0 /; ok(1); # The high security tests must currently be skipped on Windows -my $skipplat = ( $^O eq 'MSWin32' ? 1 : 0 ); +my $skipplat = ( ($^O eq 'MSWin32' || $^O eq 'os2') ? 1 : 0 ); # Can not run high security tests in perls before 5.6.0 my $skipperl = ($] < 5.006 ? 1 : 0 ); @@ -77,27 +82,17 @@ sub test_security { # of tests -- we dont use skip since the tempfile() commands will # fail with MEDIUM/HIGH security before the skip() command would be run if ($skip) { - + skip($skip,1); skip($skip,1); - + # plus we need an end block so the tests come out in the right order eval q{ END { skip($skip,1); skip($skip,1) } 1; } || die; - + return; } - - # End blocks are evaluated in reverse order - # If I want to check that the file was unlinked by the autmoatic - # feature of the module I have to set up the end block before - # creating the file. - # Use quoted end block to retain access to lexicals - my @files; - - eval q{ END { foreach (@files) { ok( !(-e $_) )} } 1; } || die; - - + # Create the tempfile my $template = "temptestXXXXXXXX"; my ($fh1, $fname1) = tempfile ( $template, DIR => File::Spec->curdir, diff --git a/t/lib/ftmp-tempfile.t b/t/lib/ftmp-tempfile.t index 9c0de8b955..3cb73c20e0 100755 --- a/t/lib/ftmp-tempfile.t +++ b/t/lib/ftmp-tempfile.t @@ -1,30 +1,35 @@ -#!./perl +#!/usr/bin/perl -w +# Test for File::Temp - tempfile function BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + require Test; import Test; + plan(tests => 11); } -# Test for File::Temp - tempfile function - use strict; -use Test; -BEGIN { plan tests => 10} use File::Spec; -use File::Temp qw/ tempfile tempdir/; # Will need to check that all files were unlinked correctly -# Set up an END block here to do it (since the END blocks -# set up by File::Temp will be evaluated in reverse order we -# set ours up first.... +# Set up an END block here to do it + +my (@files, @dirs); # Array containing list of dirs/files to test # Loop over an array hoping that the files dont exist -my @files; -eval q{ END { foreach (@files) { ok( !(-e $_) )} } 1; } || die; +END { foreach (@files) { ok( !(-e $_) )} } # And a test for directories -my @dirs; -eval q{ END { foreach (@dirs) { ok( !(-d $_) )} } 1; } || die; +END { foreach (@dirs) { ok( !(-d $_) )} } + +# Need to make sure that the END blocks are setup before +# the ones that File::Temp configures since END blocks are evaluated +# in revers order and we need to check the files *after* File::Temp +# removes them +use File::Temp qw/ tempfile tempdir/; + +# Now we start the tests properly +ok(1); # Tempfile @@ -88,5 +93,5 @@ print "# TEMPFILE: Created $tempfile\n"; ok( (-f $tempfile) ); push(@files, $tempfile); -# no tests yet to make sure that the END{} blocks correctly remove -# the files +# Now END block will execute to test the removal of directories + diff --git a/t/lib/hostname.t b/t/lib/hostname.t index 6f61fb9dad..8a34e9c4e7 100755 --- a/t/lib/hostname.t +++ b/t/lib/hostname.t @@ -3,6 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bSys\/Hostname\b/) { + print "1..0 # Skip: Sys::Hostname was not built\n"; + exit 0; + } } use Sys::Hostname; diff --git a/t/lib/ipc_sysv.t b/t/lib/ipc_sysv.t index a4f3e3f367..d2991e3eac 100755 --- a/t/lib/ipc_sysv.t +++ b/t/lib/ipc_sysv.t @@ -9,7 +9,9 @@ BEGIN { my $reason; - if ($Config{'d_sem'} ne 'define') { + if ($Config{'extensions'} !~ /\bIPC\/SysV\b/) { + $reason = 'IPC::SysV was not built'; + } elsif ($Config{'d_sem'} ne 'define') { $reason = '$Config{d_sem} undefined'; } elsif ($Config{'d_msg'} ne 'define') { $reason = '$Config{d_msg} undefined'; diff --git a/t/lib/peek.t b/t/lib/peek.t index 255512fac5..86fd74a3df 100644 --- a/t/lib/peek.t +++ b/t/lib/peek.t @@ -285,8 +285,6 @@ do_test(17, MG_VIRTUAL = &PL_vtbl_glob MG_TYPE = \'\\*\' MG_OBJ = $ADDR - MG_LEN = 1 - MG_PTR = $ADDR "a" NAME = "a" NAMELEN = 1 GvSTASH = $ADDR\\t"main" diff --git a/t/lib/selfloader.t b/t/lib/selfloader.t new file mode 100755 index 0000000000..75d6561f9b --- /dev/null +++ b/t/lib/selfloader.t @@ -0,0 +1,200 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + $dir = "self-$$"; + unshift @INC, ("./$dir", "../lib"); + + print "1..19\n"; + + # First we must set up some selfloader files + mkdir $dir, 0755 or die "Can't mkdir $dir: $!"; + + open(FOO, ">$dir/Foo.pm") or die; + print FOO <<'EOT'; +package Foo; +use SelfLoader; + +sub new { bless {}, shift } +sub foo; +sub bar; +sub bazmarkhianish; +sub a; +sub never; # declared but definition should never be read +1; +__DATA__ + +sub foo { shift; shift || "foo" }; + +sub bar { shift; shift || "bar" } + +sub bazmarkhianish { shift; shift || "baz" } + +package sheep; +sub bleat { shift; shift || "baa" } + +__END__ +sub never { die "D'oh" } +EOT + + close(FOO); + + open(BAR, ">$dir/Bar.pm") or die; + print BAR <<'EOT'; +package Bar; +use SelfLoader; + +@ISA = 'Baz'; + +sub new { bless {}, shift } +sub a; + +1; +__DATA__ + +sub a { 'a Bar'; } +sub b { 'b Bar' } + +__END__ DATA +sub never { die "D'oh" } +EOT + + close(BAR); +}; + + +package Baz; + +sub a { 'a Baz' } +sub b { 'b Baz' } +sub c { 'c Baz' } + + +package main; +use Foo; +use Bar; + +$foo = new Foo; + +print "not " unless $foo->foo eq 'foo'; # selfloaded first time +print "ok 1\n"; + +print "not " unless $foo->foo eq 'foo'; # regular call +print "ok 2\n"; + +# Try an undefined method +eval { + $foo->will_fail; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 3\n"; +} else { + print "not ok 3 $@\n"; +} + +# Used to be trouble with this +eval { + my $foo = new Foo; + die "oops"; +}; +if ($@ =~ /oops/) { + print "ok 4\n"; +} else { + print "not ok 4 $@\n"; +} + +# Pass regular expression variable to autoloaded function. This used +# to go wrong in AutoLoader because it used regular expressions to generate +# autoloaded filename. +"foo" =~ /(\w+)/; +print "not " unless $1 eq 'foo'; +print "ok 5\n"; + +print "not " unless $foo->bar($1) eq 'foo'; +print "ok 6\n"; + +print "not " unless $foo->bar($1) eq 'foo'; +print "ok 7\n"; + +print "not " unless $foo->bazmarkhianish($1) eq 'foo'; +print "ok 8\n"; + +print "not " unless $foo->bazmarkhianish($1) eq 'foo'; +print "ok 9\n"; + +# Check nested packages inside __DATA__ +print "not " unless sheep::bleat() eq 'baa'; +print "ok 10\n"; + +# Now check inheritance: + +$bar = new Bar; + +# Before anything is SelfLoaded there is no declaration of Foo::b so we should +# get Baz::b +print "not " unless $bar->b() eq 'b Baz'; +print "ok 11\n"; + +# There is no Bar::c so we should get Baz::c +print "not " unless $bar->c() eq 'c Baz'; +print "ok 12\n"; + +# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side +# effect +print "not " unless $bar->a() eq 'a Bar'; +print "ok 13\n"; + +print "not " unless $bar->b() eq 'b Bar'; +print "ok 14\n"; + +print "not " unless $bar->c() eq 'c Baz'; +print "ok 15\n"; + + + +# Check that __END__ is honoured +# Try an subroutine that should never be noticed by selfloader +eval { + $foo->never; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 16\n"; +} else { + print "not ok 16 $@\n"; +} + +# Try to read from the data file handle +my $foodata = <Foo::DATA>; +close Foo::DATA; +if (defined $foodata) { + print "not ok 17 # $foodata\n"; +} else { + print "ok 17\n"; +} + +# Check that __END__ DATA is honoured +# Try an subroutine that should never be noticed by selfloader +eval { + $bar->never; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 18\n"; +} else { + print "not ok 18 $@\n"; +} + +# Try to read from the data file handle +my $bardata = <Bar::DATA>; +close Bar::DATA; +if ($bardata ne "sub never { die \"D'oh\" }\n") { + print "not ok 19 # $bardata\n"; +} else { + print "ok 19\n"; +} + +# cleanup +END { +return unless $dir && -d $dir; +unlink "$dir/Foo.pm", "$dir/Bar.pm"; +rmdir "$dir"; +} diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t index 2857120942..3cfe3022da 100644 --- a/t/lib/syslfs.t +++ b/t/lib/syslfs.t @@ -8,7 +8,7 @@ BEGIN { require Config; import Config; # Don't bother if there are no quad offsets. if ($Config{lseeksize} < 8) { - print "1..0\n# no 64-bit file offsets\n"; + print "1..0 # Skip: no 64-bit file offsets\n"; exit(0); } require Fcntl; import Fcntl qw(/^O_/ /^SEEK_/); @@ -47,14 +47,14 @@ print "# checking whether we have sparse files...\n"; # Known have-nots. if ($^O eq 'win32' || $^O eq 'vms') { - print "1..0\n# no sparse files (because this is $^O) \n"; + print "1..0 # Skip: no sparse files (because this is $^O) \n"; bye(); } # Known haves that have problems running this test # (for example because they do not support sparse files, like UNICOS) if ($^O eq 'unicos') { - print "1..0\n# large files known to work but unable to test them here ($^O)\n"; + print "1..0 # Skip: large files known to work but unable to test them here ($^O)\n"; bye(); } @@ -95,7 +95,7 @@ zap(); unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 && $s1[11] == $s2[11] && $s1[12] == $s2[12]) { - print "1..0\n#no sparse files?\n"; + print "1..0 # Skip: no sparse files?\n"; bye; } @@ -103,15 +103,25 @@ print "# we seem to have sparse files...\n"; # By now we better be sure that we do have sparse files: # if we are not, the following will hog 5 gigabytes of disk. Ooops. +# This may fail by producing some signal; run in a subprocess first for safety $ENV{LC_ALL} = "C"; +my $r = system '../perl', '-I../lib', '-e', <<'EOF'; +use Fcntl qw(/^O_/ /^SEEK_/); +sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or die $!; +my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET); +my $syswrite = syswrite(BIG, "big"); +exit 0; +EOF + sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or do { warn "sysopen 'big' failed: $!\n"; bye }; my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET); -unless (defined $sysseek && $sysseek == 5_000_000_000) { - print "1..0\n# seeking past 2GB failed: $! (sysseek returned ", - defined $sysseek ? $sysseek : 'undef', ")\n"; +unless (! $r && defined $sysseek && $sysseek == 5_000_000_000) { + $sysseek = 'undef' unless defined $sysseek; + print "1..0 # Skip: seeking past 2GB failed: ", + $r ? 'signal '.($r & 0x7f) : "$! (sysseek returned $sysseek)", "\n"; explain(); bye(); } @@ -125,9 +135,9 @@ my $close = close BIG; print "# close failed: $!\n" unless $close; unless($syswrite && $close) { if ($! =~/too large/i) { - print "1..0\n# writing past 2GB failed: process limits?\n"; + print "1..0 # Skip: writing past 2GB failed: process limits?\n"; } elsif ($! =~ /quota/i) { - print "1..0\n# filesystem quota limits?\n"; + print "1..0 # Skip: filesystem quota limits?\n"; } explain(); bye(); @@ -138,7 +148,7 @@ unless($syswrite && $close) { print "# @s\n"; unless ($s[7] == 5_000_000_003) { - print "1..0\n# not configured to use large files?\n"; + print "1..0 # Skip: not configured to use large files?\n"; explain(); bye(); } |