$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
my $dir;
if ($Is_MacOS) {
my $path = $_;
+ if ($Mac_FS) {
+ $path = Mac::FileSpec::Unixish::nativize($path);
+ }
$path .= ":" unless /:$/;
$dir = "${path}auto:$modpname";
} else {
package Devel::SelfStubber;
+use File::Spec;
require SelfLoader;
@ISA = qw(SelfLoader);
@EXPORT = 'AUTOLOAD';
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 = ();
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
while (<DATA>) {
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 {
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 = <FH>;
close FH or die $!;
push @cleanup, $file;
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 $!;
$_ = <FH>;
close FH or die $!;
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)' );
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;
1;
END
- 'Big-Dummy/Makefile.PL' => <<'END',
+ catfile(curdir(),'Big-Dummy','Makefile.PL') => <<'END',
use ExtUtils::MakeMaker;
printf "Current package is: %s\n", __PACKAGE__;
);
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";
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;
1;
END
- 'Big-Dummy/Liar/Makefile.PL' => <<'END',
+ catfile(curdir(),'Big-Dummy','Liar','Makefile.PL') => <<'END',
use ExtUtils::MakeMaker;
my $mm = WriteMakefile(
}
END
- 'Problem-Module/Makefile.PL' => <<'END',
+ catfile(curdir(),'Problem-Module','Makefile.PL') => <<'END',
use ExtUtils::MakeMaker;
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";
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);
}
}
use File::Path;
+use File::Spec::Functions;
use strict;
my $count = 0;
# 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");
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
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
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";
$N++;
push @a, "next";
check_contents($badrec, "next");
+ undef $o; untie @a;
}
# (51-52)
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)) {
: "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.
my $z = $a[0];
}
check_contents($badrec);
+ undef $o; untie @a;
}
sub setup_badly_terminated_file {
#!./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;
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()' );
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;
require Carp;
Carp::carp("Empty compile time value given to use lib");
}
+
+ $_ = _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
my %names;
foreach (@_) {
+ $_ = _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.
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__
# 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.
);
my $Is_VMS = $^O eq 'VMS';
+my $Is_MacOS = $^O eq 'MacOS';
=head1 NAME
$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
https://perl5.git.perl.org / perl5.git / commitdiff