Portability fixes for Mac OS / bleadperl
Chris Nandor [Sat, 10 Mar 2001 14:23:55 +0000 (09:23 -0500)]
Message-Id: <p05010401b6d02f70211f@[10.0.1.177]>

p4raw-id: //depot/perl@9099

ext/B/defsubs_h.PL
ext/DynaLoader/dl_mac.xs
ext/Errno/Errno_pm.PL
lib/ExtUtils/Manifest.pm
t/lib/b.t
t/lib/errno.t

index 800bb2c..da6566b 100644 (file)
@@ -21,7 +21,8 @@ foreach my $const (qw(
  }
 foreach my $file (qw(op.h cop.h))
  {
-  open(OPH,"../../$file") || die "Cannot open ../../$file:$!";
+  my $path = $^O eq 'MacOS' ? ":::$file" : "../../$file";
+  open(OPH,"$path") || die "Cannot open $path:$!";
   while (<OPH>)
    {  
     doconst($1) if (/#define\s+(\w+)\s+([\(\)\|\dx]+)\s*(?:$|\/\*)/);
index 136e6d5..5f48139 100644 (file)
@@ -63,7 +63,7 @@ dl_load_file(filename, flags=0)
     Ptr                        mainAddr;
     Str255             errName;
     CODE:
-    DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
     err = GUSIPath2FSp(filename, &spec);
     if (!err)
        err = 
@@ -78,7 +78,7 @@ dl_load_file(filename, flags=0)
        RETVAL = connID;
     } else
        RETVAL = (ConnectionID) 0;
-    DLDEBUG(2,fprintf(stderr," libref=%d\n", RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%d\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (err)
        SaveError(aTHX_ "DynaLoader error [%d, %#s]", err, errName) ;
@@ -94,13 +94,13 @@ dl_find_symbol(connID, symbol)
        OSErr               err;
        Ptr                 symAddr;
        CFragSymbolClass    symClass;
-       DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%#s)\n",
+       DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%#s)\n",
            connID, symbol));
        err = FindSymbol(connID, symbol, &symAddr, &symClass);
        if (err)
            symAddr = (Ptr) 0;
        RETVAL = (void *) symAddr;
-       DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
+       DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref = %x\n", RETVAL));
        ST(0) = sv_newmortal() ;
        if (err)
            SaveError(aTHX_ "DynaLoader error [%d]!", err) ;
@@ -122,7 +122,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *             symref 
     char *             filename
     CODE:
-    DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
                perl_name, symref));
     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 
index dd16515..2d5a54b 100644 (file)
@@ -41,11 +41,19 @@ sub process_file {
             return;
        }
     }
-    while(<FH>) {
-       $err{$1} = 1
-           if /^\s*#\s*define\s+(E\w+)\s+/;
-   }
-   close(FH);
+
+    if ($^O eq 'MacOS') {
+       while(<FH>) {
+           $err{$1} = $2
+               if /^\s*#\s*define\s+(E\w+)\s+(\d+)/;
+       }
+    } else {
+       while(<FH>) {
+           $err{$1} = 1
+               if /^\s*#\s*define\s+(E\w+)\s+/;
+       }
+    }
+    close(FH);
 }
 
 my $cppstdin;
