From: Jarkko Hietaniemi Date: Thu, 30 May 2002 13:29:13 +0000 (+0000) Subject: Integrate macperl patch #16868. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e69a2255d0db4d110e403864fcb97407ce8e4ff9;p=p5sagit%2Fp5-mst-13.2.git Integrate macperl patch #16868. p4raw-id: //depot/perl@16882 p4raw-integrated: from //depot/macperl@16881 'copy in' ext/B/B/Concise.pm ext/B/t/deparse.t ext/B/t/terse.t ext/DynaLoader/DynaLoader_pm.PL ext/IO/lib/IO/t/io_dup.t ext/POSIX/t/sigaction.t ext/PerlIO/t/encoding.t ext/Socket/Socket.t lib/AutoSplit.t lib/Net/Ping/t/110_icmp_inst.t lib/Net/hostent.t lib/Pod/t/Usage.t lib/Pod/t/pod2html-lib.pl lib/Test/Harness/t/callback.t lib/blib.pm lib/strict.t lib/subs.t t/lib/filter-util.pl t/lib/warnings/doio t/lib/warnings/mg t/x2p/s2p.t (@16123..) lib/Test/Simple/t/exit.t (@16230..) lib/open.t lib/warnings.t (@16255..) perl.c (@16475..) lib/Unicode/Collate.pm lib/Unicode/UCD.t (@16651..) ext/PerlIO/t/fallback.t lib/Test/Harness/t/strap-analyze.t lib/Test/Harness/t/test-harness.t (@16825..) p4raw-integrated: from //depot/macperl@16868 'copy in' lib/blib.t (@16123..) t/lib/warnings/op (@16230..) ext/Cwd/t/cwd.t ext/Digest/MD5/t/files.t (@16475..) 'merge in' ext/Storable/t/utf8hash.t lib/Test/Harness/Straps.pm (@16730..) --- diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 7399d4e..80459b4 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -530,9 +530,13 @@ sub tree { # If either of the marked numbers there aren't 1, it means you need to # update the corresponding magic number in the next two lines. -# Reember, these need to stay the last things in the module. -$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + 11; -$seq_base = svref_2object(eval 'sub{}')->START->seq + 84; +# Remember, these need to stay the last things in the module. + +# Why these are different for MacOS? Does it matter? +my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11; +my $seq_mnum = $^O eq 'MacOS' ? 100 : 84; +$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum; +$seq_base = svref_2object(eval 'sub{}')->START->seq + $seq_mnum; 1; diff --git a/ext/B/t/deparse.t b/ext/B/t/deparse.t index 768257a..1c148e6 100644 --- a/ext/B/t/deparse.t +++ b/ext/B/t/deparse.t @@ -99,7 +99,7 @@ $path .= " -MMac::err=unix" if $Is_MacOS; my $redir = $Is_MacOS ? "" : "2>&1"; $a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 $redir`; -$a =~ s/(?:# )?-e syntax OK\n//g; # "# " for Mac OS +$a =~ s/-e syntax OK\n//g; $a =~ s/.*possible typo.*\n//; # Remove warning line $a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037 $a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc' @@ -113,6 +113,12 @@ LINE: while (defined($_ = )) { '???'; } EOF +$b =~ s/(LINE:)/sub BEGIN { + 'MacPerl'->bootstrap; + 'OSA'->bootstrap; + 'XL'->bootstrap; +} +$1/ if $Is_MacOS; print "# [$a]\n\# vs expected\n# [$b]\nnot " if $a ne $b; print "ok " . $i++ . "\n"; diff --git a/ext/B/t/terse.t b/ext/B/t/terse.t index 33b2313..1ad61b1 100644 --- a/ext/B/t/terse.t +++ b/ext/B/t/terse.t @@ -89,6 +89,7 @@ SKIP: { if $Config{useithreads}; # Schwern's example of finding an RV my $path = join " ", map { qq["-I$_"] } @INC; + $path = '-I::lib -MMac::err=unix' if $^O eq 'MacOS'; my $redir = $^O eq 'MacOS' ? '' : "2>&1"; my $items = qx{$^X $path "-MO=Terse" -le "print \\42" $redir}; like( $items, qr/RV $hex \\42/, 'RV' ); diff --git a/ext/Cwd/t/cwd.t b/ext/Cwd/t/cwd.t index 6b0453d..0a43c91 100644 --- a/ext/Cwd/t/cwd.t +++ b/ext/Cwd/t/cwd.t @@ -9,11 +9,13 @@ use Config; use Cwd; use strict; use warnings; +use File::Spec; use File::Path; use Test::More tests => 16; my $IsVMS = $^O eq 'VMS'; +my $IsMacOS = $^O eq 'MacOS'; # check imports can_ok('main', qw(cwd getcwd fastcwd fastgetcwd)); @@ -32,6 +34,8 @@ my $pwd = $^O eq 'MSWin32' ? "cmd" : "pwd"; my $pwd_cmd = ($^O eq "NetWare") ? "cd" : + ($IsMacOS) ? + "pwd" : (grep { -x && -f } map { "$_/$pwd$Config{exe_ext}" } split m/$Config{path_sep}/, $ENV{PATH})[0]; @@ -77,6 +81,9 @@ if( $IsVMS ) { $want =~ s|/|\.|g; $want .= '\]'; $want = '((?i)' . $want . ')'; # might be ODS-2 or ODS-5 +} elsif ( $IsMacOS ) { + $_ = ":$_" for ($Top_Test_Dir, $Test_Dir); + s|/|:|g, s|$|:| for ($want, $Test_Dir); } mkpath(["$Test_Dir"], 0, 0777); @@ -89,15 +96,16 @@ like(fastgetcwd(), qr|$want$|, ' + fastgetcwd()'); # Cwd::chdir should also update $ENV{PWD} like($ENV{PWD}, qr|$want$|, 'Cwd::chdir() updates $ENV{PWD}'); -Cwd::chdir ".."; +my $updir = File::Spec->updir; +Cwd::chdir $updir; print "#$ENV{PWD}\n"; -Cwd::chdir ".."; +Cwd::chdir $updir; print "#$ENV{PWD}\n"; -Cwd::chdir ".."; +Cwd::chdir $updir; print "#$ENV{PWD}\n"; -Cwd::chdir ".."; +Cwd::chdir $updir; print "#$ENV{PWD}\n"; -Cwd::chdir ".."; +Cwd::chdir $updir; print "#$ENV{PWD}\n"; rmtree([$Top_Test_Dir], 0, 0); @@ -105,6 +113,9 @@ rmtree([$Top_Test_Dir], 0, 0); if ($IsVMS) { like($ENV{PWD}, qr|\b((?i)t)\]$|); } +elsif ($IsMacOS) { + like($ENV{PWD}, qr|\bt:$|); +} else { like($ENV{PWD}, qr|\bt$|); } @@ -117,7 +128,7 @@ SKIP: { my $abs_path = Cwd::abs_path("linktest"); my $fast_abs_path = Cwd::fast_abs_path("linktest"); - my $want = "t/$Test_Dir"; + my $want = File::Spec->catdir("t", $Test_Dir) if $IsMacOS; like($abs_path, qr|$want$|); like($fast_abs_path, qr|$want$|); diff --git a/ext/Digest/MD5/t/files.t b/ext/Digest/MD5/t/files.t index c020559..0e89dcb 100644 --- a/ext/Digest/MD5/t/files.t +++ b/ext/Digest/MD5/t/files.t @@ -20,14 +20,23 @@ my $EXPECT; # (You'll need to have Perl 5.7.3 or later, to have the Encode installed.) # (And remember that under the Perl core distribution you should # also have the $ENV{PERL_CORE} set to a true value.) +# Similarly, to update MacOS section, run with $ENV{MAC_MD5SUM} set. if (ord "A" == 193) { # EBCDIC $EXPECT = <&2", 5; +$cmd = sprintf "$echo 1>&2", 5; +$cmd = sprintf $echo, 5 if $^O eq 'MacOS'; print `$cmd`; $stderr->close; @@ -56,7 +57,8 @@ $stdout->fdopen($dupout,"w"); $stderr->fdopen($duperr,"w"); 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 6\n"; diff --git a/ext/POSIX/t/sigaction.t b/ext/POSIX/t/sigaction.t index b864b65..d280d68 100644 --- a/ext/POSIX/t/sigaction.t +++ b/ext/POSIX/t/sigaction.t @@ -10,7 +10,7 @@ BEGIN{ use Config; eval { use POSIX; }; if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || - ($^O eq 'VMS' && !$Config{'d_sigaction'})) { + $^O eq 'MacOS' || ($^O eq 'VMS' && !$Config{'d_sigaction'})) { print "1..0\n"; exit 0; } diff --git a/ext/PerlIO/t/encoding.t b/ext/PerlIO/t/encoding.t index 133388c..b53eab5 100644 --- a/ext/PerlIO/t/encoding.t +++ b/ext/PerlIO/t/encoding.t @@ -3,6 +3,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; + push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; unless (find PerlIO::Layer 'perlio') { print "1..0 # Skip: not perlio\n"; exit 0; diff --git a/ext/PerlIO/t/fallback.t b/ext/PerlIO/t/fallback.t index a30d056..42a958d 100644 --- a/ext/PerlIO/t/fallback.t +++ b/ext/PerlIO/t/fallback.t @@ -3,6 +3,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; + push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require "../t/test.pl"; skip_all("No perlio") unless (find PerlIO::Layer 'perlio'); if (ord("A") == 193) { diff --git a/ext/Socket/Socket.t b/ext/Socket/Socket.t index 4dbc480..c06b9e7 100755 --- a/ext/Socket/Socket.t +++ b/ext/Socket/Socket.t @@ -26,7 +26,8 @@ if (socket(T,PF_INET,SOCK_STREAM,6)) { print "ok 1\n"; arm(5); - if ($has_echo && connect(T,pack_sockaddr_in(7,inet_aton("localhost")))){ + my $host = $^O eq 'MacOS' ? '127.0.0.1' : 'localhost'; + if ($has_echo && connect(T,pack_sockaddr_in(7,inet_aton($host)))){ arm(0); print "ok 2\n"; diff --git a/ext/Storable/t/utf8hash.t b/ext/Storable/t/utf8hash.t index be67dc9..a6a1643 100644 --- a/ext/Storable/t/utf8hash.t +++ b/ext/Storable/t/utf8hash.t @@ -11,6 +11,7 @@ sub BEGIN { if ($ENV{PERL_CORE}){ chdir('t') if -d 't'; @INC = ('.', '../lib'); + push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; } else { unshift @INC, 't'; } diff --git a/lib/AutoSplit.t b/lib/AutoSplit.t index 7cc680e..174902a 100644 --- a/lib/AutoSplit.t +++ b/lib/AutoSplit.t @@ -3,8 +3,7 @@ # AutoLoader.t runs before this test, so it seems safe to assume that it will # work. -my $incdir; -my $lib = '"-I../lib"'; # ok on unix, nt, The extra \" are for VMS +my($incdir, $lib); BEGIN { chdir 't' if -d 't'; if ($^O eq 'dos') { @@ -13,9 +12,10 @@ BEGIN { } if ($^O eq 'MacOS') { $incdir = ":auto-$$"; - $lib = '-x -I::lib:'; # -x overcomes MPW $Config{startperl} anomaly + $lib = '-I::lib:'; } else { $incdir = "auto-$$"; + $lib = '"-I../lib"'; # ok on unix, nt, The extra \" are for VMS } @INC = $incdir; push @INC, '../lib'; @@ -49,8 +49,9 @@ my @tests; close DATA; } -my $pathsep = $^O eq 'MSWin32' ? '\\' : '/'; - +my $pathsep = $^O eq 'MSWin32' ? '\\' : $^O eq 'MacOS' ? ':' : '/'; +my $endpathsep = $^O eq 'MacOS' ? ':' : ''; + sub split_a_file { my $contents = shift; my $file = $_[0]; @@ -76,7 +77,10 @@ my $dir = File::Spec->catdir($incdir, 'auto'); if ($^O eq 'VMS') { $dir = VMS::Filespec::unixify($dir); $dir =~ s/\/$//; +} elsif ($^O eq 'MacOS') { + $dir =~ s/:$//; } + foreach (@tests) { my $module = 'A' . $i . '_' . $$ . 'splittest'; my $file = File::Spec->catfile($incdir,"$module.pm"); @@ -84,6 +88,7 @@ foreach (@tests) { s/\*DIR\*/$dir/gm; s/\*MOD\*/$module/gm; s/\*PATHSEP\*/$pathsep/gm; + s/\*ENDPATHSEP\*/$endpathsep/gm; s#//#/#gm; # Build a hash for this test. my %args = /^\#\#\ ([^\n]*)\n # Key is on a line starting ## @@ -142,6 +147,7 @@ foreach (@tests) { } } if ($args{Require}) { + $args{Require} =~ s|/|:|gm if $^O eq 'MacOS'; my $com = 'require "' . File::Spec->catfile ('auto', $args{Require}) . '"'; $com =~ s{\\}{/}gm if ($^O eq 'MSWin32'); eval $com; @@ -221,11 +227,11 @@ sub test_a2 : locked { 1; } # And that was all it has. You were expected to manually inspect the output ## Get Warning: AutoSplit had to create top-level *DIR* unexpectedly. -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) *INC**PATHSEP**MOD*.pm: some names are not unique when truncated to 8 characters: - directory *DIR**PATHSEP**MOD*: + directory *DIR**PATHSEP**MOD**ENDPATHSEP*: testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest - directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit: + directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit*ENDPATHSEP*: testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest ## Files *DIR*/*MOD*/autosplit.ix @@ -281,7 +287,7 @@ missing use AutoLoader; (but don't skip) 1; __END__ ## Get -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) ## Require *MOD*/autosplit.ix ## Files @@ -296,7 +302,7 @@ __END__ sub obsolete {my $a if 0; return $a++;} sub gonner {warn "This gonner function should never get called"} ## Get -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) ## Require *MOD*/autosplit.ix ## Files @@ -324,7 +330,7 @@ sub ghoul {"wail"}; sub zombie {"You didn't use fire."}; sub flying_pig {"Oink oink flap flap"}; ## Get -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) ## Require *MOD*/autosplit.ix ## Files @@ -353,7 +359,7 @@ __END__ sub ghost {"bump"}; sub wraith {9}; ## Get -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) ## Require *MOD*/autosplit.ix ## Files @@ -399,7 +405,7 @@ With the timestamp check make sure that things happen (stuff gets deleted) ## Extra 0, 1, 0 ## Get -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) ## Require *MOD*/autosplit.ix ## Files diff --git a/lib/Net/Ping/t/110_icmp_inst.t b/lib/Net/Ping/t/110_icmp_inst.t index 41f8e15..b0ee1b7 100644 --- a/lib/Net/Ping/t/110_icmp_inst.t +++ b/lib/Net/Ping/t/110_icmp_inst.t @@ -21,6 +21,8 @@ if (($> and $^O ne 'VMS') or ($^O eq 'VMS' and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/))) { skip "icmp ping requires root privileges.", 1; +} elsif ($^O eq 'MacOS') { + skip "icmp protocol not supported.", 1; } else { my $p = new Net::Ping "icmp"; ok !!$p; diff --git a/lib/Net/hostent.t b/lib/Net/hostent.t index e82cf85..9c6fa13 100644 --- a/lib/Net/hostent.t +++ b/lib/Net/hostent.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } -use Test::More tests => 7; +use Test::More; BEGIN { require Config; import Config; @@ -14,8 +14,12 @@ BEGIN { { plan skip_all => "Test uses Socket, Socket not built"; } + if ($^O eq 'MacOS') { + plan skip_all => "Test relies on resolution of localhost, fails on Mac OS"; + } } +use Test::More tests => 7; BEGIN { use_ok 'Net::hostent' } diff --git a/lib/Pod/t/Usage.t b/lib/Pod/t/Usage.t index f5c7207..d970d91 100644 --- a/lib/Pod/t/Usage.t +++ b/lib/Pod/t/Usage.t @@ -47,7 +47,8 @@ SKIP: { is( $$fake_out, $vbl_0, '-pathlist parameter' ); } -{ # Test exit status from pod2usage() +SKIP: { # Test exit status from pod2usage() + skip "Exit status broken on Mac OS", 1 if $^O eq 'MacOS'; my $exit = ($^O eq 'VMS' ? 2 : 42); my $dev_null = File::Spec->devnull; my $args = join ", ", ( diff --git a/lib/Pod/t/pod2html-lib.pl b/lib/Pod/t/pod2html-lib.pl index 3a83bd1..3f1b267 100644 --- a/lib/Pod/t/pod2html-lib.pl +++ b/lib/Pod/t/pod2html-lib.pl @@ -7,7 +7,7 @@ sub convert_n_test { my($podfile, $testname) = @_; my $cwd = Cwd::cwd(); - my $base_dir = catdir $cwd, "..", "lib", "Pod"; + my $base_dir = catdir $cwd, updir(), "lib", "Pod"; my $new_dir = catdir $base_dir, "t"; my $infile = catfile $new_dir, "$podfile.pod"; my $outfile = catfile $new_dir, "$podfile.html"; diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm index 8f4f6bd..aff5735 100644 --- a/lib/Test/Harness/Straps.pm +++ b/lib/Test/Harness/Straps.pm @@ -315,8 +315,8 @@ sub _switches { my $s = ''; $s .= " $ENV{'HARNESS_PERL_SWITCHES'}" if exists $ENV{'HARNESS_PERL_SWITCHES'}; - $s .= join " ", qq[ "-$1"], map {qq["-I$_"]} $self->_filtered_INC - if $first =~ /^#!.*\bperl.*\s-\w*([Tt]+)/; + $s .= qq[ "-$1" ] if $first =~ /^#!.*\bperl.*\s-\w*([Tt]+)/; + $s .= join " ", map {qq["-I$_"]} $self->_filtered_INC; close(TEST) or print "can't close $file. $!\n"; diff --git a/lib/Test/Harness/t/callback.t b/lib/Test/Harness/t/callback.t index 2fc943a..65de524 100644 --- a/lib/Test/Harness/t/callback.t +++ b/lib/Test/Harness/t/callback.t @@ -10,7 +10,11 @@ BEGIN { } } -my $SAMPLE_TESTS = $ENV{PERL_CORE} ? 'lib/sample-tests' : 't/sample-tests'; +use File::Spec::Functions; + +my $SAMPLE_TESTS = $ENV{PERL_CORE} + ? catdir(curdir(), 'lib', 'sample-tests') + : catdir(curdir(), 't', 'sample-tests'); use Test::More; @@ -49,7 +53,7 @@ $strap->{callback} = sub { while( my($test, $expect) = each %samples ) { local @out = (); - $strap->analyze_file("$SAMPLE_TESTS/$test"); + $strap->analyze_file(catfile($SAMPLE_TESTS, $test)); is_deeply(\@out, $expect, "$test callback"); } diff --git a/lib/Test/Harness/t/strap-analyze.t b/lib/Test/Harness/t/strap-analyze.t index 781ddd2..60ecb0d 100644 --- a/lib/Test/Harness/t/strap-analyze.t +++ b/lib/Test/Harness/t/strap-analyze.t @@ -10,11 +10,19 @@ BEGIN { } } -my $SAMPLE_TESTS = $ENV{PERL_CORE} ? 'lib/sample-tests' : 't/sample-tests'; +use File::Spec::Functions; + +my $SAMPLE_TESTS = $ENV{PERL_CORE} + ? catdir(curdir(), 'lib', 'sample-tests') + : catdir(curdir(), 't', 'sample-tests'); use strict; use Test::More; +if ($^O eq 'MacOS') { + plan skip_all => "Exit status broken on Mac OS"; +} + my $IsVMS = $^O eq 'VMS'; # VMS uses native, not POSIX, exit codes. @@ -417,7 +425,7 @@ while( my($test, $expect) = each %samples ) { } my $strap = Test::Harness::Straps->new; - my %results = $strap->analyze_file("$SAMPLE_TESTS/$test"); + my %results = $strap->analyze_file(catfile($SAMPLE_TESTS, $test)); is_deeply($results{details}, $expect->{details}, "$test details" ); diff --git a/lib/Test/Harness/t/test-harness.t b/lib/Test/Harness/t/test-harness.t index 6241818..d061059 100644 --- a/lib/Test/Harness/t/test-harness.t +++ b/lib/Test/Harness/t/test-harness.t @@ -10,7 +10,11 @@ BEGIN { } } -my $SAMPLE_TESTS = $ENV{PERL_CORE} ? "lib/sample-tests" : "t/sample-tests"; +use File::Spec::Functions; + +my $SAMPLE_TESTS = $ENV{PERL_CORE} + ? catdir(curdir(), 'lib', 'sample-tests') + : catdir(curdir(), 't', 'sample-tests'); use strict; @@ -36,9 +40,10 @@ package main; use Test::More; my $IsVMS = $^O eq 'VMS'; +my $IsMacOS = $^O eq 'MacOS'; # VMS uses native, not POSIX, exit codes. -my $die_estat = $IsVMS ? 44 : 1; +my $die_estat = $IsVMS ? 44 : $IsMacOS ? 0 : 1; my %samples = ( simple => { @@ -394,7 +399,7 @@ while (my($test, $expect) = each %samples) { select NULL; # _run_all_tests() isn't as quiet as it should be. local $SIG{__WARN__} = sub { $warning .= join '', @_; }; ($totals, $failed) = - Test::Harness::_run_all_tests("$SAMPLE_TESTS/$test"); + Test::Harness::_run_all_tests(catfile($SAMPLE_TESTS, $test)); }; select STDOUT; @@ -412,7 +417,7 @@ while (my($test, $expect) = each %samples) { is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}}, $expect->{total}, "$test - totals" ); - is_deeply( {map { $_=>$failed->{"$SAMPLE_TESTS/$test"}{$_} } + is_deeply( {map { $_=>$failed->{catfile($SAMPLE_TESTS, $test)}{$_} } keys %{$expect->{failed}}}, $expect->{failed}, "$test - failed" ); diff --git a/lib/Test/Simple/t/exit.t b/lib/Test/Simple/t/exit.t index 25e6259..1367bbf 100644 --- a/lib/Test/Simple/t/exit.t +++ b/lib/Test/Simple/t/exit.t @@ -18,6 +18,11 @@ if( $^O eq 'VMS' && $] <= 5.00503 ) { exit 0; } +if( $^O eq 'MacOS' ) { + print "1..0 # Skip exit status broken on Mac OS\n"; + exit 0; +} + my $test_num = 1; # Utility testing functions. sub ok ($;$) { diff --git a/lib/Unicode/Collate.pm b/lib/Unicode/Collate.pm index 676a3aa..51c290e 100644 --- a/lib/Unicode/Collate.pm +++ b/lib/Unicode/Collate.pm @@ -10,6 +10,7 @@ use 5.006; use strict; use warnings; use Carp; +use File::Spec; require Exporter; @@ -151,8 +152,9 @@ sub read_table { my $self = shift; my $file = $self->{table} ne '' ? $self->{table} : $KeyFile; - open my $fk, "<$Path/$file" - or croak "File does not exist at $Path/$file"; + my $filepath = File::Spec->catfile($Path, $file); + open my $fk, "<$filepath" + or croak "File does not exist at $filepath"; while (<$fk>) { next if /^\s*#/; diff --git a/lib/Unicode/UCD.t b/lib/Unicode/UCD.t index 0e1550e..9082057 100644 --- a/lib/Unicode/UCD.t +++ b/lib/Unicode/UCD.t @@ -5,6 +5,7 @@ BEGIN { } chdir 't' if -d 't'; @INC = '../lib'; + @INC = "::lib" if $^O eq 'MacOS'; # module parses @INC itself } use strict; diff --git a/lib/blib.pm b/lib/blib.pm index 9797f2f..df20add 100644 --- a/lib/blib.pm +++ b/lib/blib.pm @@ -34,12 +34,13 @@ Pollutes global name space for development only task. Nick Ing-Simmons nik@tiuk.ti.com -=cut +=cut use Cwd; +use File::Spec; use vars qw($VERSION $Verbose); -$VERSION = '1.01'; +$VERSION = '1.02'; $Verbose = 0; sub import @@ -52,20 +53,32 @@ sub import $dir = shift; $dir =~ s/blib\z//; $dir =~ s,/+\z,,; - $dir = '.' unless ($dir); + $dir = File::Spec->curdir unless ($dir); die "$dir is not a directory\n" unless (-d $dir); } - my $i = 5; + my $i = 5; + my($blib, $blib_lib, $blib_arch); while ($i--) { - my $blib = "${dir}/blib"; - if (-d $blib && -d "$blib/arch" && -d "$blib/lib") + $blib = File::Spec->catdir($dir, "blib"); + $blib_lib = File::Spec->catdir($blib, "lib"); + + if ($^O eq 'MacOS') + { + $blib_arch = File::Spec->catdir($blib_lib, $MacPerl::Architecture); + } + else + { + $blib_arch = File::Spec->catdir($blib, "arch"); + } + + if (-d $blib && -d $blib_arch && -d $blib_lib) { - unshift(@INC,"$blib/arch","$blib/lib"); + unshift(@INC,$blib_arch,$blib_lib); warn "Using $blib\n" if $Verbose; return; } - $dir .= "/.."; + $dir = File::Spec->catdir($dir, File::Spec->updir); } die "Cannot find blib even in $dir\n"; } diff --git a/lib/blib.t b/lib/blib.t index bb269c4..6828f8b 100644 --- a/lib/blib.t +++ b/lib/blib.t @@ -6,10 +6,11 @@ BEGIN { } use strict; +my($blib, $blib_arch, $blib_lib, @blib_dirs); sub _cleanup { - rmdir foreach reverse qw(blib blib/arch blib/lib); - unlink "stderr"; + rmdir foreach reverse (@_); + unlink "stderr" unless $^O eq 'MacOS'; } sub _mkdirs { @@ -20,14 +21,30 @@ sub _mkdirs { } -BEGIN { _cleanup } +BEGIN { + if ($^O eq 'MacOS') + { + $blib = ":blib:"; + $blib_lib = ":blib:lib:"; + $blib_arch = ":blib:lib:$MacPerl::Architecture:"; + @blib_dirs = ($blib, $blib_lib, $blib_arch); # order + } + else + { + $blib = "blib"; + $blib_arch = "blib/arch"; + $blib_lib = "blib/lib"; + @blib_dirs = ($blib, $blib_arch, $blib_lib); + } + _cleanup( @blib_dirs ); +} use Test::More tests => 7; eval 'use blib;'; ok( $@ =~ /Cannot find blib/, 'Fails if blib directory not found' ); -_mkdirs(qw(blib blib/arch blib/lib)); +_mkdirs( @blib_dirs ); { my $warnings = ''; @@ -39,7 +56,7 @@ _mkdirs(qw(blib blib/arch blib/lib)); is( @INC, 3, '@INC now has 3 elements' ); is( $INC[2], '../lib', 'blib added to the front of @INC' ); -ok( grep(m|blib/lib$|, @INC[0,1]) == 1, ' blib/lib in @INC'); -ok( grep(m|blib/arch$|, @INC[0,1]) == 1, ' blib/arch in @INC'); +ok( grep(m|$blib_lib$|, @INC[0,1]) == 1, ' blib/lib in @INC'); +ok( grep(m|$blib_arch$|, @INC[0,1]) == 1, ' blib/arch in @INC'); -END { _cleanup(); } +END { _cleanup( @blib_dirs ); } diff --git a/lib/open.t b/lib/open.t index 48abf25..7e09d8d 100644 --- a/lib/open.t +++ b/lib/open.t @@ -3,6 +3,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; + push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; } diff --git a/lib/strict.t b/lib/strict.t index f03271b..02f191b 100644 --- a/lib/strict.t +++ b/lib/strict.t @@ -13,12 +13,12 @@ my $Is_MSWin32 = $^O eq 'MSWin32'; my $Is_NetWare = $^O eq 'NetWare'; my $tmpfile = "tmp0000"; my $i = 0 ; -1 while -f ++$tmpfile; +1 while -e ++$tmpfile; END { if ($tmpfile) { 1 while unlink $tmpfile; } } my @prgs = () ; -foreach (sort glob($^O eq 'MacOS' ? ":lib::strict:*" : "lib/strict/*")) { +foreach (sort glob($^O eq 'MacOS' ? ":lib:strict:*" : "lib/strict/*")) { next if /(~|\.orig|,v)$/; @@ -65,7 +65,7 @@ for (@prgs){ $prog = shift @files ; $prog =~ s|\./abc|:abc|g if $^O eq 'MacOS'; } - open TEST, ">$tmpfile"; + open TEST, ">$tmpfile" or die "Could not open: $!"; print TEST $prog,"\n"; close TEST or die "Could not close: $!"; my $results = $Is_MSWin32 ? diff --git a/lib/subs.t b/lib/subs.t index a98dd1d..92f4302 100644 --- a/lib/subs.t +++ b/lib/subs.t @@ -14,9 +14,10 @@ print "1..", scalar @prgs, "\n"; my $Is_VMS = $^O eq 'VMS'; my $Is_MSWin32 = $^O eq 'MSWin32'; my $Is_NetWare = $^O eq 'NetWare'; +my $Is_MacOS = $^O eq 'MacOS'; my $tmpfile = "tmp0000"; my $i = 0 ; -1 while -f ++$tmpfile; +1 while -e ++$tmpfile; END { if ($tmpfile) { 1 while unlink $tmpfile} } for (@prgs){ diff --git a/lib/warnings.t b/lib/warnings.t index d6bd374..8e57a6d 100644 --- a/lib/warnings.t +++ b/lib/warnings.t @@ -8,24 +8,32 @@ BEGIN { } use File::Path; +use File::Spec::Functions; $| = 1; my $Is_VMS = $^O eq 'VMS'; my $Is_MSWin32 = $^O eq 'MSWin32'; my $Is_NetWare = $^O eq 'NetWare'; +my $Is_MacOS = $^O eq 'MacOS'; my $tmpfile = "tmp0000"; my $i = 0 ; -1 while -f ++$tmpfile; +1 while -e ++$tmpfile; END { if ($tmpfile) { 1 while unlink $tmpfile} } my @prgs = () ; my @w_files = () ; if (@ARGV) - { print "ARGV = [@ARGV]\n" ; @w_files = map { s#^#./lib/warnings/#; $_ } @ARGV } + { print "ARGV = [@ARGV]\n" ; + if ($^O eq 'MacOS') { + @w_files = map { s#^#:lib:warnings:#; $_ } @ARGV + } else { + @w_files = map { s#^#./lib/warnings/#; $_ } @ARGV + } + } else - { @w_files = sort glob("lib/warnings/*") } + { @w_files = sort glob(catfile(curdir(), "lib", "warnings", "*")) } my $files = 0; foreach my $file (@w_files) { @@ -88,6 +96,13 @@ for (@prgs){ shift @files ; $prog = shift @files ; } + + # fix up some paths + if ($^O eq 'MacOS') { + $prog =~ s|require "./abc(d)?";|require ":abc$1";|g; + $prog =~ s|"\."|":"|g; + } + open TEST, ">$tmpfile" or die "Cannot open >$tmpfile: $!"; print TEST q{ BEGIN { @@ -123,6 +138,13 @@ for (@prgs){ $results =~ s/^(syntax|parse) error/syntax error/mig; # allow all tests to run when there are leaks $results =~ s/Scalars leaked: \d+\n//g; + + # fix up some paths + if ($^O eq 'MacOS') { + $results =~ s|:abc\.pm\b|abc.pm|g; + $results =~ s|:abc(d)?\b|./abc$1|g; + } + $expected =~ s/\n+$//; my $prefix = ($results =~ s#^PREFIX(\n|$)##) ; # any special options? (OPTIONS foo bar zap) diff --git a/perl.c b/perl.c index 5230114..90b227e 100644 --- a/perl.c +++ b/perl.c @@ -1648,7 +1648,9 @@ S_run_body(pTHX_ I32 oldscope) if (PL_minus_c) { #ifdef MACOS_TRADITIONAL - PerlIO_printf(Perl_error_log, "# %s syntax OK\n", MacPerl_MPWFileName(PL_origfilename)); + PerlIO_printf(Perl_error_log, "%s%s syntax OK\n", + (gMacPerl_ErrorFormat ? "# " : ""), + MacPerl_MPWFileName(PL_origfilename)); #else PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename); #endif @@ -3787,8 +3789,11 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers) p = Nullch; /* break out */ } #ifdef MACOS_TRADITIONAL - if (!strchr(SvPVX(libdir), ':')) - sv_insert(libdir, 0, 0, ":", 1); + if (!strchr(SvPVX(libdir), ':')) { + char buf[256]; + + sv_setpv(libdir, MacPerl_CanonDir(SvPVX(libdir), buf, 0)); + } if (SvPVX(libdir)[SvCUR(libdir)-1] != ':') sv_catpv(libdir, ":"); #endif diff --git a/t/lib/filter-util.pl b/t/lib/filter-util.pl index c378f22..1bc3bfb 100644 --- a/t/lib/filter-util.pl +++ b/t/lib/filter-util.pl @@ -45,6 +45,7 @@ sub ok $Inc = '' ; foreach (@INC) { $Inc .= "\"-I$_\" " } +$Inc = "-I::lib" if $^O eq 'MacOS'; $Perl = '' ; $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio index 569229d..bb09aa8 100644 --- a/t/lib/warnings/doio +++ b/t/lib/warnings/doio @@ -171,6 +171,15 @@ Use of -l on filehandle STDIN at - line 3. Use of -l on filehandle $fh at - line 6. ######## # doio.c [Perl_do_aexec5] +BEGIN { + if ($^O eq 'MacOS') { + print < $sedcmd ); + $psedres = runperl( args => $sedcmd, switches => $switches ); is( $psedres, $testcase{$tc}{expect}, "psed $tc" ); # 2nd test: run s2p # translate the sed script to a Perl program - - my $perlprog = runperl( args => $s2pcmd ); + + my $perlprog = runperl( args => $s2pcmd, switches => $switches ); open( PP, ">$plsed" ) || goto FAIL_S2P; print PP $perlprog; close( PP ) || goto FAIL_S2P; # execute generated Perl program, compare - $s2pres = runperl( args => $plcmd ); + $s2pres = runperl( args => $plcmd, switches => $switches ); is( $s2pres, $testcase{$tc}{expect}, "s2p $tc" ); next;