From: Jarkko Hietaniemi Date: Sun, 28 Apr 2002 20:26:30 +0000 (+0000) Subject: Integrate #16254 from macperl; X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dc459aad73ffc3aaf43c03d9908415c433fd93ba;p=p5sagit%2Fp5-mst-13.2.git Integrate #16254 from macperl; Fix most tests on MacOS (not yet ext/ or /lib) p4raw-id: //depot/perl@16257 --- diff --git a/lib/Pod/Find.pm b/lib/Pod/Find.pm index c1aaac4..2b84b86 100644 --- a/lib/Pod/Find.pm +++ b/lib/Pod/Find.pm @@ -128,12 +128,29 @@ sub pod_find 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 @@ sub pod_find # * 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 @@ sub pod_find } 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 @@ sub _check_and_extract_name { $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 @@ F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively. 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 @@ sub pod_where { my %options = ( '-inc' => 0, '-verbose' => 0, - '-dirs' => [ '.' ], + '-dirs' => [ File::Spec->curdir ], ); # Check for an options hash as first argument @@ -348,7 +387,22 @@ sub pod_where { 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 @@ sub pod_where { # 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'}; diff --git a/t/comp/cpp.t b/t/comp/cpp.t index 2e03c26..48250c2 100755 --- a/t/comp/cpp.t +++ b/t/comp/cpp.t @@ -9,7 +9,8 @@ BEGIN { } 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. diff --git a/t/io/dup.t b/t/io/dup.t index 6555d07..6e7d121 100755 --- a/t/io/dup.t +++ b/t/io/dup.t @@ -22,12 +22,13 @@ print STDOUT "ok 2\n"; 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 @@ if( $^O eq 'VMS' ) { } 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(STDOUT,">&DUPOUT") or die "Could not open: $!"; 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"; diff --git a/t/io/fs.t b/t/io/fs.t index 19625b5..12eec19 100755 --- a/t/io/fs.t +++ b/t/io/fs.t @@ -7,7 +7,9 @@ BEGIN { } 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 @@ my $accurate_timestamps = !($^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 @@ plan tests => 32; 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'), } diff --git a/t/io/inplace.t b/t/io/inplace.t index 4582cc2..a97add5 100755 --- a/t/io/inplace.t +++ b/t/io/inplace.t @@ -19,6 +19,12 @@ elsif ($^O eq 'NetWare') { `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`; diff --git a/t/io/iprefix.t b/t/io/iprefix.t index 6070223..a845040 100755 --- a/t/io/iprefix.t +++ b/t/io/iprefix.t @@ -25,6 +25,12 @@ elsif ($^O eq 'VMS') { `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`; diff --git a/t/io/open.t b/t/io/open.t index 1871061..cf1d39d 100755 --- a/t/io/open.t +++ b/t/io/open.t @@ -10,6 +10,7 @@ $| = 1; use warnings; use Config; $Is_VMS = $^O eq 'VMS'; +$Is_MacOS = $^O eq 'MacOS'; plan tests => 94; @@ -79,7 +80,7 @@ SKIP: { skip "open -| busted and noisy on VMS", 3 if $Is_VMS; ok( open(my $f, '-|', <; @@ -87,7 +88,9 @@ EOC ok( close($f), ' close' ); } -{ +SKIP: { + skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS; + ok( open(my $f, '|-', <; @@ -180,7 +183,9 @@ EOC ok( close($f), ' close' ); } -{ +SKIP: { + skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS; + ok( open(local $f, '|-', < 130; { 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 @@ plan tests => 130; { my $progfile = "progtmp000"; 1 while -f ++ $progfile; - END {unlink_all $progfile} + END {unlink_all $progfile if $progfile} my @programs = (<< ' --', << ' --'); #!./perl diff --git a/t/lib/1_compile.t b/t/lib/1_compile.t index 46b9ca2..1af3ecf 100644 --- a/t/lib/1_compile.t +++ b/t/lib/1_compile.t @@ -11,6 +11,7 @@ BEGIN { use strict; use warnings; +use File::Spec::Functions; # Okay, this is the list. @@ -49,7 +50,10 @@ foreach my $module (@Core_Modules) { 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/; } diff --git a/t/lib/compmod.pl b/t/lib/compmod.pl index 00dc1fb..fa032f1 100644 --- a/t/lib/compmod.pl +++ b/t/lib/compmod.pl @@ -1,8 +1,8 @@ #!./perl BEGIN { - chdir '..' if -d '../pod' && -d '../t'; - @INC = 'lib'; + chdir 't'; + @INC = '../lib'; } my $module = shift; diff --git a/t/op/chdir.t b/t/op/chdir.t index f9c64a5..2932b92 100644 --- a/t/op/chdir.t +++ b/t/op/chdir.t @@ -11,7 +11,8 @@ use Config; 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 @@ sub check_env { 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 @@ sub clean_env { 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 @@ foreach my $key (@magic_envs) { { 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' ); diff --git a/t/op/exec.t b/t/op/exec.t index a0f361a..3edbc6a 100755 --- a/t/op/exec.t +++ b/t/op/exec.t @@ -17,6 +17,8 @@ $ENV{LANGUAGE} = 'C'; # Ditto in GNU. 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(); diff --git a/t/op/magic.t b/t/op/magic.t index 0d7857b..436e253 100755 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -134,10 +134,15 @@ ok((keys %h)[0] eq "foo\034bar", (keys %h)[0]); } # $?, $@, $$ -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", $@; diff --git a/t/op/read.t b/t/op/read.t index 2746970..cfa0103 100755 --- a/t/op/read.t +++ b/t/op/read.t @@ -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); diff --git a/t/op/readdir.t b/t/op/readdir.t index 7cfecdb..83451d3 100755 --- a/t/op/readdir.t +++ b/t/op/readdir.t @@ -33,12 +33,13 @@ else { @R = sort @D; @G = sort ; +@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,); } -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); } diff --git a/t/op/runlevel.t b/t/op/runlevel.t index 1eedda8..fffe103 100755 --- a/t/op/runlevel.t +++ b/t/op/runlevel.t @@ -11,6 +11,7 @@ chdir 't' if -d 't'; $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; diff --git a/t/op/srand.t b/t/op/srand.t index e809673..5753a5d 100644 --- a/t/op/srand.t +++ b/t/op/srand.t @@ -53,6 +53,7 @@ ok( !eq_array(\@first_run, \@second_run), # 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'); diff --git a/t/op/stat.t b/t/op/stat.t index 5b01821..3cdfc23 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -17,6 +17,7 @@ $Is_Amiga = $^O eq 'amigaos'; $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 @@ ok(-w $tmpfile, ' -w'); 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,9 +331,9 @@ SKIP: { # These aren't strictly "stat" calls, but so what? - -ok(-T 'op/stat.t', '-T'); -ok(! -B 'op/stat.t', '!-B'); +my $statfile = File::Spec->catfile($Curdir, 'op', 'stat.t'); +ok( -T $statfile, '-T'); +ok(! -B $statfile, '!-B'); SKIP: { skip("DG/UX", 1) if $Is_DGUX; @@ -341,7 +342,7 @@ ok(-B $Perl, '-B'); 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 @@ SKIP: { ok(! -B FOO, ' still -B'); close(FOO); - open(FOO,'op/stat.t'); + open(FOO,$statfile); $_ = ; like($_, qr/perl/, 'reopened and after readline'); ok(-T FOO, ' still -T'); @@ -392,7 +393,7 @@ ok(-f(), ' -f() "'); 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: { diff --git a/t/op/study.t b/t/op/study.t index d90efdc..c93e4f6 100755 --- a/t/op/study.t +++ b/t/op/study.t @@ -105,7 +105,7 @@ ok(/^$_$/); $* = 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" } diff --git a/t/op/subst_wamp.t b/t/op/subst_wamp.t index ced5ee9..5e1b826 100755 --- a/t/op/subst_wamp.t +++ b/t/op/subst_wamp.t @@ -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; } } diff --git a/t/op/taint.t b/t/op/taint.t index 07b9f48..bbe643c 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -14,6 +14,7 @@ BEGIN { use strict; use Config; +use File::Spec::Functions; my $test = 177; sub ok ($;$) { @@ -48,6 +49,7 @@ BEGIN { } } +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_Dos = $^O eq 'dos'; 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 @@ sub test ($$;$) { } # 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 @@ print "1..203\n"; 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 @@ print "1..203\n"; # 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 @@ print "1..203\n"; # 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 @@ else { 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 @@ else { { # 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 = ; my $b = ; @@ -732,7 +739,7 @@ else { { # bug id 20001004.007 - open IN, "./TEST" or warn "$0: cannot read ./TEST: $!" ; + open IN, $TEST or warn "$0: cannot read $TEST: $!" ; my $a = ; my $c = { a => 42, diff --git a/t/op/write.t b/t/op/write.t index e08a64b..6af6fcb 100755 --- a/t/op/write.t +++ b/t/op/write.t @@ -273,7 +273,7 @@ else # 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); diff --git a/t/pod/testp2pt.pl b/t/pod/testp2pt.pl index 4d99f82..2db7c3f 100644 --- a/t/pod/testp2pt.pl +++ b/t/pod/testp2pt.pl @@ -47,9 +47,9 @@ if ($^O eq 'VMS') { # clean up directory spec $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'), diff --git a/t/run/exit.t b/t/run/exit.t index 5305bd2..53ba4ea 100644 --- a/t/run/exit.t +++ b/t/run/exit.t @@ -19,12 +19,14 @@ sub run { } 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 = run("END { \$? = $exit_arg }"); $exit_arg = (44 & 7) if $^O eq 'VMS'; is( $exit >> 8, $exit_arg, 'Changing $? in END block' ); +} diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t index 8a334a5..3cac42f 100644 --- a/t/run/fresh_perl.t +++ b/t/run/fresh_perl.t @@ -95,7 +95,7 @@ EXPECT ######## 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 = ); ######## @@ -282,7 +282,7 @@ print "ok\n" if ("\0" lt "\xFF"); 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 diff --git a/t/run/switchPx.t b/t/run/switchPx.t index af98031..72b068f 100644 --- a/t/run/switchPx.t +++ b/t/run/switchPx.t @@ -8,7 +8,7 @@ BEGIN { $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. diff --git a/t/run/switcht.t b/t/run/switcht.t index 2ac9ed0..869605f 100644 --- a/t/run/switcht.t +++ b/t/run/switcht.t @@ -16,14 +16,14 @@ my $Tmsg = 'while running with -t switch'; 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"' ); } diff --git a/t/run/switchx.t b/t/run/switchx.t index 4676d1a..60a522c 100644 --- a/t/run/switchx.t +++ b/t/run/switchx.t @@ -6,5 +6,6 @@ BEGIN { } 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') ); diff --git a/t/test.pl b/t/test.pl index a58b86c..7df12b6 100644 --- a/t/test.pl +++ b/t/test.pl @@ -378,15 +378,28 @@ sub runperl { $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;