@@ -90,6 +98,11 @@ sub get_files {
        # Some Linuxes have weird errno.hs which generate
        # no #file or #line directives
        $file{'/usr/include/errno.h'} = 1;
+    } elsif ($^O eq 'MacOS') {
+       # note that we are only getting the GUSI errno's here ...
+       # we might miss out on compiler-specific ones
+       $file{"$ENV{GUSI}include:sys:errno.h"} = 1;
+
     } else {
        open(CPPI,"> errno.c") or
            die "Cannot open errno.c";
@@ -152,31 +165,33 @@ sub write_errno_pm {
 
     close(CPPI);
 
+    unless ($^O eq 'MacOS') {  # trust what we have
     # invoke CPP and read the output
 
-    if ($^O eq 'VMS') {
-       my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
-       $cpp =~ s/sys\$input//i;
-       open(CPPO,"$cpp  errno.c |") or
-          die "Cannot exec $Config{cppstdin}";
-    } elsif ($^O eq 'MSWin32') {
-       open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
-           die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
-    } else {
-       my $cpp = default_cpp();
-       open(CPPO,"$cpp < errno.c |")
-           or die "Cannot exec $cpp";
-    }
+       if ($^O eq 'VMS') {
+           my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
+           $cpp =~ s/sys\$input//i;
+           open(CPPO,"$cpp  errno.c |") or
+               die "Cannot exec $Config{cppstdin}";
+       } elsif ($^O eq 'MSWin32') {
+           open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
+               die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
+       } else {
+           my $cpp = default_cpp();
+           open(CPPO,"$cpp < errno.c |")
+               or die "Cannot exec $cpp";
+       }
 
-    %err = ();
+       %err = ();
 
-    while(<CPPO>) {
-       my($name,$expr);
-       next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
-       next if $name eq $expr;
-       $err{$name} = eval $expr;
+       while(<CPPO>) {
+           my($name,$expr);
+           next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
+           next if $name eq $expr;
+           $err{$name} = eval $expr;
+       }
+       close(CPPO);
     }
-    close(CPPO);
 
     # Write Errno.pm
 
index 7103ee9..b333196 100644 (file)
@@ -16,6 +16,7 @@ $VERSION = substr(q$Revision: 1.33 $, 10);
 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
              'skipcheck', 'maniread', 'manicopy');
 
+$Is_MacOS = $^O eq 'MacOS';
 $Is_VMS = $^O eq 'VMS';
 if ($Is_VMS) { require File::Basename }
 
@@ -51,6 +52,7 @@ sub mkmanifest {
        }
        my $text = $all{$file};
        ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
+       $file = _unmacify($file);
        my $tabs = (5 - (length($file)+1)/8);
        $tabs = 1 if $tabs < 1;
        $tabs = 0 unless $text;
@@ -62,10 +64,11 @@ sub mkmanifest {
 sub manifind {
     local $found = {};
     find(sub {return if -d $_;
-             (my $name = $File::Find::name) =~ s|./||;
+             (my $name = $File::Find::name) =~ s|^\./||;
+             $name =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
              warn "Debug: diskfile $name\n" if $Debug;
-             $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
-             $found->{$name} = "";}, ".");
+             $name =~ s#(.*)\.$#\L$1# if $Is_VMS;
+             $found->{$name} = "";}, $Is_MacOS ? ":" : ".");
     $found;
 }
 
@@ -117,7 +120,8 @@ sub _manicheck {
            }
            warn "Debug: manicheck checking from disk $file\n" if $Debug;
            unless ( exists $read->{$file} ) {
-               warn "Not in $MANIFEST: $file\n" unless $Quiet;
+               my $canon = "\t" . _unmacify($file) if $Is_MacOS;
+               warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
                push @missentry, $file;
            }
        }
