$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)' );
@ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
use vars qw($VERSION);
-$VERSION = '1.01';
+$VERSION = '1.03';
use Config;
use Cwd 'cwd';
use File::Spec;
use vars qw(%make_data);
+my $Mac_FS = eval { require Mac::FileSpec::Unixish };
+
use ExtUtils::MakeMaker qw($Verbose &neatvalue);
=head1 NAME
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]);
}
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{
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);
}
} else {
$expected = $_ = "op/a*.t";
}
-$_ = "op/a*.t";
my @r = glob;
print "not " if $_ ne $expected;
print "ok 1\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, $_;
}
# 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";
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";
}
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");
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 ;
# tests are skipped on other OSs
my $root;
if ($^O eq 'MacOS') {
- push @INC, "::lib:$MacPerl::Architecture";
$root = File::Spec::Mac->rootdir();
}
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";
# 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";
}
}
-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;
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");
}
}
}
-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.
}
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" );
}
}
-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;
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 => {
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;
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" );
$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");
}
+
+ 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
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.
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.
}
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)";
}
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)";
}
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";
{
);
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
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
$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(<PM>){
use Config;
use File::Basename qw(&basename &dirname);
+use File::Spec;
use Cwd;
# List explicitly here the variables you want Configure to
$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.
projects / p5sagit/p5-mst-13.2.git / commitdiff