[MacPerl-Porters] [PATCH] Mac OS Compatability for bleadperl
authorChris Nandor <pudge@pobox.com>
Sun, 10 Jun 2001 23:35:38 +0000 (19:35 -0400)
committerJarkko Hietaniemi <jhi@iki.fi>
Mon, 11 Jun 2001 12:28:49 +0000 (12:28 +0000)
Message-Id: <p05100306b749ec0eaade@[10.0.1.177]>

p4raw-id: //depot/perl@10512

23 files changed:
lib/DirHandle.pm
lib/File/Basename.pm
lib/diagnostics.pm
perl.c
t/base/term.t
t/comp/cpp.t
t/comp/multiline.t
t/comp/script.t
t/lib/anydbm.t
t/lib/autoloader.t
t/lib/dirhand.t
t/lib/selfloader.t
t/op/anonsub.t
t/op/closure.t
t/op/defins.t
t/op/exec.t
t/op/goto.t
t/op/pack.t
t/op/regexp.t
t/op/regexp_noamp.t
t/op/split.t
t/op/write.t
t/pragma/strict.t

index 12ee6c6343d2ad4374f8d5ed261a22f92bf50ae6..1d259691b46c3e9921a775aedb15cc34191927c8 100644 (file)
@@ -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;
index cc124744cad50bb81559d0a25d140362bcf61934..72a7e3970433c33936ae5354ec91547a5c2cc604 100644 (file)
@@ -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);
index b027b74dc308e5019fd5e88b3ac71ec8035ac8a4..4ef9a2f64dae977aad0b7769e25b4d1951e5bb4f 100755 (executable)
@@ -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 b9a9111d33f7f103de3a900bdc7c9f795c7e634b..d94bb5f5ad5c1dc49140f0a0abfc43bb1b085ab7 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
        }
     }
 }
index 061cd33b1e714f2a0a6c8a486e96fd339f355f6c..e86633787977419233f8d3a164d0f3f344cd8fe0 100755 (executable)
@@ -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";
 }
index 5b061ee18199f180d06b2fbfa7eca3cca95746f2..cb8df508119560ccd54acfb16697f6342abc695a 100755 (executable)
@@ -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";
index ed418b84fc1d0b6575a3565d2147132db1a40c3f..309ac71e9b8e755a276531545c2f2b3b5e5585b3 100755 (executable)
@@ -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";}
 
index a9bc47d3f20b2684fd92f8ac91c45afc34553c28..9ae83e4304c75eb8f9e200306217821797c51ae0 100755 (executable)
@@ -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";}
index 40c436628fed96c8b7e785a9923204ec5e14dd7c..08d1f7c9470524e2b81393df64502da99c559b74 100755 (executable)
@@ -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 {
index b53b9feeae8a1e03cd04fc09d9672ea59241cdc3..f2fae7f309d835ebfe69e2383ada140ba0566e2f 100755 (executable)
@@ -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";
 }
index aa7be356df3a9874836c54224af2ed52d5b8764d..e83ea134965ec2e9f64db337ee24157809a158e4 100755 (executable)
@@ -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 <*>;
index 6b9c244b7ebc2dba7b927717a0378a5507262713..6987f6592be83f34926e062946cf53cd4a46908f 100755 (executable)
@@ -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";
 }
index 17889d9d2f9d5c35d47c5ac2ee0d7c0dba9df98c..aa25de0131b1f84a36ff2741054bf3c907ea6a9b 100755 (executable)
@@ -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
index 5f3245fbc9f99e5a7831e745796ed10acf49de40..633428607ea5d83fe7412f358ce7983f2d8ffaa7 100755 (executable)
@@ -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') {
index 33c74ea28e8d67497ae50324def1f227cd57a85a..06d48b601bc850636d6aa870f7c9f6dc614a9d0e 100755 (executable)
@@ -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);
 
index 23e9ec1cec7305c5799ac65dbe4707b213468e59..57a114e766e7213e835968ef98e41706b4bf35e7 100755 (executable)
@@ -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') {
index b2e5b2ca98e86e2ca8739852e911da472022281c..579e8180e471d88878819c09ab7c5504ce1b5342 100755 (executable)
@@ -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`;
 
index 5323bc34b8a4239dcf29493e74ede6e602ece26d..f9b35ae35a4475cd5cbe4afbe098780869d0a90f 100755 (executable)
@@ -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;
index 075155996458746d968fb1fce3448c23b2f95e13..6d33580b305685015fe89932b47e31f5b260fa56 100755 (executable)
@@ -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>) { }
index 088bd40264aa2d03100aefbe9f40130071af426a..8a6dd282065e567e396260a2b1ecbe583cec0ba3 100755 (executable)
@@ -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";
index 3077909c927430caf3f4f91d48787d9ff1206c05..4e3e546c18933d793fc27e233bec8ca7e984470b 100755 (executable)
@@ -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";
 
index e5baaa470c065d7699d1171515ac9d4cd1bcaa1e..8e4cca8fdc1a2328f5ecc71994f9ecd3264c9d88 100755 (executable)
@@ -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 @<<
index 5b245d0ab45d3c9a6ea3df94e396d9f743014275..bbfb8ab1f10939cf59bfbe6645e1f551f57e4149 100755 (executable)
@@ -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" ;