diff options
-rw-r--r-- | Changes | 136 | ||||
-rw-r--r-- | doop.c | 8 | ||||
-rw-r--r-- | ext/B/B/Deparse.pm | 23 | ||||
-rw-r--r-- | lib/Test/Harness.pm | 33 | ||||
-rw-r--r-- | pp.c | 17 | ||||
-rwxr-xr-x | t/comp/cpp.t | 2 | ||||
-rwxr-xr-x | t/io/pipe.t | 2 | ||||
-rwxr-xr-x | t/lib/db-btree.t | 2 | ||||
-rwxr-xr-x | t/lib/db-hash.t | 2 | ||||
-rwxr-xr-x | t/lib/db-recno.t | 2 | ||||
-rwxr-xr-x | t/lib/gdbm.t | 2 | ||||
-rw-r--r-- | t/lib/io_multihomed.t | 18 | ||||
-rwxr-xr-x | t/lib/io_pipe.t | 14 | ||||
-rwxr-xr-x | t/lib/io_sock.t | 18 | ||||
-rwxr-xr-x | t/lib/io_udp.t | 24 | ||||
-rw-r--r-- | t/lib/io_unix.t | 24 | ||||
-rwxr-xr-x | t/lib/ipc_sysv.t | 14 | ||||
-rwxr-xr-x | t/lib/ndbm.t | 2 | ||||
-rwxr-xr-x | t/lib/odbm.t | 2 | ||||
-rwxr-xr-x | t/lib/thread.t | 2 | ||||
-rwxr-xr-x | t/op/exec.t | 5 | ||||
-rwxr-xr-x | t/op/fork.t | 2 | ||||
-rwxr-xr-x | t/op/grent.t | 20 | ||||
-rwxr-xr-x | t/op/groups.t | 2 | ||||
-rwxr-xr-x | t/op/list.t | 12 | ||||
-rwxr-xr-x | t/op/nothread.t | 2 | ||||
-rwxr-xr-x | t/op/numconvert.t | 10 | ||||
-rwxr-xr-x | t/op/pwent.t | 19 | ||||
-rw-r--r-- | t/pragma/warn/sv | 2 | ||||
-rw-r--r-- | win32/win32.c | 13 |
30 files changed, 321 insertions, 113 deletions
@@ -79,6 +79,142 @@ Version 5.005_57 Development release working toward 5.006 ---------------- ____________________________________________________________________________ +[ 3403] By: gsar on 1999/05/12 10:49:01 + Log: From: Stephen Zander <gibreel@pobox.com> + Date: 12 May 1999 01:22:31 -0700 + Message-ID: <87u2tik88o.fsf@pooh.fire-swamp.net> + Subject: Re: Test::Harness runs tainted tests with wrong library path + Branch: perl + ! lib/Test/Harness.pm +____________________________________________________________________________ +[ 3402] By: gsar on 1999/05/12 10:42:06 + Log: typo in change#3400 + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 3401] By: jhi on 1999/05/12 10:40:42 + Log: A better, shinier, and possibly even correctly working + reincarnation of #3398. + Branch: cfgperl + ! Configure config_h.SH +____________________________________________________________________________ +[ 3400] By: gsar on 1999/05/12 10:40:11 + Log: deparse \&func() as \(&func()) for clarity + From: Albert Dvornik <bert@genscan.com> + Date: 11 May 1999 13:32:04 -0400 + Message-ID: <tqk8ufwm0b.fsf@puma.genscan.com> + Subject: [PATCH 5.005_56] Deparse and \&func() (was Re: File::Find...) + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 3399] By: gsar on 1999/05/12 10:36:02 + Log: more testsuite smarts (many of them courtesy Ilya) + Branch: perl + ! lib/Test/Harness.pm t/comp/cpp.t t/io/pipe.t t/lib/db-btree.t + ! t/lib/db-hash.t t/lib/db-recno.t t/lib/gdbm.t + ! t/lib/io_multihomed.t t/lib/io_pipe.t t/lib/io_sock.t + ! t/lib/io_udp.t t/lib/io_unix.t t/lib/ipc_sysv.t t/lib/ndbm.t + ! t/lib/odbm.t t/lib/thread.t t/op/exec.t t/op/fork.t + ! t/op/grent.t t/op/groups.t t/op/nothread.t t/op/numconvert.t + ! t/op/pwent.t +____________________________________________________________________________ +[ 3398] By: jhi on 1999/05/12 09:33:08 + Log: Detect whether fflush(NULL) works as per change #3352. + Branch: cfgperl + ! Configure config_h.SH perl.h +____________________________________________________________________________ +[ 3397] By: gsar on 1999/05/12 08:56:03 + Log: From: jan.dubois@ibm.net (Jan Dubois) + Date: Wed, 12 May 1999 01:01:00 +0200 + Message-ID: <3741b5e8.20386944@smtp1.ibm.net> + Subject: [PATCH 5.005_03] chop/chomp modify readonly values + Branch: perl + ! doop.c +____________________________________________________________________________ +[ 3396] By: gsar on 1999/05/12 08:23:27 + Log: opendir(D,"x:") on win32 opens cwd() for drive rather than root; + stat() behaves similarly + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 3395] By: jhi on 1999/05/11 22:21:32 + Log: Redo parts of #3341 and #3358 that #3394 undid. + Branch: cfgperl + ! Configure config_h.SH +____________________________________________________________________________ +[ 3394] By: jhi on 1999/05/11 22:03:48 + Log: Add I_NETINET_TCP to help change #3391. + Branch: cfgperl + ! Configure config_h.SH ext/Socket/Socket.xs +____________________________________________________________________________ +[ 3393] By: jhi on 1999/05/11 21:44:59 + Log: Integrate from mainperl. + Branch: cfgperl + !> (integrate 55 files) +____________________________________________________________________________ +[ 3392] By: gsar on 1999/05/11 20:56:43 + Log: update embedvar.h + Branch: perl + ! embedvar.h ext/ByteLoader/ByteLoader.pm pod/perldelta.pod +____________________________________________________________________________ +[ 3391] By: gsar on 1999/05/11 16:32:05 + Log: From: Joshua Pritikin <joshua.pritikin@db.com> + Date: Tue, 11 May 1999 11:10:13 -0400 (EDT) + Message-ID: <Pine.GSO.4.02.9905111106460.1418-100000@eq1062.wks.na.deuba.com> + Subject: Socket IPPROTO_TCP [PATCH 5.005_5x] + Branch: perl + ! ext/Socket/Socket.pm ext/Socket/Socket.xs +____________________________________________________________________________ +[ 3390] By: gsar on 1999/05/11 15:27:40 + Log: display more frequent progress messages when STDOUT is a tty + Branch: perl + ! lib/Test/Harness.pm +____________________________________________________________________________ +[ 3389] By: gsar on 1999/05/11 14:40:58 + Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Date: Mon, 10 May 1999 02:07:01 -0400 (EDT) + Message-Id: <199905100607.CAA26045@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_53] Explanations by Test::Harness + Branch: perl + ! lib/Test/Harness.pm +____________________________________________________________________________ +[ 3388] By: gsar on 1999/05/11 14:08:14 + Log: avoid creating spurious subroutine stubs on failed subroutine + call and other places of sv_2cv() misuse; fixes problems with + failed subroutine calls "hiding" later attempts to lookup methods + in base classes + Branch: perl + ! gv.c perl.c pod/perlguts.pod pp_hot.c sv.c t/op/method.t +____________________________________________________________________________ +[ 3387] By: gsar on 1999/05/11 09:34:13 + Log: various fixes for clean build and test on win32; configpm broken, + needed to open myconfig.SH rather than myconfig; sundry adjustments + to bytecode stuff; tweaks to DYNAMIC_ENV_FETCH code to make it + work under win32; getenv_sv() changed to getenv_len() since SVs + aren't visible in the lower echelons; remove bogus exports from + config.sym; PERL_OBJECT-ness for C++ exception support; null out + IoDIRP in filter_del() or sv_free() will attempt to close it + Branch: perl + ! Changes bytecode.pl byterun.c byterun.h configpm embed.h + ! embed.pl ext/B/B/Asmdata.pm ext/ByteLoader/ByteLoader.xs + ! ext/DynaLoader/dlutils.c global.sym hv.c iperlsys.h objXSUB.h + ! op.c perl.c perl.h pp.c pp_ctl.c proto.h scope.c scope.h + ! t/io/open.t t/op/magic.t toke.c util.c vms/vms.c vms/vmsish.h + ! win32/GenCAPI.pl win32/Makefile win32/config.bc + ! win32/config.gc win32/config.vc win32/makedef.pl + ! win32/makefile.mk win32/perlhost.h win32/runperl.c + ! win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 3386] By: gsar on 1999/05/11 02:49:07 + Log: gutsupport for C++ exceptions + From: Chip Salzenberg <chip@perlsupport.com> + Date: Tue, 9 Mar 1999 11:51:57 -0500 + Message-ID: <19990309115157.E7911@perlsupport.com> + Subject: [PATCH 5.005] Flexible Exceptions + Branch: perl + ! embed.h global.sym objXSUB.h perl.c perl.h pp_ctl.c proto.h + ! scope.c scope.h thrdvar.h util.c +____________________________________________________________________________ [ 3385] By: gsar on 1999/05/10 19:33:36 Log: "weak" references internals, still needs perlguts documentation (somewhat modified version of patch suggested by Tuomas J. Lukka @@ -779,7 +779,7 @@ do_chop(register SV *astr, register SV *sv) } return; } - if (SvTYPE(sv) == SVt_PVHV) { + else if (SvTYPE(sv) == SVt_PVHV) { HV* hv = (HV*)sv; HE* entry; (void)hv_iterinit(hv); @@ -788,6 +788,8 @@ do_chop(register SV *astr, register SV *sv) do_chop(astr,hv_iterval(hv,entry)); return; } + else if (SvREADONLY(sv)) + croak(PL_no_modify); s = SvPV(sv, len); if (len && !SvPOK(sv)) s = SvPV_force(sv, len); @@ -846,7 +848,7 @@ do_chomp(register SV *sv) } return count; } - if (SvTYPE(sv) == SVt_PVHV) { + else if (SvTYPE(sv) == SVt_PVHV) { HV* hv = (HV*)sv; HE* entry; (void)hv_iterinit(hv); @@ -855,6 +857,8 @@ do_chomp(register SV *sv) count += do_chomp(hv_iterval(hv,entry)); return count; } + else if (SvREADONLY(sv)) + croak(PL_no_modify); s = SvPV(sv, len); if (len && !SvPOKp(sv)) s = SvPV_force(sv, len); diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 3abb39a0d1..e00bd22a89 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -962,13 +962,22 @@ sub pp_refgen { $kid->sibling->ppaddr eq "pp_anoncode") { return "sub " . $self->deparse_sub($self->padval($kid->sibling->targ)); - } elsif ($kid->ppaddr eq "pp_pushmark" - and $kid->sibling->ppaddr =~ /^pp_(pad|rv2)[ah]v$/ - and not $kid->sibling->flags & OPf_REF) { - # The @a in \(@a) isn't in ref context, but only when the - # parens are there. - return "\\(" . $self->deparse($kid->sibling, 1) . ")"; - } + } elsif ($kid->ppaddr eq "pp_pushmark") { + my $sib_ppaddr = $kid->sibling->ppaddr; + if ($sib_ppaddr =~ /^pp_(pad|rv2)[ah]v$/ + and not $kid->sibling->flags & OPf_REF) + { + # The @a in \(@a) isn't in ref context, but only when the + # parens are there. + return "\\(" . $self->deparse($kid->sibling, 1) . ")"; + } elsif ($sib_ppaddr eq 'pp_entersub') { + my $text = $self->deparse($kid->sibling, 1); + # Always show parens for \(&func()), but only with -p otherwise + $text = "($text)" if $self->{'parens'} + or $kid->sibling->private & OPpENTERSUB_AMPER; + return "\\$text"; + } + } } $self->pfixop($op, $cx, "\\", 20); } diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 866551328c..662ec7ff33 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -74,15 +74,17 @@ sub runtests { $te = $test; chop($te); if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./; } + my $blank = (' ' x 77); my $leader = "$te" . '.' x (20 - length($te)); my $ml = ""; - $ml = "\r$leader" if -t STDOUT and not $ENV{HARNESS_NOTTY}; + $ml = "\r$blank\r$leader" if -t STDOUT and not $ENV{HARNESS_NOTTY}; print $leader; my $fh = new FileHandle; $fh->open($test) or print "can't open $test. $!\n"; my $first = <$fh>; my $s = $switches; - $s .= q[ "-T"] if $first =~ /^#!.*\bperl.*-\w*T/; + $s .= join " ", q[ "-T"], map {qq["-I$_"]} @INC + if $first =~ /^#!.*\bperl.*-\w*T/; $fh->close or print "can't close $test. $!\n"; my $cmd = ($ENV{'COMPILE_TEST'})? "./perl -I../lib ../utils/perlcc $test -run 2>> ./compilelog |" @@ -105,16 +107,17 @@ sub runtests { $totmax += $max; $files++; $next = 1; - } elsif (/^1\.\.([0-9]+)/) { + } elsif (/^1\.\.([0-9]+)(\s*\#\s*[Ss]kip\S*(?>\s+)(.+))?/) { $max = $1; $totmax += $max; $files++; $next = 1; + $skip_reason = $3 if not $max and defined $3; } elsif ($max && /^(not\s+)?ok\b/) { my $this = $next; if (/^not ok\s*(\d*)/){ $this = $1 if $1 > 0; - print "${ml}NOK $this \n" if $ml; + print "${ml}NOK $this\n" if $ml; if (!$todo{$this}) { push @failed, $this; } else { @@ -123,7 +126,7 @@ sub runtests { } } elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip\S*(?:(?>\s+)(.+))?)?/) { $this = $1 if $1 > 0; - print "${ml}ok $this " if $ml; + print "${ml}ok $this/$max" if $ml; $ok++; $totok++; $skipped++ if defined $2; @@ -191,16 +194,18 @@ sub runtests { } elsif ($ok == $max && $next == $max+1) { if ($max and $skipped + $bonus) { my @msg; - push(@msg, "$skipped/$max subtest".($skipped>1?'s':'')." skipped: $skip_reason") + push(@msg, "$skipped/$max skipped: $skip_reason") if $skipped; - push(@msg, "$bonus subtest".($bonus>1?'s':''). - " unexpectedly succeeded") + push(@msg, "$bonus/$max unexpectedly succeeded") if $bonus; - print "${ml}ok, ".join(', ', @msg)." \n"; + print "${ml}ok, ".join(', ', @msg)."\n"; } elsif ($max) { - print "${ml}ok \n"; + print "${ml}ok\n"; + } elsif (defined $skip_reason) { + print "skipped: $skip_reason\n"; + $tests_skipped++; } else { - print "skipping test on this platform\n"; + print "skipped test on this platform\n"; $tests_skipped++; } $good++; @@ -429,6 +434,12 @@ variations in spacing and case) after C<ok> or C<ok NUMBER>, it is counted as a skipped test. If the whole testscript succeeds, the count of skipped tests is included in the generated output. +C<Test::Harness> reports the text after C< # Skip(whatever)> as a +reason for skipping. Similarly, one can include a similar explanation +in a C<1..0> line emitted if the test is skipped completely: + + 1..0 # Skipped: no leverage found + =head1 EXPORT C<&runtests> is exported by Test::Harness per default. @@ -2827,20 +2827,17 @@ PP(pp_lslice) for (lelem = firstlelem; lelem <= lastlelem; lelem++) { ix = SvIVx(*lelem); - if (ix < 0) { + if (ix < 0) ix += max; - if (ix < 0) - *lelem = &PL_sv_undef; - else if (!(*lelem = firstrelem[ix])) - *lelem = &PL_sv_undef; - } - else { + else ix -= arybase; - if (ix >= max || !(*lelem = firstrelem[ix])) + if (ix < 0 || ix >= max) + *lelem = &PL_sv_undef; + else { + is_something_there = TRUE; + if (!(*lelem = firstrelem[ix])) *lelem = &PL_sv_undef; } - if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem))) - is_something_there = TRUE; } if (is_something_there) SP = lastlelem; diff --git a/t/comp/cpp.t b/t/comp/cpp.t index f6450a5f75..bbff38c553 100755 --- a/t/comp/cpp.t +++ b/t/comp/cpp.t @@ -11,7 +11,7 @@ use Config; if ( $^O eq 'MSWin32' or ($Config{'cppstdin'} =~ /\bcppstdin\b/) and ( ! -x $Config{'binexp'} . "/cppstdin") ) { - print "1..0\n"; + print "1..0 # Skip: \$Config{cppstdin} unavailable\n"; exit; # Cannot test till after install, alas. } diff --git a/t/io/pipe.t b/t/io/pipe.t index 9f12ed8c73..1c72440478 100755 --- a/t/io/pipe.t +++ b/t/io/pipe.t @@ -7,7 +7,7 @@ BEGIN { unshift @INC, '../lib'; require Config; import Config; unless ($Config{'d_fork'}) { - print "1..0\n"; + print "1..0 # Skip: no fork\n"; exit 0; } } diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t index 7f982d6fd6..2729048593 100755 --- a/t/lib/db-btree.t +++ b/t/lib/db-btree.t @@ -4,7 +4,7 @@ BEGIN { unshift @INC, '../lib' if -d '../lib' ; require Config; import Config; if ($Config{'extensions'} !~ /\bDB_File\b/) { - print "1..0\n"; + print "1..0 # Skip: DB_File was not built\n"; exit 0; } } diff --git a/t/lib/db-hash.t b/t/lib/db-hash.t index 21f2aadada..ecf3886e08 100755 --- a/t/lib/db-hash.t +++ b/t/lib/db-hash.t @@ -4,7 +4,7 @@ BEGIN { unshift @INC, '../lib' if -d '../lib' ; require Config; import Config; if ($Config{'extensions'} !~ /\bDB_File\b/) { - print "1..0\n"; + print "1..0 # Skip: DB_File was not built\n"; exit 0; } } diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t index cb223b1bc8..ce333134bf 100755 --- a/t/lib/db-recno.t +++ b/t/lib/db-recno.t @@ -4,7 +4,7 @@ BEGIN { unshift @INC, '../lib' if -d '../lib' ; require Config; import Config; if ($Config{'extensions'} !~ /\bDB_File\b/) { - print "1..0\n"; + print "1..0 # Skip: DB_File was not built\n"; exit 0; } } diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t index d8c0ed29c3..dc4e96e4d8 100755 --- a/t/lib/gdbm.t +++ b/t/lib/gdbm.t @@ -6,7 +6,7 @@ BEGIN { unshift @INC, '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bGDBM_File\b/) { - print "1..0\n"; + print "1..0 # Skip: GDBM_File was not built\n"; exit 0; } } diff --git a/t/lib/io_multihomed.t b/t/lib/io_multihomed.t index de15b3e42e..8dc46e96b4 100644 --- a/t/lib/io_multihomed.t +++ b/t/lib/io_multihomed.t @@ -11,11 +11,19 @@ use Config; BEGIN { if(-d "lib" && -f "TEST") { - if (!$Config{'d_fork'} || - (($Config{'extensions'} !~ /\bSocket\b/ || - $Config{'extensions'} !~ /\bIO\b/) && - !(($^O eq 'VMS') && $Config{d_socket}))) { - print "1..0\n"; + my $reason; + if (! $Config{'d_fork'}) { + $reason = 'no fork'; + } + elsif ($Config{'extensions'} !~ /\bSocket\b/) { + $reason = 'Socket extension unavailable'; + } + elsif ($Config{'extensions'} !~ /\bIO\b/) { + $reason = 'IO extension unavailable'; + } + undef $reason if $^O eq 'VMS' and $Config{d_socket}; + if ($reason) { + print "1..0 # Skip: $reason\n"; exit 0; } } diff --git a/t/lib/io_pipe.t b/t/lib/io_pipe.t index 0c1a498226..bcb89a0daf 100755 --- a/t/lib/io_pipe.t +++ b/t/lib/io_pipe.t @@ -11,10 +11,16 @@ use Config; BEGIN { if(-d "lib" && -f "TEST") { - if (! $Config{'d_fork'} || - ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS')) - { - print "1..0\n"; + my $reason; + if (! $Config{'d_fork'}) { + $reason = 'no fork'; + } + elsif ($Config{'extensions'} !~ /\bIO\b/) { + $reason = 'IO extension unavailable'; + } + undef $reason if $^O eq 'VMS'; + if ($reason) { + print "1..0 # Skip: $reason\n"; exit 0; } } diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t index 0e002be339..e236f5f399 100755 --- a/t/lib/io_sock.t +++ b/t/lib/io_sock.t @@ -11,11 +11,19 @@ use Config; BEGIN { if (-d "lib" && -f "TEST") { - if (!$Config{'d_fork'} || - (($Config{'extensions'} !~ /\bSocket\b/ || - $Config{'extensions'} !~ /\bIO\b/) && - !(($^O eq 'VMS') && $Config{d_socket}))) { - print "1..0\n"; + my $reason; + if (! $Config{'d_fork'}) { + $reason = 'no fork'; + } + elsif ($Config{'extensions'} !~ /\bSocket\b/) { + $reason = 'Socket extension unavailable'; + } + elsif ($Config{'extensions'} !~ /\bIO\b/) { + $reason = 'IO extension unavailable'; + } + undef $reason if $^O eq 'VMS' and $Config{d_socket}; + if ($reason) { + print "1..0 # Skip: $reason\n"; exit 0; } } diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t index 435533f6c4..02112a27e3 100755 --- a/t/lib/io_udp.t +++ b/t/lib/io_udp.t @@ -11,13 +11,25 @@ use Config; BEGIN { if(-d "lib" && -f "TEST") { - if ( ($Config{'extensions'} !~ /\bSocket\b/ || - $Config{'extensions'} !~ /\bIO\b/ || - ($^O eq 'os2') || $^O eq 'apollo') && - !(($^O eq 'VMS') && $Config{d_socket})) { - print "1..0\n"; + my $reason; + + if ($Config{'extensions'} !~ /\bSocket\b/) { + $reason = 'Socket was not built'; + } + elsif ($Config{'extensions'} !~ /\bIO\b/) { + $reason = 'IO was not built'; + } + elsif ($^O eq 'os2') { + $reason = "blocks on OS/2, not debugged yet"; + } + elsif ($^O eq 'apollo') { + $reason = "unknown *FIXME*"; + } + undef $reason if $^O eq 'VMS' and $Config{d_socket}; + if ($reason) { + print "1..0 # Skip: $reason\n"; exit 0; - } + } } } diff --git a/t/lib/io_unix.t b/t/lib/io_unix.t index 30e7c0e4e5..7a4556d215 100644 --- a/t/lib/io_unix.t +++ b/t/lib/io_unix.t @@ -10,17 +10,21 @@ BEGIN { use Config; BEGIN { - if (!$Config{d_fork}) { - print "1..0\n"; - exit 0; - } - if(-d "lib" && -f "TEST") { - if ( ($Config{'extensions'} !~ /\bSocket\b/ || - $Config{'extensions'} !~ /\bIO\b/) && - !(($^O eq 'VMS') && $Config{d_socket})) { - print "1..0\n"; - exit 0; + my $reason; + if (! $Config{'d_fork'}) { + $reason = 'no fork'; + } + elsif ($Config{'extensions'} !~ /\bSocket\b/) { + $reason = 'Socket extension unavailable'; + } + elsif ($Config{'extensions'} !~ /\bIO\b/) { + $reason = 'IO extension unavailable'; + } + undef $reason if $^O eq 'VMS' and $Config{d_socket}; + if ($reason) { + print "1..0 # Skip: $reason\n"; + exit 0; } } } diff --git a/t/lib/ipc_sysv.t b/t/lib/ipc_sysv.t index 42b8458e8b..00a157ba54 100755 --- a/t/lib/ipc_sysv.t +++ b/t/lib/ipc_sysv.t @@ -7,10 +7,16 @@ BEGIN { require Config; import Config; - unless ($Config{'d_msg'} eq 'define' && - $Config{'d_sem'} eq 'define') { - print "1..0\n"; - exit; + my $reason; + + if ($Config{'d_sem'} ne 'define') { + $reason = '$Config{d_sem} undefined'; + } elsif ($Config{'d_msg'} ne 'define') { + $reason = '$Config{d_msg} undefined'; + } + if ($reason) { + print "1..0 # Skip: $reason\n"; + exit 0; } } diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t index de42c0d990..39c3f400a0 100755 --- a/t/lib/ndbm.t +++ b/t/lib/ndbm.t @@ -7,7 +7,7 @@ BEGIN { unshift @INC, '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bNDBM_File\b/) { - print "1..0\n"; + print "1..0 # Skip: NDBM_File was not built\n"; exit 0; } } diff --git a/t/lib/odbm.t b/t/lib/odbm.t index 0ef2592c93..fc15d13ebf 100755 --- a/t/lib/odbm.t +++ b/t/lib/odbm.t @@ -7,7 +7,7 @@ BEGIN { unshift @INC, '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bODBM_File\b/) { - print "1..0\n"; + print "1..0 # Skip: ODBM_File was not built\n"; exit 0; } } diff --git a/t/lib/thread.t b/t/lib/thread.t index 5cc2eaf886..3bca8ba726 100755 --- a/t/lib/thread.t +++ b/t/lib/thread.t @@ -5,7 +5,7 @@ BEGIN { unshift @INC, '../lib'; require Config; import Config; if (! $Config{'usethreads'}) { - print "1..0\n"; + print "1..0 # Skip: this perl is not threaded\n"; exit 0; } diff --git a/t/op/exec.t b/t/op/exec.t index 098a455455..5cf7386c93 100755 --- a/t/op/exec.t +++ b/t/op/exec.t @@ -1,13 +1,10 @@ #!./perl -# $RCSfile: exec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:49 $ - $| = 1; # flush stdout if ($^O eq 'MSWin32') { - print "# exec is unsupported on Win32\n"; # XXX the system tests could be written to use ./perl and so work on Win32 - print "1..0\n"; + print "1..0 # Skip: shh, win32\n"; exit(0); } diff --git a/t/op/fork.t b/t/op/fork.t index 516aa735fe..20c87472b2 100755 --- a/t/op/fork.t +++ b/t/op/fork.t @@ -7,7 +7,7 @@ BEGIN { unshift @INC, '../lib'; require Config; import Config; unless ($Config{'d_fork'}) { - print "1..0\n"; + print "1..0 # Skip: no fork\n"; exit 0; } } diff --git a/t/op/grent.t b/t/op/grent.t index abe6b5add0..9b06f11a3e 100755 --- a/t/op/grent.t +++ b/t/op/grent.t @@ -4,12 +4,12 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, "../lib" if -d "../lib"; eval { require Config; import Config; }; - - unless (defined $Config{'i_grp'} && - $Config{'i_grp'} eq 'define' && - -f "/etc/group" ) { # Play safe. - print "1..0\n"; - exit 0; + my $reason; + if ($Config{'i_grp'} ne 'define') { + $reason = '$Config{i_grp} not defined'; + } + elsif (not -f "/etc/group" ) { # Play safe. + $reason = 'no /etc/group file'; } if (not defined $where) { # Try NIS. @@ -18,6 +18,7 @@ BEGIN { open(GR, "$ypcat group 2>/dev/null |") && defined(<GR>)) { $where = "NIS group"; + undef $reason; last; } } @@ -29,6 +30,7 @@ BEGIN { open(GR, "$nidump group . 2>/dev/null |") && defined(<GR>)) { $where = "NetInfo group"; + undef $reason; last; } } @@ -37,12 +39,12 @@ BEGIN { if (not defined $where) { # Try local. my $GR = "/etc/group"; if (-f $GR && open(GR, $GR) && defined(<GR>)) { + undef $reason; $where = $GR; } } - - if (not defined $where) { # Give up. - print "1..0\n"; + if ($reason) { + print "1..0 # Skip: $reason\n"; exit 0; } } diff --git a/t/op/groups.t b/t/op/groups.t index 5778795a0e..d22d8f07ad 100755 --- a/t/op/groups.t +++ b/t/op/groups.t @@ -6,7 +6,7 @@ $ENV{LC_ALL} = "C"; # so that external utilities speak English $ENV{LANGUAGE} = 'C'; # GNU locale extension sub quit { - print "1..0\n"; + print "1..0 # Skip: no `id` or `groups`\n"; exit 0; } diff --git a/t/op/list.t b/t/op/list.t index a4230b681b..4d7a2d5444 100755 --- a/t/op/list.t +++ b/t/op/list.t @@ -1,8 +1,6 @@ #!./perl -# $RCSfile: list.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:02 $ - -print "1..27\n"; +print "1..28\n"; @foo = (1, 2, 3, 4); if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";} @@ -81,3 +79,11 @@ for ($x = 0; $x < 3; $x++) { print $a,$b,$c; } +# slices +{ + my @a = (0, undef, undef, 3); + my @b = @a[1,2]; + my @c = (0, undef, undef, 3)[1, 2]; + print "not " unless @b == @c and @c == 2; + print "ok 28\n"; +} diff --git a/t/op/nothread.t b/t/op/nothread.t index cee8e2dbe1..a434956cb0 100755 --- a/t/op/nothread.t +++ b/t/op/nothread.t @@ -11,7 +11,7 @@ BEGIN import Config; if ($Config{'usethreads'}) { - print "1..0\n"; + print "1..0 # Skip: this perl is threaded\n"; exit 0; } } diff --git a/t/op/numconvert.t b/t/op/numconvert.t index 405f721d20..f71fd6c141 100755 --- a/t/op/numconvert.t +++ b/t/op/numconvert.t @@ -42,15 +42,7 @@ BEGIN { use strict 'vars'; -my $max_chain = $ENV{PERL_TEST_NUMCONVERTS}; -unless (defined $max_chain) { - my $is_debug; - eval <<'EOE'; - use Config; - $is_debug = 1 if $Config{ccflags} =~ /-DDEBUGGING\b/; -EOE - $max_chain = $is_debug ? 3 : 2; -} +my $max_chain = $ENV{PERL_TEST_NUMCONVERTS} || 2; # Bulk out if unsigned type is hopelessly wrong: my $max_uv1 = ~0; diff --git a/t/op/pwent.t b/t/op/pwent.t index cd5db34cf5..feee6f2b90 100755 --- a/t/op/pwent.t +++ b/t/op/pwent.t @@ -4,12 +4,12 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, "../lib" if -d "../lib"; eval { require Config; import Config; }; - - unless (defined $Config{'i_pwd'} && - $Config{'i_pwd'} eq 'define' && - -f "/etc/passwd" ) { # Play safe. - print "1..0\n"; - exit 0; + my $reason; + if ($Config{'i_pwd'} ne 'define') { + $reason = '$Config{i_pwd} undefined'; + } + elsif (not -f "/etc/passwd" ) { # Play safe. + $reason = 'no /etc/passwd file'; } if (not defined $where) { # Try NIS. @@ -18,6 +18,7 @@ BEGIN { open(PW, "$ypcat passwd 2>/dev/null |") && defined(<PW>)) { $where = "NIS passwd"; + undef $reason; last; } } @@ -29,6 +30,7 @@ BEGIN { open(PW, "$nidump passwd . 2>/dev/null |") && defined(<PW>)) { $where = "NetInfo passwd"; + undef $reason; last; } } @@ -38,11 +40,12 @@ BEGIN { my $PW = "/etc/passwd"; if (-f $PW && open(PW, $PW) && defined(<PW>)) { $where = $PW; + undef $reason; } } - if (not defined $where) { # Give up. - print "1..0\n"; + if ($reason) { # Give up. + print "1..0 # Skip: $reason\n"; exit 0; } } diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv index f453de96d3..f3c530f884 100644 --- a/t/pragma/warn/sv +++ b/t/pragma/warn/sv @@ -115,7 +115,7 @@ Use of uninitialized value at - line 3. use warning 'uninitialized' ; $x = chop undef ; # g EXPECT -Use of uninitialized value at - line 3. +Modification of a read-only value attempted at - line 3. ######## # sv.c use warning 'uninitialized' ; diff --git a/win32/win32.c b/win32/win32.c index 4988e31648..ec04823b15 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -682,8 +682,15 @@ win32_opendir(char *filename) /* Create the search pattern */ strcpy(scanname, filename); - if (scanname[len-1] != '/' && scanname[len-1] != '\\') + + /* bare drive name means look in cwd for drive */ + if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') { + scanname[len++] = '.'; + scanname[len++] = '/'; + } + else if (scanname[len-1] != '/' && scanname[len-1] != '\\') { scanname[len++] = '/'; + } scanname[len++] = '*'; scanname[len] = '\0'; @@ -929,10 +936,10 @@ win32_stat(const char *path, struct stat *buffer) t[l] = '\0'; path = t; break; - /* FindFirstFile() is buggy with "x:", so add a slash :-( */ + /* FindFirstFile() is buggy with "x:", so add a dot :-( */ case ':': if (l == 2 && isALPHA(path[0])) { - t[0] = path[0]; t[1] = ':'; t[2] = '/'; t[3] = '\0'; + t[0] = path[0]; t[1] = ':'; t[2] = '.'; t[3] = '\0'; l = 3; path = t; } |