From: Jarkko Hietaniemi Date: Fri, 31 May 2002 21:42:12 +0000 (+0000) Subject: Integrate macperl patches #16926 and #16938; X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d5201bd266fe42b2df8b480183c08be291a1ad06;p=p5sagit%2Fp5-mst-13.2.git Integrate macperl patches #16926 and #16938; Big MacPerl Testing Patch No. 2 Big MacPerl Testing Patch No. 3 p4raw-id: //depot/perl@16942 p4raw-integrated: from //depot/macperl@16937 'copy in' lib/Devel/SelfStubber.pm lib/Devel/SelfStubber.t lib/File/DosGlob.t lib/File/Path.t lib/File/Spec/t/Spec.t lib/File/Temp.pm lib/FindBin.t lib/Tie/File/t/09_gen_rs.t lib/lib.t t/comp/use.t utils/dprofpp.PL utils/splain.PL (@16123..) t/lib/MakeMaker/Test/Utils.pm (@16230..) lib/diagnostics.t (@16646..) lib/ExtUtils/t/00setup_dummy.t lib/ExtUtils/t/Command.t (@16730..) lib/lib_pm.PL (@16926..) lib/ExtUtils/MM_MacOS.pm lib/Test/Harness/Straps.pm lib/Test/Harness/t/callback.t lib/Test/Harness/t/strap-analyze.t lib/Test/Harness/t/test-harness.t (@16929..) p4raw-integrated: from //depot/macperl@16926 'merge in' lib/English.t (@16123..) ext/DynaLoader/DynaLoader_pm.PL (@16868..) --- diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index 7e1b8cb..8c44b40 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -77,6 +77,9 @@ $Is_VMS = $^O eq 'VMS'; $do_expand = $Is_VMS; $Is_MacOS = $^O eq 'MacOS'; +my $Mac_FS; +$Mac_FS = eval { require Mac::FileSpec::Unixish } if $Is_MacOS; + @dl_require_symbols = (); # names of symbols we need @dl_resolve_using = (); # names of files to link with @dl_library_path = (); # path to look for files @@ -251,6 +254,9 @@ sub bootstrap { my $dir; if ($Is_MacOS) { my $path = $_; + if ($Mac_FS) { + $path = Mac::FileSpec::Unixish::nativize($path); + } $path .= ":" unless /:$/; $dir = "${path}auto:$modpname"; } else { diff --git a/lib/Devel/SelfStubber.pm b/lib/Devel/SelfStubber.pm index baf46dc..bfdb443 100644 --- a/lib/Devel/SelfStubber.pm +++ b/lib/Devel/SelfStubber.pm @@ -1,4 +1,5 @@ package Devel::SelfStubber; +use File::Spec; require SelfLoader; @ISA = qw(SelfLoader); @EXPORT = 'AUTOLOAD'; @@ -29,10 +30,11 @@ sub _package_defined { sub stub { my($self,$module,$lib) = @_; my($line,$end_data,$fh,$mod_file,$found_selfloader); - $lib ||= '.'; + $lib ||= File::Spec->curdir(); ($mod_file = $module) =~ s,::,/,g; + $mod_file =~ tr|/|:| if $^O eq 'MacOS'; - $mod_file = "$lib/$mod_file.pm"; + $mod_file = File::Spec->catfile($lib, "$mod_file.pm"); $fh = "${module}::DATA"; my (@BEFORE_DATA, @AFTER_DATA, @AFTER_END); @DATA = @STUBS = (); diff --git a/lib/Devel/SelfStubber.t b/lib/Devel/SelfStubber.t index 2e74a02..b5deb14 100644 --- a/lib/Devel/SelfStubber.t +++ b/lib/Devel/SelfStubber.t @@ -7,8 +7,10 @@ BEGIN { use strict; use Devel::SelfStubber; +use File::Spec::Functions; my $runperl = "$^X \"-I../lib\""; +$runperl =~ s|../lib|::lib:| if $^O eq 'MacOS'; # ensure correct output ordering for system() calls @@ -31,7 +33,8 @@ push @cleanup, $inlib; while () { if (/^\#{16,}\s+(.*)/) { - my $file = "$inlib/$1"; + my $f = $1; + my $file = catfile(curdir(),$inlib,$f); push @cleanup, $file; open FH, ">$file" or die $!; } else { @@ -169,8 +172,9 @@ $Devel::SelfStubber::JUST_STUBS=0; undef $/; foreach my $module (@module, 'Data', 'End') { - my $file = "$lib/$module.pm"; - open FH, "$inlib/$module.pm" or die $!; + my $file = catfile(curdir(),$lib,"$module.pm"); + my $fileo = catfile(curdir(),$inlib,"$module.pm"); + open FH, $fileo or die "Can't open $fileo: $!"; my $contents = ; close FH or die $!; push @cleanup, $file; @@ -210,7 +214,7 @@ system "$runperl -w \"-I$lib\" \"-MData\" -e \"Data::ok\""; system "$runperl -w \"-I$lib\" \"-MEnd\" -e \"End::lime\""; # But check that the documentation after the __END__ survived. -open FH, "$lib/End.pm" or die $!; +open FH, catfile(curdir(),$lib,"End.pm") or die $!; $_ = ; close FH or die $!; diff --git a/lib/English.t b/lib/English.t index 6f1520c..49819fc 100755 --- a/lib/English.t +++ b/lib/English.t @@ -128,7 +128,7 @@ is( $keys[1], 'd|e|f', '$SUBSCRIPT_SEPARATOR' ); eval { is( $EXCEPTIONS_BEING_CAUGHT, 1, '$EXCEPTIONS_BEING_CAUGHT' ) }; ok( !$EXCEPTIONS_BEING_CAUGHT, '$EXCEPTIONS_BEING_CAUGHT should be false' ); -eval { open('') }; +eval { local *F; my $f = 'asdasdasd'; ++$f while -e $f; open(F, $f); }; is( $OS_ERROR, $ERRNO, '$OS_ERROR' ); ok( $OS_ERROR{ENOENT}, '%OS_ERROR (ENOENT should be set)' ); diff --git a/lib/ExtUtils/MM_MacOS.pm b/lib/ExtUtils/MM_MacOS.pm index 326ca6d..af4a0d6 100644 --- a/lib/ExtUtils/MM_MacOS.pm +++ b/lib/ExtUtils/MM_MacOS.pm @@ -12,7 +12,7 @@ require ExtUtils::MM_Unix; @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); use vars qw($VERSION); -$VERSION = '1.01'; +$VERSION = '1.03'; use Config; use Cwd 'cwd'; @@ -21,6 +21,8 @@ use File::Basename; use File::Spec; use vars qw(%make_data); +my $Mac_FS = eval { require Mac::FileSpec::Unixish }; + use ExtUtils::MakeMaker qw($Verbose &neatvalue); =head1 NAME @@ -242,7 +244,7 @@ Translate relative path names into Mac names. sub macify { # mmm, better ... and this condition should always be satisified, # as the module is now distributed with MacPerl, but leave in anyway - if (do 'Mac/FileSpec/Unixish.pm') { + if ($Mac_FS) { return Mac::FileSpec::Unixish::nativize($_[0]); } @@ -606,7 +608,11 @@ sub constants { XSPROTOARG MACLIBS_68K MACLIBS_PPC MACLIBS_SC MACLIBS_MRC MACLIBS_ALL_68K MACLIBS_ALL_PPC MACLIBS_SHARED SOURCE TYPEMAPS / ) { next unless defined $self->{$tmp}; - push @m, "$tmp = $self->{$tmp}\n"; + if ($tmp eq 'TYPEMAPS' && ref $self->{$tmp}) { + push @m, sprintf "$tmp = %s\n", join " ", @{$self->{$tmp}}; + } else { + push @m, "$tmp = $self->{$tmp}\n"; + } } push @m, q{ diff --git a/lib/ExtUtils/t/00setup_dummy.t b/lib/ExtUtils/t/00setup_dummy.t index 3ec1d31..a55fc00 100644 --- a/lib/ExtUtils/t/00setup_dummy.t +++ b/lib/ExtUtils/t/00setup_dummy.t @@ -12,11 +12,12 @@ chdir 't'; use strict; use Test::More tests => 9; +use File::Spec::Functions; use File::Path; use File::Basename; my %Files = ( - 'Big-Dummy/lib/Big/Dummy.pm' => <<'END', + catfile(curdir(),'Big-Dummy','lib','Big','Dummy.pm') => <<'END', package Big::Dummy; $VERSION = 0.01; @@ -24,7 +25,7 @@ $VERSION = 0.01; 1; END - 'Big-Dummy/Makefile.PL' => <<'END', + catfile(curdir(),'Big-Dummy','Makefile.PL') => <<'END', use ExtUtils::MakeMaker; printf "Current package is: %s\n", __PACKAGE__; @@ -36,14 +37,14 @@ WriteMakefile( ); END - 'Big-Dummy/t/compile.t' => <<'END', + catfile(curdir(),'Big-Dummy','t','compile.t') => <<'END', print "1..2\n"; print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; print "ok 2 - TEST_VERBOSE\n"; END - 'Big-Dummy/Liar/t/sanity.t' => <<'END', + catfile(curdir(),'Big-Dummy','Liar','t','sanity.t') => <<'END', print "1..3\n"; print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; @@ -51,7 +52,7 @@ print eval "use Big::Liar; 1;" ? "ok 2\n" : "not ok 2\n"; print "ok 3 - TEST_VERBOSE\n"; END - 'Big-Dummy/Liar/lib/Big/Liar.pm' => <<'END', + catfile(curdir(),'Big-Dummy','Liar','lib','Big','Liar.pm') => <<'END', package Big::Liar; $VERSION = 0.01; @@ -59,7 +60,7 @@ $VERSION = 0.01; 1; END - 'Big-Dummy/Liar/Makefile.PL' => <<'END', + catfile(curdir(),'Big-Dummy','Liar','Makefile.PL') => <<'END', use ExtUtils::MakeMaker; my $mm = WriteMakefile( @@ -74,7 +75,7 @@ foreach my $key (qw(INST_LIB INST_ARCHLIB)) { } END - 'Problem-Module/Makefile.PL' => <<'END', + catfile(curdir(),'Problem-Module','Makefile.PL') => <<'END', use ExtUtils::MakeMaker; WriteMakefile( @@ -82,7 +83,7 @@ WriteMakefile( ); END - 'Problem-Module/subdir/Makefile.PL' => <<'END', + catfile(curdir(),'Problem-Module','subdir','Makefile.PL') => <<'END', printf "\@INC %s .\n", (grep { $_ eq '.' } @INC) ? "has" : "doesn't have"; warn "I think I'm going to be sick\n"; diff --git a/lib/ExtUtils/t/Command.t b/lib/ExtUtils/t/Command.t index 709f3e1..2e0e08f 100644 --- a/lib/ExtUtils/t/Command.t +++ b/lib/ExtUtils/t/Command.t @@ -106,7 +106,8 @@ BEGIN { SKIP: { if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || - $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin') { + $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin' || + $^O eq 'MacOS') { skip( "different file permission semantics on $^O", 3); } diff --git a/lib/File/DosGlob.t b/lib/File/DosGlob.t index 4017fab..625d107 100755 --- a/lib/File/DosGlob.t +++ b/lib/File/DosGlob.t @@ -21,7 +21,6 @@ if ($^O eq 'MacOS') { } else { $expected = $_ = "op/a*.t"; } -$_ = "op/a*.t"; my @r = glob; print "not " if $_ ne $expected; print "ok 1\n"; @@ -94,7 +93,8 @@ print "ok 7\n"; package Foo; use File::DosGlob 'glob'; @s = (); -while (glob '*/a*.t') { +$pat = $^O eq 'MacOS' ? ':*:a*.t' : '*/a*.t'; +while (glob($pat)) { print "# $_\n"; push @s, $_; } @@ -103,15 +103,28 @@ print "ok 8\n"; # test if different glob ops maintain independent contexts @s = (); -while (<*/a*.t>) { - my $i = 0; - print "# $_ <"; - push @s, $_; - while (<*/b*.t>) { - print " $_"; - $i++; +if ($^O eq 'MacOS') { + while (<:*:a*.t>) { + my $i = 0; + print "# $_ <"; + push @s, $_; + while (<:*:b*.t>) { + print " $_"; + $i++; + } + print " >\n"; + } +} else { + while (<*/a*.t>) { + my $i = 0; + print "# $_ <"; + push @s, $_; + while (<*/b*.t>) { + print " $_"; + $i++; + } + print " >\n"; } - print " >\n"; } print "not " if "@r" ne "@s"; print "ok 9\n"; @@ -121,15 +134,28 @@ eval <<'EOT'; use File::DosGlob 'GLOBAL_glob'; package Bar; @s = (); -while (<*/a*.t>) { - my $i = 0; - print "# $_ <"; - push @s, $_; - while (glob '*/b*.t') { - print " $_"; - $i++; +if ($^O eq 'MacOS') { + while (<:*:a*.t>) { + my $i = 0; + print "# $_ <"; + push @s, $_; + while (glob ':*:b*.t') { + print " $_"; + $i++; + } + print " >\n"; + } +} else { + while (<*/a*.t>) { + my $i = 0; + print "# $_ <"; + push @s, $_; + while (glob '*/b*.t') { + print " $_"; + $i++; + } + print " >\n"; } - print " >\n"; } print "not " if "@r" ne "@s"; print "ok 10\n"; diff --git a/lib/File/Path.t b/lib/File/Path.t index 6e1414e..86b280d 100755 --- a/lib/File/Path.t +++ b/lib/File/Path.t @@ -6,6 +6,7 @@ BEGIN { } use File::Path; +use File::Spec::Functions; use strict; my $count = 0; @@ -16,10 +17,11 @@ print "1..4\n"; # first check for stupid permissions second for full, so we clean up # behind ourselves for my $perm (0111,0777) { - mkpath("foo/bar"); - chmod $perm, "foo", "foo/bar"; + my $path = catdir(curdir(), "foo", "bar"); + mkpath($path); + chmod $perm, "foo", $path; - print "not " unless -d "foo" && -d "foo/bar"; + print "not " unless -d "foo" && -d $path; print "ok ", ++$count, "\n"; rmtree("foo"); diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t index 306a131..3f18a35 100644 --- a/lib/File/Spec/t/Spec.t +++ b/lib/File/Spec/t/Spec.t @@ -3,6 +3,9 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; + if ($^O eq 'MacOS') { + push @INC, "::lib:$MacPerl::Architecture"; + } } # Grab all of the plain routines from File::Spec use File::Spec @File::Spec::EXPORT_OK ; @@ -37,7 +40,6 @@ require File::Spec::Mac ; # tests are skipped on other OSs my $root; if ($^O eq 'MacOS') { - push @INC, "::lib:$MacPerl::Architecture"; $root = File::Spec::Mac->rootdir(); } diff --git a/lib/File/Temp.pm b/lib/File/Temp.pm index 0df1af4..6f351df 100644 --- a/lib/File/Temp.pm +++ b/lib/File/Temp.pm @@ -472,14 +472,14 @@ sub _gettemp { if ( $open_success ) { # Reset umask - umask($umask); + umask($umask) if defined $umask; # Opened successfully - return file handle and name return ($fh, $path); } else { # Reset umask - umask($umask); + umask($umask) if defined $umask; # Error opening file - abort with error # if the reason was anything but EEXIST @@ -503,13 +503,13 @@ sub _gettemp { if (mkdir( $path, 0700)) { # created okay # Reset umask - umask($umask); + umask($umask) if defined $umask; return undef, $path; } else { # Reset umask - umask($umask); + umask($umask) if defined $umask; # Abort with error if the reason for failure was anything # except EEXIST diff --git a/lib/FindBin.t b/lib/FindBin.t index ebca15b..80ac811 100755 --- a/lib/FindBin.t +++ b/lib/FindBin.t @@ -11,5 +11,9 @@ use FindBin qw($Bin); print "# $Bin\n"; -print "not " unless $Bin =~ m,[/.]lib\]?$,; +if ($^O eq 'MacOS') { + print "not " unless $Bin =~ m,:lib:$,; +} else { + print "not " unless $Bin =~ m,[/.]lib\]?$,; +} print "ok 1\n"; diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm index d19239f..7b018ae 100644 --- a/lib/Test/Harness/Straps.pm +++ b/lib/Test/Harness/Straps.pm @@ -328,8 +328,11 @@ sub _switches { # When taint mode is on, PERL5LIB is ignored. So we need to put # all that on the command line as -Is. - $s .= join " ", qq[ "-$1"], map {qq["-I$_"]} $self->_filtered_INC - if $first =~ /^#!.*\bperl.*\s-\w*([Tt]+)/; + if ($first =~ /^#!.*\bperl.*\s-\w*([Tt]+)/) { + $s .= join " ", qq[ "-$1"], map {qq["-I$_"]} $self->_filtered_INC; + } elsif ($^O eq 'MacOS') { + $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 0537f91..63aaa22 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; @@ -50,7 +54,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 7ebbf35..96b549a 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. @@ -455,7 +463,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 c428e85..f75f379 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 => { @@ -426,7 +431,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; @@ -444,7 +449,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/Tie/File/t/09_gen_rs.t b/lib/Tie/File/t/09_gen_rs.t index 7d70e3e..c202556 100644 --- a/lib/Tie/File/t/09_gen_rs.t +++ b/lib/Tie/File/t/09_gen_rs.t @@ -104,6 +104,7 @@ if (setup_badly_terminated_file(3)) { $N++; push @a, "next"; check_contents($badrec, "next"); + undef $o; untie @a; } # (51-52) if (setup_badly_terminated_file(2)) { @@ -112,6 +113,7 @@ if (setup_badly_terminated_file(2)) { or die "Couldn't tie file: $!"; splice @a, 1, 0, "x", "y"; check_contents($badrec, "x", "y"); + undef $o; untie @a; } # (53-56) if (setup_badly_terminated_file(4)) { @@ -126,6 +128,7 @@ if (setup_badly_terminated_file(4)) { : "not ok $N \# expected <$badrec>, got <$r[0]>\n"; $N++; check_contents("x", "y"); + undef $o; untie @a; } # (57-58) 20020402 The modifiaction would have failed if $\ were set wrong. @@ -138,6 +141,7 @@ if (setup_badly_terminated_file(2)) { my $z = $a[0]; } check_contents($badrec); + undef $o; untie @a; } sub setup_badly_terminated_file { diff --git a/lib/diagnostics.t b/lib/diagnostics.t index f30f70e..d9855a9 100644 --- a/lib/diagnostics.t +++ b/lib/diagnostics.t @@ -1,8 +1,13 @@ #!./perl BEGIN { - chdir '..' if -d '../pod' && -d '../t'; - @INC = 'lib'; + if ($^O eq 'MacOS') { + chdir '::' if -d '::pod' && -d '::t'; + @INC = ':lib:'; + } else { + chdir '..' if -d '../pod' && -d '../t'; + @INC = 'lib'; + } } use Test::More tests => 2; diff --git a/lib/lib.t b/lib/lib.t index 9a86ac7..41280ee 100644 --- a/lib/lib.t +++ b/lib/lib.t @@ -51,13 +51,25 @@ use lib $Lib_Dir; BEGIN { use_ok('Yup') } BEGIN { + if ($^O eq 'MacOS') { + for ($Lib_Dir, $Arch_Dir) { + tr|/|:|; + $_ .= ":" unless /:$/; + $_ = ":$_" unless /^:/; # we know this path is relative + } + } is( $INC[1], $Lib_Dir, 'lib adding at end of @INC' ); print "# \@INC == @INC\n"; is( $INC[0], $Arch_Dir, ' auto/ dir in front of that' ); is( grep(/^\Q$Lib_Dir\E$/, @INC), 1, ' no duplicates' ); # Yes, %INC uses Unixy filepaths. - is( $INC{'Yup.pm'}, join("/",$Lib_Dir, 'Yup.pm'), '%INC set properly' ); + # Not on Mac OS, it doesn't ... it never has, at least. + my $path = join("/",$Lib_Dir, 'Yup.pm'); + if ($^O eq 'MacOS') { + $path = $Lib_Dir . 'Yup.pm'; + } + is( $INC{'Yup.pm'}, $path, '%INC set properly' ); is( eval { do 'Yup.pm' }, 42, 'do() works' ); ok( eval { require Yup; }, ' require()' ); diff --git a/lib/lib_pm.PL b/lib/lib_pm.PL index d778673..daca494 100644 --- a/lib/lib_pm.PL +++ b/lib/lib_pm.PL @@ -57,6 +57,12 @@ print OUT <<'!NO!SUBS!'; our @ORIG_INC = @INC; # take a handy copy of 'original' value our $VERSION = '0.5564'; +my $Is_MacOS = $^O eq 'MacOS'; +my $Mac_FS; +if ($Is_MacOS) { + require File::Spec; + $Mac_FS = eval { require Mac::FileSpec::Unixish }; +} sub import { shift; @@ -67,21 +73,29 @@ sub import { require Carp; Carp::carp("Empty compile time value given to use lib"); } + + local $_ = _nativize($_); + if (-e && ! -d _) { require Carp; Carp::carp("Parameter to use lib must be directory, not file"); } unshift(@INC, $_); - # Add any previous version directories we found at configure time - foreach my $incver (@inc_version_list) - { - unshift(@INC, "$_/$incver") if -d "$_/$incver"; - } + # Add any previous version directories we found at configure time + foreach my $invcer (@inc_version_list) + { + my $dir = $Is_MacOS + ? File::Spec->catdir( $_, $incver ) + : "$_/$incver"; + unshift(@INC, $dir) if -d $dir; + } # Put a corresponding archlib directory infront of $_ if it # looks like $_ has an archlib directory below it. - unshift(@INC, "$_/$archname") if -d "$_/$archname/auto"; - unshift(@INC, "$_/$version") if -d "$_/$version"; - unshift(@INC, "$_/$version/$archname") if -d "$_/$version/$archname"; + my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir) + = _get_dirs($_); + unshift(@INC, $arch_dir) if -d $arch_auto_dir; + unshift(@INC, $version_dir) if -d $version_dir; + unshift(@INC, $version_arch_dir) if -d $version_arch_dir; } # remove trailing duplicates @@ -95,10 +109,14 @@ sub unimport { my %names; foreach (@_) { + local $_ = _nativize($_); + + my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir) + = _get_dirs($_); ++$names{$_}; - ++$names{"$_/$archname"} if -d "$_/$archname/auto"; - ++$names{"$_/$version"} if -d "$_/$version"; - ++$names{"$_/$version/$archname"} if -d "$_/$version/$archname"; + ++$names{$arch_dir} if -d $arch_auto_dir; + ++$names{$version_dir} if -d $version_dir; + ++$names{$version_arch_dir} if -d $version_arch_dir; } # Remove ALL instances of each named directory. @@ -106,6 +124,37 @@ sub unimport { return; } +sub _get_dirs { + my($dir) = @_; + my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir); + + # we could use this for all platforms in the future, but leave it + # Mac-only for now, until there is more time for testing it. + if ($Is_MacOS) { + $arch_auto_dir = File::Spec->catdir( $_, $archname, 'auto' ); + $arch_dir = File::Spec->catdir( $_, $archname, ); + $version_dir = File::Spec->catdir( $_, $version ); + $version_arch_dir = File::Spec->catdir( $_, $version, $archname ); + } else { + $arch_auto_dir = "$_/$archname/auto"; + $arch_dir = "$_/$archname"; + $version_dir = "$_/$version"; + $version_arch_dir = "$_/$version/$archname"; + } + return($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir); +} + +sub _nativize { + my($dir) = @_; + + if ($Is_MacOS && $Mac_FS) { + $dir = Mac::FileSpec::Unixish::nativize($dir); + $dir .= ":" unless $dir =~ /:$/; + } + + return $dir; +} + 1; __END__ @@ -181,6 +230,13 @@ users must first translate their file paths to Unix conventions. # their @INC would write use lib 'stuff/moo'; +=head1 NOTES + +In the future, this module will likely use File::Spec for determining +paths, as it does now for Mac OS (where Unix-style or Mac-style paths +work, and Unix-style paths are converted properly to Mac-style paths +before being added to @INC). + =head1 SEE ALSO FindBin - optional module which deals with paths relative to the source file. diff --git a/t/comp/use.t b/t/comp/use.t index e0281b4..8e9eb8b 100755 --- a/t/comp/use.t +++ b/t/comp/use.t @@ -82,7 +82,7 @@ if ($@) { } print "ok ",$i++,"\n"; -print "not " unless $INC[0] eq "fred"; +print "not " unless ($INC[0] eq "fred" || ($^O eq 'MacOS' && $INC[0] eq ":fred:")); print "ok ",$i++,"\n"; eval "use lib 1.0 qw(joe)"; @@ -92,7 +92,7 @@ if ($@) { } print "ok ",$i++,"\n"; -print "not " unless $INC[0] eq "joe"; +print "not " unless ($INC[0] eq "joe" || ($^O eq 'MacOS' && $INC[0] eq ":joe:")); print "ok ",$i++,"\n"; eval "use lib 1.01 qw(freda)"; @@ -101,7 +101,7 @@ unless ($@) { } print "ok ",$i++,"\n"; -print "not " if $INC[0] eq "freda"; +print "not " if ($INC[0] eq "freda" || ($^O eq 'MacOS' && $INC[0] eq ":freda:")); print "ok ",$i++,"\n"; { diff --git a/t/lib/MakeMaker/Test/Utils.pm b/t/lib/MakeMaker/Test/Utils.pm index b7e01ae..fff8055 100644 --- a/t/lib/MakeMaker/Test/Utils.pm +++ b/t/lib/MakeMaker/Test/Utils.pm @@ -16,6 +16,7 @@ $VERSION = 0.02; ); my $Is_VMS = $^O eq 'VMS'; +my $Is_MacOS = $^O eq 'MacOS'; =head1 NAME @@ -68,7 +69,7 @@ sub which_perl { $perl .= $Config{exe_ext} unless $perl =~ m/$Config{exe_ext}$/i; my $perlpath = File::Spec->rel2abs( $perl ); - unless( -x $perlpath ) { + unless( $Is_MacOS || -x $perlpath ) { # $^X was probably 'perl' # When building in the core, *don't* go off and find diff --git a/utils/dprofpp.PL b/utils/dprofpp.PL index 1ef0b19..d04f61d 100644 --- a/utils/dprofpp.PL +++ b/utils/dprofpp.PL @@ -2,6 +2,7 @@ use Config; use File::Basename qw(&basename &dirname); +use File::Spec; # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you @@ -17,7 +18,7 @@ chdir(dirname($0)); $file =~ s/\.pl$// if ($Config{'osname'} eq 'OS2'); # "case-forgiving" $file =~ s/\.pl$/.com/ if ($Config{'osname'} eq 'VMS'); # "case-forgiving" -my $dprof_pm = '../ext/Devel/DProf/DProf.pm'; +my $dprof_pm = File::Spec->catfile(File::Spec->updir, 'ext', 'Devel', 'DProf', 'DProf.pm'); my $VERSION = 0; open( PM, "<$dprof_pm" ) || die "Can't open $dprof_pm: $!"; while(){ diff --git a/utils/splain.PL b/utils/splain.PL index a638dba..9c70b61 100644 --- a/utils/splain.PL +++ b/utils/splain.PL @@ -2,6 +2,7 @@ use Config; use File::Basename qw(&basename &dirname); +use File::Spec; use Cwd; # List explicitly here the variables you want Configure to @@ -20,7 +21,7 @@ $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; # Open input file before creating output file. -$IN = '../lib/diagnostics.pm'; +$IN = File::Spec->catfile(File::Spec->updir, 'lib', 'diagnostics.pm'); open IN or die "Can't open $IN: $!\n"; # Create output file.