Change 16257 by jhi@alpha on 2002/04/28 20:26:30
Integrate #16254 from macperl;
Fix most tests on MacOS (not yet ext/ or /lib)
Affected files ...
.... //depot/perl/lib/Pod/Find.pm#12 integrate
.... //depot/perl/t/comp/cpp.t#14 integrate
.... //depot/perl/t/io/dup.t#14 integrate
.... //depot/perl/t/io/fs.t#49 integrate
.... //depot/perl/t/io/inplace.t#10 integrate
.... //depot/perl/t/io/iprefix.t#4 integrate
.... //depot/perl/t/io/open.t#30 integrate
.... //depot/perl/t/io/openpid.t#11 integrate
.... //depot/perl/t/japh/abigail.t#8 integrate
.... //depot/perl/t/lib/1_compile.t#63 integrate
.... //depot/perl/t/lib/compmod.pl#3 integrate
.... //depot/perl/t/op/chdir.t#12 integrate
.... //depot/perl/t/op/exec.t#20 integrate
.... //depot/perl/t/op/magic.t#48 integrate
.... //depot/perl/t/op/read.t#6 integrate
.... //depot/perl/t/op/readdir.t#16 integrate
.... //depot/perl/t/op/runlevel.t#24 integrate
.... //depot/perl/t/op/srand.t#5 integrate
.... //depot/perl/t/op/stat.t#67 integrate
.... //depot/perl/t/op/study.t#13 integrate
.... //depot/perl/t/op/subst_wamp.t#3 integrate
.... //depot/perl/t/op/taint.t#47 integrate
.... //depot/perl/t/op/write.t#24 integrate
.... //depot/perl/t/pod/testp2pt.pl#11 integrate
.... //depot/perl/t/run/exit.t#7 integrate
.... //depot/perl/t/run/fresh_perl.t#8 integrate
.... //depot/perl/t/run/switchPx.t#5 integrate
.... //depot/perl/t/run/switcht.t#3 integrate
.... //depot/perl/t/run/switchx.t#2 integrate
.... //depot/perl/t/test.pl#44 integrate
Differences ...
==== //depot/perl/lib/Pod/Find.pm#12 (text) ====
Index: perl/lib/Pod/Find.pm
--- perl/lib/Pod/Find.pm.~1~ Sun Apr 28 14:30:05 2002
+++ perl/lib/Pod/Find.pm Sun Apr 28 14:30:05 2002
@@ -128,12 +128,29 @@
if($opts{-script}) {
require Config;
- push(@search, $Config::Config{scriptdir});
+ push(@search, $Config::Config{scriptdir})
+ if -d $Config::Config{scriptdir};
$opts{-perl} = 1;
}
if($opts{-inc}) {
- push(@search, grep($_ ne '.',@INC));
+ if ($^O eq 'MacOS') {
+ # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
+ my @new_INC = @INC;
+ for (@new_INC) {
+ if ( $_ eq '.' ) {
+ $_ = ':';
+ } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
+ $_ = ':'. $_;
+ } else {
+ $_ =~ s|^\./|:|;
+ }
+ }
+ push(@search, grep($_ ne File::Spec->curdir, @new_INC));
+ } else {
+ push(@search, grep($_ ne File::Spec->curdir, @INC));
+ }
+
$opts{-perl} = 1;
}
@@ -144,9 +161,18 @@
# * remove e.g. "i586-linux" (from 'archname')
# * remove e.g. 5.00503
# * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
- $SIMPLIFY_RX =
-
qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
+
+ # Mac OS:
+ # * remove ":?site_perl:"
+ # * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod)
+ if ($^O eq 'MacOS') {
+ $SIMPLIFY_RX =
+ qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!;
+ } else {
+ $SIMPLIFY_RX =
+
+qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
+ }
}
my %dirs_visited;
@@ -171,7 +197,7 @@
}
next;
}
- my $root_rx = qq!^\Q$try\E/!;
+ my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!;
File::Find::find( sub {
my $item = $File::Find::name;
if(-d) {
@@ -232,10 +258,19 @@
$name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX);
}
else {
- $name =~ s:^.*/::s;
+ if ($^O eq 'MacOS') {
+ $name =~ s/^.*://s;
+ } else {
+ $name =~ s:^.*/::s;
+ }
}
_simplify($name);
$name =~ s!/+!::!g; #/
+ if ($^O eq 'MacOS') {
+ $name =~ s!:+!::!g; # : -> ::
+ } else {
+ $name =~ s!/+!::!g; # / -> ::
+ }
$name;
}
@@ -252,7 +287,11 @@
sub simplify_name {
my ($str) = @_;
# remove all path components
- $str =~ s:^.*/::s;
+ if ($^O eq 'MacOS') {
+ $str =~ s/^.*://s;
+ } else {
+ $str =~ s:^.*/::s;
+ }
_simplify($str);
$str;
}
@@ -320,7 +359,7 @@
my %options = (
'-inc' => 0,
'-verbose' => 0,
- '-dirs' => [ '.' ],
+ '-dirs' => [ File::Spec->curdir ],
);
# Check for an options hash as first argument
@@ -348,7 +387,22 @@
require Config;
# Add @INC
- push (@search_dirs, @INC) if $options{'-inc'};
+ if ($^O eq 'MacOS' && $options{'-inc'}) {
+ # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
+ my @new_INC = @INC;
+ for (@new_INC) {
+ if ( $_ eq '.' ) {
+ $_ = ':';
+ } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
+ $_ = ':'. $_;
+ } else {
+ $_ =~ s|^\./|:|;
+ }
+ }
+ push (@search_dirs, @new_INC);
+ } elsif ($options{'-inc'}) {
+ push (@search_dirs, @INC);
+ }
# Add location of pod documentation for perl man pages (eg perlfunc)
# This is a pod directory in the private install tree
@@ -365,7 +419,7 @@
# Loop over directories
Dir: foreach my $dir ( @search_dirs ) {
- # Don't bother if cant find the directory
+ # Don't bother if can't find the directory
if (-d $dir) {
warn "Looking in directory $dir\n"
if $options{'-verbose'};
==== //depot/perl/t/comp/cpp.t#14 (xtext) ====
Index: perl/t/comp/cpp.t
--- perl/t/comp/cpp.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/comp/cpp.t Sun Apr 28 14:30:05 2002
@@ -9,7 +9,8 @@
}
use Config;
-if ( ($Config{'cppstdin'} =~ /\bcppstdin\b/) &&
+if ( $^O eq 'MacOS' ||
+ ($Config{'cppstdin'} =~ /\bcppstdin\b/) &&
! -x $Config{'binexp'} . "/cppstdin" ) {
print "1..0 # Skip: \$Config{cppstdin} unavailable\n";
exit; # Cannot test till after install, alas.
==== //depot/perl/t/io/dup.t#14 (xtext) ====
Index: perl/t/io/dup.t
--- perl/t/io/dup.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/io/dup.t Sun Apr 28 14:30:05 2002
@@ -22,12 +22,13 @@
print STDERR "ok 3\n";
# Since some systems don't have echo, we use Perl.
-$echo = qq{$^X -le "print q{ok %d}"};
+$echo = qq{$^X -le "print q(ok %d)"};
-$cmd = sprintf $echo, 4;
+$cmd = sprintf $echo, 4;
print `$cmd`;
-$cmd = sprintf "$echo 1>&2", 5;
+$cmd = sprintf "$echo 1>&2", 5;
+$cmd = sprintf $echo, 5 if $^O eq 'MacOS'; # don't know if we can do this ...
print `$cmd`;
# KNOWN BUG system() does not honor STDOUT redirections on VMS.
@@ -37,7 +38,12 @@
}
else {
system sprintf $echo, 6;
- system sprintf "$echo 1>&2", 7;
+ if ($^O eq 'MacOS') {
+ system sprintf $echo, 7;
+ }
+ else {
+ system sprintf "$echo 1>&2", 7;
+ }
}
close(STDOUT) or die "Could not close: $!";
@@ -47,7 +53,8 @@
open(STDERR,">&DUPERR") or die "Could not open: $!";
if (($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'VMS')) { print `type Io.dup`
}
-else { system 'cat Io.dup' }
+elsif ($^O eq 'MacOS') { system 'catenate Io.dup' }
+else { system 'cat Io.dup' }
unlink 'Io.dup';
print STDOUT "ok 8\n";
==== //depot/perl/t/io/fs.t#49 (xtext) ====
Index: perl/t/io/fs.t
--- perl/t/io/fs.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/io/fs.t Sun Apr 28 14:30:05 2002
@@ -7,7 +7,9 @@
}
use Config;
+use File::Spec::Functions;
+my $Is_MacOS = ($^O eq 'MacOS');
my $Is_VMSish = ($^O eq 'VMS');
if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
@@ -24,7 +26,8 @@
!($^O eq 'MSWin32' || $^O eq 'NetWare' ||
$^O eq 'dos' || $^O eq 'os2' ||
$^O eq 'mint' || $^O eq 'cygwin' ||
- $^O eq 'amigaos' || $wd =~ m#$Config{afsroot}/#
+ $^O eq 'amigaos' || $wd =~ m#$Config{afsroot}/# ||
+ $Is_MacOS
);
if (defined &Win32::IsWinNT && Win32::IsWinNT()) {
@@ -50,23 +53,27 @@
if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
`rmdir /s /q tmp 2>nul`;
`mkdir tmp`;
-} elsif ($^O eq 'VMS') {
+}
+elsif ($^O eq 'VMS') {
`if f\$search("[.tmp]*.*") .nes. "" then delete/nolog/noconfirm [.tmp]*.*.*`;
`if f\$search("tmp.dir") .nes. "" then delete/nolog/noconfirm tmp.dir;`;
`create/directory [.tmp]`;
}
+elsif ($Is_MacOS) {
+ rmdir "tmp"; mkdir "tmp";
+}
else {
`rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`;
}
-chdir './tmp';
+chdir catdir(curdir(), 'tmp');
`/bin/rm -rf a b c x` if -x '/bin/rm';
umask(022);
SKIP: {
- skip "bogus umask", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq
'epoc');
+ skip "bogus umask", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq
+'epoc') || $Is_MacOS;
is((umask(0)&0777), 022, 'umask'),
}
==== //depot/perl/t/io/inplace.t#10 (xtext) ====
Index: perl/t/io/inplace.t
--- perl/t/io/inplace.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/io/inplace.t Sun Apr 28 14:30:05 2002
@@ -19,6 +19,12 @@
`perl -le "print 'foo'" > .b`;
`perl -le "print 'foo'" > .c`;
}
+elsif ($^O eq 'MacOS') {
+ $CAT = "$^X -e \"print<>\"";
+ `$^X -le "print 'foo'" > .a`;
+ `$^X -le "print 'foo'" > .b`;
+ `$^X -le "print 'foo'" > .c`;
+}
elsif ($^O eq 'VMS') {
$CAT = 'MCR []perl. -e "print<>"';
`MCR []perl. -le "print 'foo'" > ./.a`;
==== //depot/perl/t/io/iprefix.t#4 (xtext) ====
Index: perl/t/io/iprefix.t
--- perl/t/io/iprefix.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/io/iprefix.t Sun Apr 28 14:30:05 2002
@@ -25,6 +25,12 @@
`MCR []perl. -le "print 'foo'" > ./.b`;
`MCR []perl. -le "print 'foo'" > ./.c`;
}
+elsif ($^O eq 'MacOS') {
+ $CAT = "$^X -e \"print<>\"";
+ `$^X -le "print 'foo'" > .a`;
+ `$^X -le "print 'foo'" > .b`;
+ `$^X -le "print 'foo'" > .c`;
+}
else {
$CAT = 'cat';
`echo foo | tee .a .b .c`;
==== //depot/perl/t/io/open.t#30 (xtext) ====
Index: perl/t/io/open.t
--- perl/t/io/open.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/io/open.t Sun Apr 28 14:30:05 2002
@@ -10,6 +10,7 @@
use warnings;
use Config;
$Is_VMS = $^O eq 'VMS';
+$Is_MacOS = $^O eq 'MacOS';
plan tests => 94;
@@ -79,7 +80,7 @@
skip "open -| busted and noisy on VMS", 3 if $Is_VMS;
ok( open(my $f, '-|', <<EOC), 'open -|' );
- $Perl -e "print qq(a row\n); print qq(another row\n)"
+ $Perl -e "print qq(a row\\n); print qq(another row\\n)"
EOC
my @rows = <$f>;
@@ -87,7 +88,9 @@
ok( close($f), ' close' );
}
-{
+SKIP: {
+ skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS;
+
ok( open(my $f, '|-', <<EOC), 'open |-' );
$Perl -pe "s/^not //"
EOC
@@ -172,7 +175,7 @@
skip "open -| busted and noisy on VMS", 3 if $Is_VMS;
ok( open(local $f, '-|', <<EOC), 'open local $f, "-|", ...' );
- $Perl -e "print qq(a row\n); print qq(another row\n)"
+ $Perl -e "print qq(a row\\n); print qq(another row\\n)"
EOC
my @rows = <$f>;
@@ -180,7 +183,9 @@
ok( close($f), ' close' );
}
-{
+SKIP: {
+ skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS;
+
ok( open(local $f, '|-', <<EOC), 'open local $f, "|-", ...' );
$Perl -pe "s/^not //"
EOC
==== //depot/perl/t/io/openpid.t#11 (xtext) ====
Index: perl/t/io/openpid.t
--- perl/t/io/openpid.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/io/openpid.t Sun Apr 28 14:30:05 2002
@@ -13,7 +13,7 @@
require './test.pl';
}
-if ($^O eq 'dos') {
+if ($^O eq 'dos' || $^O eq 'MacOS') {
skip_all("no multitasking");
}
==== //depot/perl/t/japh/abigail.t#8 (text) ====
Index: perl/t/japh/abigail.t
--- perl/t/japh/abigail.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/japh/abigail.t Sun Apr 28 14:30:05 2002
@@ -34,6 +34,8 @@
undef &skip;
}
+skip_all "Unhappy on MacOS" if $^O eq 'MacOS';
+
#
# ./test.pl does real evilness by jumping to a label.
# This function copies the skip from ./test, omitting the goto.
@@ -140,7 +142,7 @@
{
my $datafile = "datatmp000";
1 while -f ++ $datafile;
- END {unlink_all $datafile}
+ END {unlink_all $datafile if $datafile}
open MY_DATA, "> $datafile" or die "Failed to open $datafile: $!";
print MY_DATA << " --";
@@ -220,7 +222,7 @@
{
my $progfile = "progtmp000";
1 while -f ++ $progfile;
- END {unlink_all $progfile}
+ END {unlink_all $progfile if $progfile}
my @programs = (<< ' --', << ' --');
#!./perl
==== //depot/perl/t/lib/1_compile.t#63 (text) ====
Index: perl/t/lib/1_compile.t
--- perl/t/lib/1_compile.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/lib/1_compile.t Sun Apr 28 14:30:05 2002
@@ -11,6 +11,7 @@
use strict;
use warnings;
+use File::Spec::Functions;
# Okay, this is the list.
@@ -49,7 +50,10 @@
sub compile_module {
my ($module) = $_[0];
- my $out = scalar `$^X "-I../lib" lib/compmod.pl $module`;
+ my $compmod = catfile(curdir(), 'lib', 'compmod.pl');
+ my $lib = '-I' . catdir(updir(), 'lib');
+
+ my $out = scalar `$^X $lib $compmod $module`;
print "# $out";
return $out =~ /^ok/;
}
==== //depot/perl/t/lib/compmod.pl#3 (text) ====
Index: perl/t/lib/compmod.pl
--- perl/t/lib/compmod.pl.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/lib/compmod.pl Sun Apr 28 14:30:05 2002
@@ -1,8 +1,8 @@
#!./perl
BEGIN {
- chdir '..' if -d '../pod' && -d '../t';
- @INC = 'lib';
+ chdir 't';
+ @INC = '../lib';
}
my $module = shift;
==== //depot/perl/t/op/chdir.t#12 (text) ====
Index: perl/t/op/chdir.t
--- perl/t/op/chdir.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/chdir.t Sun Apr 28 14:30:05 2002
@@ -11,7 +11,8 @@
require "test.pl";
plan(tests => 31);
-my $IsVMS = $^O eq 'VMS';
+my $IsVMS = $^O eq 'VMS';
+my $IsMacOS = $^O eq 'MacOS';
# Might be a little early in the testing process to start using these,
# but I can't think of a way to write this test without them.
@@ -44,7 +45,7 @@
my($key) = @_;
# Make sure $ENV{'SYS$LOGIN'} is only honored on VMS.
- if( $key eq 'SYS$LOGIN' && !$IsVMS ) {
+ if( $key eq 'SYS$LOGIN' && !$IsVMS && !$IsMacOS ) {
ok( !chdir(), "chdir() on $^O ignores only \$ENV{$key} set" );
is( abs_path, $Cwd, ' abs_path() did not change' );
pass( " no need to test SYS\$LOGIN on $^O" ) for 1..7;
@@ -92,8 +93,10 @@
next if $IsVMS && $env eq 'SYS$LOGIN';
next if $IsVMS && $env eq 'HOME' && !$Config{'d_setenv'};
- # On VMS, %ENV is many layered.
- delete $ENV{$env} while exists $ENV{$env};
+ unless ($IsMacOS) { # ENV on MacOS is "special" :-)
+ # On VMS, %ENV is many layered.
+ delete $ENV{$env} while exists $ENV{$env};
+ }
}
# The following means we won't really be testing for non-existence,
@@ -122,7 +125,7 @@
{
clean_env;
- if ($IsVMS && !$Config{'d_setenv'}) {
+ if (($IsVMS || $IsMacOS) && !$Config{'d_setenv'}) {
pass("Can't reset HOME, so chdir() test meaningless");
} else {
ok( !chdir(), 'chdir() w/o any ENV set' );
==== //depot/perl/t/op/exec.t#20 (xtext) ====
Index: perl/t/op/exec.t
--- perl/t/op/exec.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/exec.t Sun Apr 28 14:30:05 2002
@@ -17,6 +17,8 @@
my $Is_VMS = $^O eq 'VMS';
my $Is_Win32 = $^O eq 'MSWin32';
+skip_all("Tests mostly usesless on MacOS") if $^O eq 'MacOS';
+
plan(tests => 20);
my $Perl = which_perl();
==== //depot/perl/t/op/magic.t#48 (xtext) ====
Index: perl/t/op/magic.t
--- perl/t/op/magic.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/magic.t Sun Apr 28 14:30:05 2002
@@ -134,10 +134,15 @@
}
# $?, $@, $$
-system qq[$PERL "-I../lib" -e "use vmsish qw(hushed); exit(0)"];
-ok $? == 0, $?;
-system qq[$PERL "-I../lib" -e "use vmsish qw(hushed); exit(1)"];
-ok $? != 0, $?;
+if ($Is_MacOS) {
+ skip('$? + system are broken on MacPerl') for 1..2;
+}
+else {
+ system qq[$PERL "-I../lib" -e "use vmsish qw(hushed); exit(0)"];
+ ok $? == 0, $?;
+ system qq[$PERL "-I../lib" -e "use vmsish qw(hushed); exit(1)"];
+ ok $? != 0, $?;
+}
eval { die "foo\n" };
ok $@ eq "foo\n", $@;
==== //depot/perl/t/op/read.t#6 (xtext) ====
Index: perl/t/op/read.t
--- perl/t/op/read.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/read.t Sun Apr 28 14:30:05 2002
@@ -5,7 +5,7 @@
print "1..4\n";
-open(FOO,'op/read.t') || open(FOO,'t/op/read.t') || die "Can't open op.read";
+open(FOO,'op/read.t') || open(FOO,'t/op/read.t') || open(FOO,':op:read.t') || die
+"Can't open op.read";
seek(FOO,4,0);
$got = read(FOO,$buf,4);
==== //depot/perl/t/op/readdir.t#16 (xtext) ====
Index: perl/t/op/readdir.t
--- perl/t/op/readdir.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/readdir.t Sun Apr 28 14:30:05 2002
@@ -33,12 +33,13 @@
@R = sort @D;
@G = sort <op/*.t>;
+@G = sort <:op:*.t> if $^O eq 'MacOS';
if ($G[0] =~ m#.*\](\w+\.t)#i) {
# grep is to convert filespecs returned from glob under VMS to format
# identical to that returned by readdir
@G = grep(s#.*\](\w+\.t).*#op/$1#i,<op/*.t>);
}
-while (@R && @G && "op/".$R[0] eq $G[0]) {
+while (@R && @G && $G[0] eq ($^O eq 'MacOS' ? ':op:' : 'op/').$R[0]) {
shift(@R);
shift(@G);
}
==== //depot/perl/t/op/runlevel.t#24 (xtext) ====
Index: perl/t/op/runlevel.t
--- perl/t/op/runlevel.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/runlevel.t Sun Apr 28 14:30:05 2002
@@ -11,6 +11,7 @@
$Is_VMS = $^O eq 'VMS';
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_NetWare = $^O eq 'NetWare';
+$Is_MacOS = $^O eq 'MacOS';
$ENV{PERL5LIB} = "../lib" unless $Is_VMS;
$|=1;
==== //depot/perl/t/op/srand.t#5 (text) ====
Index: perl/t/op/srand.t
--- perl/t/op/srand.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/srand.t Sun Apr 28 14:30:05 2002
@@ -53,6 +53,7 @@
# This test checks whether Perl called srand for you.
@first_run = `$^X -le "print int rand 100 for 1..100"`;
+sleep(1); # in case our srand() is too time-dependent
@second_run = `$^X -le "print int rand 100 for 1..100"`;
ok( !eq_array(\@first_run, \@second_run), 'srand() called automatically');
==== //depot/perl/t/op/stat.t#67 (xtext) ====
Index: perl/t/op/stat.t
--- perl/t/op/stat.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/stat.t Sun Apr 28 14:30:05 2002
@@ -17,6 +17,7 @@
$Is_Cygwin = $^O eq 'cygwin';
$Is_Darwin = $^O eq 'darwin';
$Is_Dos = $^O eq 'dos';
+$Is_MacOS = $^O eq 'MacOS';
$Is_MPE = $^O eq 'mpeix';
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_NetWare = $^O eq 'NetWare';
@@ -175,7 +176,7 @@
SKIP: {
skip "-x simply determins if a file ends in an executable suffix", 1
- if $Is_Dosish;
+ if $Is_Dosish || $Is_MacOS;
ok(-x $tmpfile, ' -x');
}
@@ -330,10 +331,10 @@
# These aren't strictly "stat" calls, but so what?
+my $statfile = File::Spec->catfile($Curdir, 'op', 'stat.t');
+ok( -T $statfile, '-T');
+ok(! -B $statfile, '!-B');
-ok(-T 'op/stat.t', '-T');
-ok(! -B 'op/stat.t', '!-B');
-
SKIP: {
skip("DG/UX", 1) if $Is_DGUX;
ok(-B $Perl, '-B');
@@ -341,7 +342,7 @@
ok(! -T $Perl, '!-T');
-open(FOO,'op/stat.t');
+open(FOO,$statfile);
SKIP: {
eval { -T FOO; };
skip "-T/B on filehandle not implemented", 15 if $@ =~ /not implemented/;
@@ -357,7 +358,7 @@
ok(! -B FOO, ' still -B');
close(FOO);
- open(FOO,'op/stat.t');
+ open(FOO,$statfile);
$_ = <FOO>;
like($_, qr/perl/, 'reopened and after readline');
ok(-T FOO, ' still -T');
@@ -392,7 +393,7 @@
unlink $tmpfile or print "# unlink failed: $!\n";
# bug id 20011101.069
-my @r = \stat(".");
+my @r = \stat($Curdir);
is(scalar @r, 13, 'stat returns full 13 elements');
SKIP: {
==== //depot/perl/t/op/study.t#13 (xtext) ====
Index: perl/t/op/study.t
--- perl/t/op/study.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/study.t Sun Apr 28 14:30:05 2002
@@ -105,7 +105,7 @@
$* = 1; # test 3 only tested the optimized version--this one is for real
ok("ab\ncd\n" =~ /^cd/);
-if ($^O eq 'os390' or $^O eq 'posix-bc') {
+if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'MacOS') {
# Even with the alarm() OS/390 and BS2000 can't manage these tests
# (Perl just goes into a busy loop, luckily an interruptable one)
for (25..26) { print "not ok $_ # TODO compiler bug?\n" }
==== //depot/perl/t/op/subst_wamp.t#3 (xtext) ====
Index: perl/t/op/subst_wamp.t
--- perl/t/op/subst_wamp.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/subst_wamp.t Sun Apr 28 14:30:05 2002
@@ -1,9 +1,9 @@
#!./perl
$dummy = defined $&; # Now we have it...
-for $file ('op/subst.t', 't/op/subst.t') {
+for $file ('op/subst.t', 't/op/subst.t', ':op:subst.t') {
if (-r $file) {
- do "./$file";
+ do ($^O eq 'MacOS' ? $file : "./$file");
exit;
}
}
==== //depot/perl/t/op/taint.t#47 (xtext) ====
Index: perl/t/op/taint.t
--- perl/t/op/taint.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/taint.t Sun Apr 28 14:30:05 2002
@@ -14,6 +14,7 @@
use strict;
use Config;
+use File::Spec::Functions;
my $test = 177;
sub ok ($;$) {
@@ -48,6 +49,7 @@
}
}
+my $Is_MacOS = $^O eq 'MacOS';
my $Is_VMS = $^O eq 'VMS';
my $Is_MSWin32 = $^O eq 'MSWin32';
my $Is_NetWare = $^O eq 'NetWare';
@@ -55,6 +57,7 @@
my $Is_Cygwin = $^O eq 'cygwin';
my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' :
($Is_MSWin32 ? '.\perl' :
+ $Is_MacOS ? ':perl' :
($Is_NetWare ? 'perl' : './perl'));
my @MoreEnv = qw/IFS CDPATH ENV BASH_ENV/;
@@ -112,13 +115,15 @@
}
# We need an external program to call.
-my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));
+my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : $Is_MacOS ? ":echo$$" : ($Is_NetWare ?
+"echo$$" : "./echo$$"));
END { unlink $ECHO }
open PROG, "> $ECHO" or die "Can't create $ECHO: $!";
print PROG 'print "@ARGV\n"', "\n";
close PROG;
my $echo = "$Invoke_Perl $ECHO";
+my $TEST = catfile(curdir(), 'TEST');
+
print "1..203\n";
# First, let's make sure that Perl is checking the dangerous
@@ -139,7 +144,7 @@
test 1, eval { `$echo 1` } eq "1\n";
- if ($Is_MSWin32 || $Is_NetWare || $Is_VMS || $Is_Dos) {
+ if ($Is_MSWin32 || $Is_NetWare || $Is_VMS || $Is_Dos || $Is_MacOS) {
print "# Environment tainting tests skipped\n";
for (2..5) { print "ok $_\n" }
}
@@ -255,8 +260,8 @@
# How about command-line arguments? The problem is that we don't
# always get some, so we'll run another process with some.
-{
- my $arg = "./arg$$";
+SKIP: {
+ my $arg = catfile(curdir(), "arg$$");
open PROG, "> $arg" or die "Can't create $arg: $!";
print PROG q{
eval { join('', @ARGV), kill 0 };
@@ -272,8 +277,7 @@
# Reading from a file should be tainted
{
- my $file = './TEST';
- test 32, open(FILE, $file), "Couldn't open '$file': $!";
+ test 32, open(FILE, $TEST), "Couldn't open '$TEST': $!";
my $block;
sysread(FILE, $block, 100);
@@ -606,7 +610,10 @@
if ($Config{d_readlink} && $Config{d_symlink}) {
my $symlink = "sl$$";
unlink($symlink);
- symlink("/something/naughty", $symlink) or die "symlink: $!\n";
+ my $sl = "/something/naughty";
+ # it has to be a real path on Mac OS
+ $sl = MacPerl::MakePath((MacPerl::Volumes())[0]) if $Is_MacOS;
+ symlink($sl, $symlink) or die "symlink: $!\n";
my $readlink = readlink($symlink);
test 144, tainted $readlink;
unlink($symlink);
@@ -720,7 +727,7 @@
{
# bug id 20001004.006
- open IN, "./TEST" or warn "$0: cannot read ./TEST: $!" ;
+ open IN, $TEST or warn "$0: cannot read $TEST: $!" ;
local $/;
my $a = <IN>;
my $b = <IN>;
@@ -732,7 +739,7 @@
{
# bug id 20001004.007
- open IN, "./TEST" or warn "$0: cannot read ./TEST: $!" ;
+ open IN, $TEST or warn "$0: cannot read $TEST: $!" ;
my $a = <IN>;
my $c = { a => 42,
==== //depot/perl/t/op/write.t#24 (xtext) ====
Index: perl/t/op/write.t
--- perl/t/op/write.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/op/write.t Sun Apr 28 14:30:05 2002
@@ -273,7 +273,7 @@
# 12..47: scary format testing from Merijn H. Brand
-if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'dos' ||
+if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'dos' || $^O eq 'MacOS' ||
($^O eq 'os2' and not eval '$OS2::can_fork')) {
foreach (12..47) { print "ok $_ # skipped: '|-' and '-|' not supported\n"; }
exit(0);
==== //depot/perl/t/pod/testp2pt.pl#11 (text) ====
Index: perl/t/pod/testp2pt.pl
--- perl/t/pod/testp2pt.pl.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/pod/testp2pt.pl Sun Apr 28 14:30:05 2002
@@ -47,9 +47,9 @@
$INSTDIR =~ s#/$##;
$INSTDIR =~ s#/000000/#/#;
}
-# cut 't/pod' from path (cut 't:pod:' on Mac OS)
-$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod');
-$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't');
+
+$INSTDIR = (dirname $INSTDIR) if ((File::Spec->splitdir($INSTDIR))[-1] eq 'pod');
+$INSTDIR = (dirname $INSTDIR) if ((File::Spec->splitdir($INSTDIR))[-1] eq 't');
my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'),
catfile($INSTDIR, 'scripts'),
==== //depot/perl/t/run/exit.t#7 (text) ====
Index: perl/t/run/exit.t
--- perl/t/run/exit.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/run/exit.t Sun Apr 28 14:30:05 2002
@@ -19,12 +19,14 @@
}
BEGIN {
- $numtests = ($^O eq 'VMS') ? 7 : 3;
+ # MacOS system() doesn't have good return value
+ $numtests = ($^O eq 'VMS') ? 7 : ($^O eq 'MacOS') ? 0 : 3;
}
require "test.pl";
plan(tests => $numtests);
+if ($^O ne 'MacOS') {
my $exit, $exit_arg;
$exit = run('exit');
@@ -66,3 +68,4 @@
$exit_arg = (44 & 7) if $^O eq 'VMS';
is( $exit >> 8, $exit_arg, 'Changing $? in END block' );
+}
==== //depot/perl/t/run/fresh_perl.t#8 (text) ====
Index: perl/t/run/fresh_perl.t
--- perl/t/run/fresh_perl.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/run/fresh_perl.t Sun Apr 28 14:30:05 2002
@@ -95,7 +95,7 @@
########
eval {sub bar {print "In bar";}}
########
-system './perl -ne "print if eof" /dev/null'
+system './perl -ne "print if eof" /dev/null' unless $^O eq 'MacOS'
########
chop($file = <DATA>);
########
@@ -282,7 +282,7 @@
EXPECT
ok
########
-open(H,'run/fresh_perl.t'); # must be in the 't' directory
+open(H,$^O eq 'MacOS' ? ':run:fresh_perl.t' : 'run/fresh_perl.t'); # must be in the
+'t' directory
stat(H);
print "ok\n" if (-e _ and -f _ and -r _);
EXPECT
==== //depot/perl/t/run/switchPx.t#5 (text) ====
Index: perl/t/run/switchPx.t
--- perl/t/run/switchPx.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/run/switchPx.t Sun Apr 28 14:30:05 2002
@@ -8,7 +8,7 @@
$ENV{PERL5LIB} = '../lib';
use Config;
- if ( ($Config{'cppstdin'} =~ /\bcppstdin\b/) &&
+ if ( $^O eq 'MacOS' || ($Config{'cppstdin'} =~ /\bcppstdin\b/) &&
! -x $Config{'binexp'} . "/cppstdin" ) {
print "1..0 # Skip: \$Config{cppstdin} unavailable\n";
exit; # Cannot test till after install, alas.
==== //depot/perl/t/run/switcht.t#3 (text) ====
Index: perl/t/run/switcht.t
--- perl/t/run/switcht.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/run/switcht.t Sun Apr 28 14:30:05 2002
@@ -16,14 +16,14 @@
ok( ${^TAINT}, '${^TAINT} defined' );
-my $out = `$Perl -le "print q{Hello}"`;
+my $out = `$Perl -le "print q(Hello)"`;
is( $out, "Hello\n", '`` worked' );
like( $warning, qr/^Insecure .* $Tmsg/, ' taint warn' );
{
no warnings 'taint';
$warning = '';
- my $out = `$Perl -le "print q{Hello}"`;
+ my $out = `$Perl -le "print q(Hello)"`;
is( $out, "Hello\n", '`` worked' );
is( $warning, '', ' no warnings "taint"' );
}
==== //depot/perl/t/run/switchx.t#2 (text) ====
Index: perl/t/run/switchx.t
--- perl/t/run/switchx.t.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/run/switchx.t Sun Apr 28 14:30:05 2002
@@ -6,5 +6,6 @@
}
require './test.pl';
+use File::Spec::Functions;
-print runperl( switches => ['-x'], progfile => 'run/switchx.aux' );
+print runperl( switches => ['-x'], progfile => catfile(curdir(), 'run',
+'switchx.aux') );
==== //depot/perl/t/test.pl#44 (text) ====
Index: perl/t/test.pl
--- perl/t/test.pl.~1~ Sun Apr 28 14:30:05 2002
+++ perl/t/test.pl Sun Apr 28 14:30:05 2002
@@ -378,15 +378,28 @@
$runperl .= qq( "$args{progfile}");
}
if (defined $args{stdin}) {
- # so we don't try to put literal newlines and crs onto the
- # command line.
- $args{stdin} =~ s/\n/\\n/g;
- $args{stdin} =~ s/\r/\\r/g;
+ # so we don't try to put literal newlines and crs onto the
+ # command line.
+ $args{stdin} =~ s/\n/\\n/g;
+ $args{stdin} =~ s/\r/\\r/g;
if ($is_mswin || $is_netware || $is_vms) {
$runperl = qq{$^X -e "print qq(} .
$args{stdin} . q{)" | } . $runperl;
}
+ elsif ($is_macos) {
+ # MacOS can only do two processes under MPW at once;
+ # the test itself is one; we can't do two more, so
+ # write to temp file
+ my $stdin = qq{$^X -e 'print qq(} . $args{stdin} . qq{)' > teststdin; };
+ if ($args{verbose}) {
+ my $stdindisplay = $stdin;
+ $stdindisplay =~ s/\n/\n\#/g;
+ print STDERR "# $stdindisplay\n";
+ }
+ `$stdin`;
+ $runperl .= q{ < teststdin };
+ }
else {
$runperl = qq{$^X -e 'print qq(} .
$args{stdin} . q{)' | } . $runperl;
End of Patch.
