[MacPerl-Porters] [PATCH] Mac OS Compatability for bleadperl

Message-Id: <p05100306b749ec0eaade@[10.0.1.177]>

p4raw-id: //depot/perl@10512

diff --git a/lib/DirHandle.pm b/lib/DirHandle.pm
index 12ee6c6..1d25969 100644 (file)
--- a/lib/DirHandle.pm
+++ b/lib/DirHandle.pm
@@ -25,6 +25,20 @@ opendir(), closedir(), readdir(), and rewinddir() functions.
 The only objective benefit to using C<DirHandle> is that it avoids
 namespace pollution by creating globs to hold directory handles.
 
+=head1 NOTES
+
+=over 4
+
+=item *
+
+On Mac OS (Classic), the path separator is ':', not '/', and the 
+current directory is denoted as ':', not '.'. You should be careful 
+about specifying relative pathnames. While a full path always begins 
+with a volume name, a relative pathname should always begin with a 
+':'.  If specifying a volume name only, a trailing ':' is required.
+
+=back
+
 =cut
 
 require 5.000;

diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm
index cc12474..72a7e39 100644 (file)
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -95,7 +95,7 @@ would yield
     $dir  eq 'Doc_Root:[Help]'
     $type eq '.Rnh'
 
-=over 4
+=over
 
 =item C<basename>
 
@@ -141,7 +141,7 @@ our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
-$VERSION = "2.6";
+$VERSION = "2.7";
 
 
 #   fileparse_set_fstype() - specify OS-based rules used in future
@@ -183,6 +183,7 @@ sub fileparse {
   }
   elsif ($fstype =~ /^MacOS/si) {
     ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
+    $dirpath = ':' unless $dirpath;
   }
   elsif ($fstype =~ /^AmigaOS/i) {
     ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);

diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
index b027b74..4ef9a2f 100755 (executable)
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -168,7 +168,7 @@ Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995.
 =cut
 
 use strict;
-use 5.005_64;
+use 5.6.0;
 use Carp;
 
 our $VERSION = 1.0;
@@ -195,6 +195,12 @@ my @trypod = (
 unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod";
 (my $PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];
 
+if ($^O eq 'MacOS') {
+    # just updir one from each lib dir, we'll find it ...
+    ($PODFILE) = grep { -e } map { "$_:pod:perldiag.pod" } @INC;
+}
+
+
 $DEBUG ||= 0;
 my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
 

diff --git a/perl.c b/perl.c
index b9a9111..d94bb5f 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3139,6 +3139,9 @@ S_find_beginning(pTHX)
                    while ((s = moreswitches(s)))
                        ;
            }
+#ifdef MACOS_TRADITIONAL
+           break;
+#endif
        }
     }
 }

diff --git a/t/base/term.t b/t/base/term.t
index 061cd33..e866337 100755 (executable)
--- a/t/base/term.t
+++ b/t/base/term.t
@@ -11,8 +11,9 @@ print "1..7\n";
 # check "" interpretation
 
 $x = "\n";
-# 10 is ASCII/Iso Latin, 21 is EBCDIC.
+# 10 is ASCII/Iso Latin, 13 in Mac OS, 21 is EBCDIC.
 if ($x eq chr(10)) { print "ok 1\n";}
+elsif ($x eq chr(13)) { print "ok 1 # Mac OS\n"; }
 elsif ($x eq chr(21)) { print "ok 1 # EBCDIC\n"; }
 else {print "not ok 1\n";}
 
@@ -39,7 +40,7 @@ if (($x | 1) == 101) {print "ok 5\n";} else {print "not ok 5\n";}
 
 # check <> pseudoliteral
 
-open(try, "/dev/null") || open(try,"nla0:") || (die "Can't open /dev/null.");
+open(try, "/dev/null") || open(try,"Dev:Null") || open(try,"nla0:") || (die "Can't open /dev/null.");
 if (<try> eq '') {
     print "ok 6\n";
 }

diff --git a/t/comp/cpp.t b/t/comp/cpp.t
index 5b061ee..cb8df50 100755 (executable)
--- a/t/comp/cpp.t
+++ b/t/comp/cpp.t
@@ -8,7 +8,7 @@ BEGIN {
 }
 
 use Config;