@@ -137,7 +141,13 @@ sub maniread {
     while (<M>){
        chomp;
        next if /^#/;
-       if ($Is_VMS) {
+       if ($Is_MacOS) {
+           my($item,$text) = /^(\S+)\s*(.*)/;
+           $item = _macify($item);
+           $item =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
+           $read->{$item}=$text;
+       }
+       elsif ($Is_VMS) {
            my($file)= /^(\S+)/;
            next unless $file;
            my($base,$dir) = File::Basename::fileparse($file);
@@ -167,7 +177,7 @@ sub _maniskip {
        chomp;
        next if /^#/;
        next if /^\s*$/;
-       push @skip, $_;
+       push @skip, _macify($_);
     }
     close M;
     my $opts = $Is_VMS ? 'oi ' : 'o ';
@@ -190,13 +200,22 @@ sub manicopy {
     $target = VMS::Filespec::unixify($target) if $Is_VMS;
     File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
     foreach $file (keys %$read){
-       $file = VMS::Filespec::unixify($file) if $Is_VMS;
-       if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
-           my $dir = File::Basename::dirname($file);
-           $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
-           File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
+       if ($Is_MacOS) {
+           if ($file =~ m!:!) { 
+               my $dir = _maccat($target, $file);
+               $dir =~ s/[^:]+$//;
+               File::Path::mkpath($dir,1,0755);
+           }
+           cp_if_diff($file, _maccat($target, $file), $how);
+       } else {
+           $file = VMS::Filespec::unixify($file) if $Is_VMS;
+           if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
+               my $dir = File::Basename::dirname($file);
+               $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
+               File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
+           }
+           cp_if_diff($file, "$target/$file", $how);
        }
-       cp_if_diff($file, "$target/$file", $how);
     }
 }
 
@@ -205,8 +224,8 @@ sub cp_if_diff {
     -f $from or carp "$0: $from not found";
     my($diff) = 0;
     local(*F,*T);
-    open(F,$from) or croak "Can't read $from: $!\n";
-    if (open(T,$to)) {
+    open(F,"< $from\0") or croak "Can't read $from: $!\n";
+    if (open(T,"< $to\0")) {
        while (<F>) { $diff++,last if $_ ne <T>; }
        $diff++ unless eof(T);
        close T;
@@ -234,7 +253,7 @@ sub cp {
     copy($srcFile,$dstFile);
     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
     # chmod a+rX-w,go-w
-    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
+    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile ) unless ($^O eq 'MacOS');
 }
 
 sub ln {
@@ -259,6 +278,42 @@ sub best {
     }
 }
 
+sub _macify {
+    my($file) = @_;
+
+    return $file unless $Is_MacOS;
+    
+    $file =~ s|^\./||;
+    if ($file =~ m|/|) {
+       $file =~ s|/+|:|g;
+       $file = ":$file";
+    }
+    
+    $file;
+}
+
+sub _maccat {
+    my($f1, $f2) = @_;
+    
+    return "$f1/$f2" unless $Is_MacOS;
+    
+    $f1 .= ":$f2";
+    $f1 =~ s/([^:]:):/$1/g;
+    return $f1;
+}
+
+sub _unmacify {
+    my($file) = @_;
+
+    return $file unless $Is_MacOS;
+    
+    $file =~ s|^:||;
+    $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
+    $file =~ y|:|/|;
+    
+    $file;
+}
+
 1;
 
 __END__
index 1f7dc14..397fdba 100755 (executable)
--- a/t/lib/b.t
+++ b/t/lib/b.t
@@ -2,7 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($^O eq 'MacOS') { 
+       @INC = qw(: ::lib ::macos:lib); 
+    } else { 
+       @INC = '.'; 
+       push @INC, '../lib'; 
+    }
 }
 
 $|  = 1;
@@ -69,7 +74,12 @@ ok;
 
 my $a;
 my $Is_VMS = $^O eq 'VMS';
-$a = `$^X "-I../lib" "-MO=Deparse" -anle 1 2>&1`;
+my $Is_MacOS = $^O eq 'MacOS';
+
+my $path = join " ", map { qq["-I$_"] } @INC;
+my $redir = $Is_MacOS ? "" : "2>&1";
+
+$a = `$^X $path "-MO=Deparse" -anle 1 $redir`;
 $a =~ s/-e syntax OK\n//g;
 $a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
 $a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
@@ -85,17 +95,17 @@ EOF
 print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
 ok;
 
-$a = `$^X "-I../lib" "-MO=Debug" -e 1 2>&1`;
+$a = `$^X $path "-MO=Debug" -e 1 $redir`;
 print "not " unless $a =~
 /\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
 ok;
 
-$a = `$^X "-I../lib" "-MO=Terse" -e 1 2>&1`;
+$a = `$^X $path "-MO=Terse" -e 1 $redir`;
 print "not " unless $a =~
 /\bLISTOP\b.*leave.*\n    OP\b.*enter.*\n    COP\b.*nextstate.*\n    OP\b.*null/s;
 ok;
 
-$a = `$^X "-I../lib" "-MO=Terse" -ane "s/foo/bar/" 2>&1`;
+$a = `$^X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
 $a =~ s/\(0x[^)]+\)//g;
 $a =~ s/\[[^\]]+\]//g;
 $a =~ s/-e syntax OK//;
@@ -123,7 +133,7 @@ $b =~ s/\s+$//;
 print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
 ok;
 
-chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e1`);
+chomp($a = `$^X $path "-MB::Stash" "-Mwarnings" -e1`);
 $a = join ',', sort split /,/, $a;
 $a =~ s/-u(perlio|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define';
 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
@@ -144,7 +154,7 @@ if ($Config{static_ext} eq ' ') {
 if ($is_thread) {
     print "# use5005threads: test $test skipped\n";
 } else {
-    $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
+    $a = `$^X $path "-MO=Showlex" -e "my %one" $redir`;
     if (ord('A') != 193) { # ASCIIish
         print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
     } 
index d173cd9..02f5ce2 100755 (executable)
@@ -3,7 +3,11 @@
 BEGIN {
     unless(grep /blib/, @INC) {
        chdir 't' if -d 't';
-       @INC = '../lib';
+       if ($^O eq 'MacOS') { 
+           @INC = qw(: ::lib ::macos:lib); 
+       } else { 
+           @INC = '../lib'; 
+       }
     }
 }