-if ( $^O eq 'MSWin32' or
+if ( $^O eq 'MSWin32' or $^O eq 'MacOS' or
      ($Config{'cppstdin'} =~ /\bcppstdin\b/) and
      ( ! -x $Config{'binexp'} . "/cppstdin") ) {
     print "1..0 # Skip: \$Config{cppstdin} unavailable\n";

diff --git a/t/comp/multiline.t b/t/comp/multiline.t
index ed418b8..309ac71 100755 (executable)
--- a/t/comp/multiline.t
+++ b/t/comp/multiline.t
@@ -36,7 +36,9 @@ if ($z eq $y) {print "ok 2\n";} else {print "not ok 2\n";}
 
 if ($count == 7) {print "ok 3\n";} else {print "not ok 3\n";}
 
-$_ = ($^O eq 'MSWin32') ? `type Comp.try` : `cat Comp.try`;
+$_ = ($^O eq 'MSWin32') ? `type Comp.try`
+    : ($^O eq 'MacOS') ? `catenate Comp.try`
+    : `cat Comp.try`;
 
 if (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";}
 

diff --git a/t/comp/script.t b/t/comp/script.t
index a9bc47d..9ae83e4 100755 (executable)
--- a/t/comp/script.t
+++ b/t/comp/script.t
@@ -4,7 +4,8 @@
 
 print "1..3\n";
 
-$PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl';
+$PERL = ($^O eq 'MSWin32') ? '.\perl'
+    : ($^O eq 'MacOS') ? $^X : './perl';
 $x = `$PERL -le "print 'ok';"`;
 
 if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}

diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t
index 40c4366..08d1f7c 100755 (executable)
--- a/t/lib/anydbm.t
+++ b/t/lib/anydbm.t
@@ -29,7 +29,7 @@ $Dfile = "Op_dbmx.pag";
 if (! -e $Dfile) {
        ($Dfile) = <Op_dbmx*>;
 }
-if ($Is_Dosish) {
+if ($Is_Dosish || $^O eq 'MacOS') {
     print "ok 2 # Skipped: different file permission semantics\n";
 }
 else {

diff --git a/t/lib/autoloader.t b/t/lib/autoloader.t
index b53b9fe..f2fae7f 100755 (executable)
--- a/t/lib/autoloader.t
+++ b/t/lib/autoloader.t
@@ -2,7 +2,13 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    $dir = "auto-$$";
+    if ($^O eq 'MacOS') {
+       $dir = ":auto-$$";
+       $sep = ":";
+    } else {
+       $dir = "auto-$$";
+       $sep = "/";
+    }
     @INC = $dir;
     push @INC, '../lib';
 }
@@ -11,10 +17,10 @@ print "1..11\n";
 
 # First we must set up some autoloader files
 mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
-mkdir "$dir/auto", 0755     or die "Can't mkdir: $!";
-mkdir "$dir/auto/Foo", 0755 or die "Can't mkdir: $!";
+mkdir "$dir${sep}auto", 0755     or die "Can't mkdir: $!";
+mkdir "$dir${sep}auto${sep}Foo", 0755 or die "Can't mkdir: $!";
 
-open(FOO, ">$dir/auto/Foo/foo.al") or die;
+open(FOO, ">$dir${sep}auto${sep}Foo${sep}foo.al") or die;
 print FOO <<'EOT';
 package Foo;
 sub foo { shift; shift || "foo" }
@@ -22,7 +28,7 @@ sub foo { shift; shift || "foo" }
 EOT
 close(FOO);
 
-open(BAR, ">$dir/auto/Foo/bar.al") or die;
+open(BAR, ">$dir${sep}auto${sep}Foo${sep}bar.al") or die;
 print BAR <<'EOT';
 package Foo;
 sub bar { shift; shift || "bar" }
@@ -30,7 +36,7 @@ sub bar { shift; shift || "bar" }
 EOT
 close(BAR);
 
-open(BAZ, ">$dir/auto/Foo/bazmarkhian.al") or die;
+open(BAZ, ">$dir${sep}auto${sep}Foo${sep}bazmarkhian.al") or die;
 print BAZ <<'EOT';
 package Foo;
 sub bazmarkhianish { shift; shift || "baz" }
@@ -90,7 +96,7 @@ print "not " unless $foo->bazmarkhianish($1) eq 'foo';
 print "ok 9\n";
 
 # test recursive autoloads
-open(F, ">$dir/auto/Foo/a.al") or die;
+open(F, ">$dir${sep}auto${sep}Foo${sep}a.al") or die;
 print F <<'EOT';
 package Foo;
 BEGIN { b() }
@@ -99,7 +105,7 @@ sub a { print "ok 11\n"; }
 EOT
 close(F);
 
-open(F, ">$dir/auto/Foo/b.al") or die;
+open(F, ">$dir${sep}auto${sep}Foo${sep}b.al") or die;
 print F <<'EOT';
 package Foo;
 sub b { print "ok 10\n"; }
@@ -111,12 +117,12 @@ Foo::a();
 # cleanup
 END {
 return unless $dir && -d $dir;
-unlink "$dir/auto/Foo/foo.al";
-unlink "$dir/auto/Foo/bar.al";
-unlink "$dir/auto/Foo/bazmarkhian.al";
-unlink "$dir/auto/Foo/a.al";
-unlink "$dir/auto/Foo/b.al";
-rmdir "$dir/auto/Foo";
-rmdir "$dir/auto";
+unlink "$dir${sep}auto${sep}Foo${sep}foo.al";
+unlink "$dir${sep}auto${sep}Foo${sep}bar.al";
+unlink "$dir${sep}auto${sep}Foo${sep}bazmarkhian.al";
+unlink "$dir${sep}auto${sep}Foo${sep}a.al";
+unlink "$dir${sep}auto${sep}Foo${sep}b.al";
+rmdir "$dir${sep}auto${sep}Foo";
+rmdir "$dir${sep}auto";
 rmdir "$dir";
 }

diff --git a/t/lib/dirhand.t b/t/lib/dirhand.t
index aa7be35..e83ea13 100755 (executable)
--- a/t/lib/dirhand.t
+++ b/t/lib/dirhand.t
@@ -14,7 +14,8 @@ use DirHandle;
 
 print "1..5\n";
 
-$dot = new DirHandle ".";
+$dot = new DirHandle ($^O eq 'MacOS' ? ':' : '.');
+
 print defined($dot) ? "ok" : "not ok", " 1\n";
 
 @a = sort <*>;

diff --git a/t/lib/selfloader.t b/t/lib/selfloader.t
index 6b9c244..6987f65 100755 (executable)
--- a/t/lib/selfloader.t
+++ b/t/lib/selfloader.t
@@ -3,6 +3,13 @@
 BEGIN {
     chdir 't' if -d 't';
     $dir = "self-$$";
+    $sep = "/";
+
+    if ($^O eq 'MacOS') {
+       $dir = ":" . $dir;
+       $sep = ":";
+    }
+
     @INC = $dir;
     push @INC, '../lib';
 
@@ -11,7 +18,7 @@ BEGIN {
     # First we must set up some selfloader files
     mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
 
-    open(FOO, ">$dir/Foo.pm") or die;
+    open(FOO, ">$dir${sep}Foo.pm") or die;
     print FOO <<'EOT';
 package Foo;
 use SelfLoader;
@@ -40,7 +47,7 @@ EOT
 
     close(FOO);
 
-    open(BAR, ">$dir/Bar.pm") or die;
+    open(BAR, ">$dir${sep}Bar.pm") or die;
     print BAR <<'EOT';
 package Bar;
 use SelfLoader;
@@ -196,6 +203,6 @@ if ($bardata ne "sub never { die \"D'oh\" }\n") {
 # cleanup
 END {
 return unless $dir && -d $dir;
-unlink "$dir/Foo.pm", "$dir/Bar.pm";
+unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm";
 rmdir "$dir";
 }

diff --git a/t/op/anonsub.t b/t/op/anonsub.t
index 17889d9..aa25de0 100755 (executable)
--- a/t/op/anonsub.t
+++ b/t/op/anonsub.t
@@ -4,6 +4,7 @@ chdir 't' if -d 't';
 @INC = '../lib';
 $Is_VMS = $^O eq 'VMS';
 $Is_MSWin32 = $^O eq 'MSWin32';
+$Is_MacOS = $^O eq 'MacOS';
 $ENV{PERL5LIB} = "../lib" unless $Is_VMS;
 
 $|=1;
@@ -26,10 +27,12 @@ for (@prgs){
     print TEST "$prog\n";
     close TEST;
     my $results = $Is_VMS ?
-                  `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` :
-                     $Is_MSWin32 ?  
-                         `.\\perl -I../lib $switch $tmpfile 2>&1` :
-                             `./perl $switch $tmpfile 2>&1`;
+               `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` :
+                 $Is_MSWin32 ?
+                   `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                     $Is_MacOS ?  
+                       `$^X -I::lib $switch $tmpfile` :
+                         `./perl $switch $tmpfile 2>&1`;
     my $status = $?;
     $results =~ s/\n+$//;
     # allow expected output to be written as if $prog is on STDIN

diff --git a/t/op/closure.t b/t/op/closure.t
index 5f3245f..6334286 100755 (executable)
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -465,6 +465,7 @@ END
            open CMD, ">$cmdfile"; print CMD $code; close CMD;
            my $cmd = (($^O eq 'VMS') ? "MCR $^X"
                       : ($^O eq 'MSWin32') ? '.\perl'
+                      : ($^O eq 'MacOS') ? $^X
                       : './perl');
            $cmd .= " -w $cmdfile 2>$errfile";
            if ($^O eq 'VMS' or $^O eq 'MSWin32') {

diff --git a/t/op/defins.t b/t/op/defins.t
index 33c74ea..06d48b6 100755 (executable)
--- a/t/op/defins.t
+++ b/t/op/defins.t
@@ -12,16 +12,17 @@ BEGIN {
 }
 
 $wanted_filename = $^O eq 'VMS' ? '0.' : '0';
+$saved_filename = $^O eq 'MacOS' ? ':0' : './0';
     
 print "not " if $warns;
 print "ok 1\n";
 
-open(FILE,">./0");
+open(FILE,">$saved_filename");
 print FILE "1\n";
 print FILE "0";
 close(FILE);
 
-open(FILE,"<./0");
+open(FILE,"<$saved_filename");
 my $seen = 0;
 my $dummy;
 while (my $name = <FILE>)
@@ -63,7 +64,7 @@ print "not " unless $seen;
 print "ok 5\n";
 close FILE;
 
-opendir(DIR,'.');
+opendir(DIR,($^O eq 'MacOS' ? ':' : '.'));
 $seen = 0;
 while (my $name = readdir(DIR))
  {
@@ -116,7 +117,7 @@ while ($where{$seen} = glob('*'))
 print "not " unless $seen;
 print "ok 11\n";
 
-unlink("./0");
+unlink($saved_filename);
 
 my %hash = (0 => 1, 1 => 2);
 

diff --git a/t/op/exec.t b/t/op/exec.t
index 23e9ec1..57a114e 100755 (executable)
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -11,6 +11,12 @@ if ($^O eq 'MSWin32') {
     exit(0);
 }
 
+if ($^O eq 'MacOS') {
+    # XXX the system tests could be written to use ./perl and so work on Win32
+    print "1..0 # Mostly useless tests for Mac OS\n";
+    exit(0);
+}
+
 print "1..8\n";
 
 if ($^O ne 'os2') {

diff --git a/t/op/goto.t b/t/op/goto.t
index b2e5b2c..579e818 100755 (executable)
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -29,7 +29,7 @@ label4:
 print "#2\t:$foo: == 4\n";
 if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
 
-$PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl';
+$PERL = ($^O eq 'MSWin32') ? '.\perl' : ($^O eq 'MacOS') ? $^X : './perl';
 $CMD = qq[$PERL -e "goto foo;" 2>&1 ];
 $x = `$CMD`;
 

diff --git a/t/op/pack.t b/t/op/pack.t
index 5323bc3..f9b35ae 100755 (executable)
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -43,7 +43,7 @@ $sum = 103 if ($Config{ebcdic} eq 'define');
 print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == $sum
        ? "ok 7\n" : "not ok 7 $x\n";
 
-open(BIN, "./perl") || open(BIN, "./perl.exe")
+open(BIN, "./perl") || open(BIN, "./perl.exe") || open(BIN, $^X)
     || die "Can't open ../perl or ../perl.exe: $!\n";
 sysread BIN, $foo, 8192;
 close BIN;

diff --git a/t/op/regexp.t b/t/op/regexp.t
index 0751559..6d33580 100755 (executable)
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -38,7 +38,7 @@ BEGIN {
 
 $iters = shift || 1;           # Poor man performance suite, 10000 is OK.
 
-open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') ||
+open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || open(TESTS,':op:re_tests') ||
        die "Can't open re_tests";
 
 while (<TESTS>) { }

diff --git a/t/op/regexp_noamp.t b/t/op/regexp_noamp.t
index 088bd40..8a6dd28 100755 (executable)
--- a/t/op/regexp_noamp.t
+++ b/t/op/regexp_noamp.t
@@ -1,10 +1,10 @@
 #!./perl
 
 $skip_amp = 1;
-for $file ('op/regexp.t', 't/op/regexp.t') {
+for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
   if (-r $file) {
-    do "./$file";
+    do $file;
     exit;
   }
 }
-die "Cannot find op/regexp.t or t/op/regexp.t\n";
+die "Cannot find ./op/regexp.t or ./t/op/regexp.t\n";

diff --git a/t/op/split.t b/t/op/split.t
index 3077909..4e3e546 100755 (executable)
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -52,6 +52,7 @@ print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n";
 # Does assignment to a list imply split to one more field than that?
 if ($^O eq 'MSWin32') { $foo = `.\\perl -D1024 -e "(\$a,\$b) = split;" 2>&1` }
 elsif ($^O eq 'VMS')  { $foo = `./perl "-D1024" -e "(\$a,\$b) = split;" 2>&1` }
+elsif ($^O eq 'MacOS'){ $foo = `$^X "-D1024" -e "(\$a,\$b) = split;"` }
 else                  { $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1` }
 print $foo =~ /DEBUGGING/ || $foo =~ /SV = (VOID|IV\(3\))/ ? "ok 11\n" : "not ok 11\n";
 

diff --git a/t/op/write.t b/t/op/write.t
index e5baaa4..8e4cca8 100755 (executable)
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -7,7 +7,8 @@ BEGIN {
 
 print "1..44\n";
 
-my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat';
+my $CAT = ($^O eq 'MSWin32') ? 'type'
+       : ($^O eq 'MacOS') ? 'catenate' : 'cat';
 
 format OUT =
 the quick brown @<<

diff --git a/t/pragma/strict.t b/t/pragma/strict.t
index 5b245d0..bbfb8ab 100755 (executable)
--- a/t/pragma/strict.t
+++ b/t/pragma/strict.t
@@ -17,7 +17,7 @@ END { if ($tmpfile) { 1 while unlink $tmpfile; } }
 
 my @prgs = () ;
 
-foreach (sort glob("pragma/strict-*")) {
+foreach (sort glob($^O eq 'MacOS' ? ":pragma:strict-*" : "pragma/strict-*")) {
 
     next if /(~|\.orig|,v)$/;
 
@@ -54,6 +54,7 @@ for (@prgs){
        while (@files > 2) {
            my $filename = shift @files ;
            my $code = shift @files ;
+           $code =~ s|\./abc|:abc|g if $^O eq 'MacOS';
            push @temps, $filename ;
            open F, ">$filename" or die "Cannot open $filename: $!\n" ;
            print F $code ;
@@ -61,12 +62,15 @@ for (@prgs){
        }
        shift @files ;
        $prog = shift @files ;
+       $prog =~ s|\./abc|:abc|g if $^O eq 'MacOS';
     }
     open TEST, ">$tmpfile";
     print TEST $prog,"\n";
     close TEST;
     my $results = $Is_MSWin32 ?
                   `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                  $^O eq 'MacOS' ?
+                  `$^X -I::lib $switch $tmpfile` :
                   `./perl $switch $tmpfile 2>&1`;
     my $status = $?;
     $results =~ s/\n+$//;
@@ -74,6 +78,8 @@ for (@prgs){
     $results =~ s/tmp\d+/-/g;
     $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
     $expected =~ s/\n+$//;
+    $expected =~ s|(\./)?abc\.pm|:abc.pm|g if $^O eq 'MacOS';
+    $expected =~ s|./abc|:abc|g if $^O eq 'MacOS';
     my $prefix = ($results =~ s/^PREFIX\n//) ;
     if ( $results =~ s/^SKIPPED\n//) {
        print "$results\n" ;