From: Chris Nandor Date: Sat, 10 Mar 2001 14:23:55 +0000 (-0500) Subject: Portability fixes for Mac OS / bleadperl X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=db5fd3951bd11f350bba21084582656186031ed8;p=p5sagit%2Fp5-mst-13.2.git Portability fixes for Mac OS / bleadperl Message-Id: p4raw-id: //depot/perl@9099 --- diff --git a/ext/B/defsubs_h.PL b/ext/B/defsubs_h.PL index 800bb2c..da6566b 100644 --- a/ext/B/defsubs_h.PL +++ b/ext/B/defsubs_h.PL @@ -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 () { doconst($1) if (/#define\s+(\w+)\s+([\(\)\|\dx]+)\s*(?:$|\/\*)/); diff --git a/ext/DynaLoader/dl_mac.xs b/ext/DynaLoader/dl_mac.xs index 136e6d5..5f48139 100644 --- a/ext/DynaLoader/dl_mac.xs +++ b/ext/DynaLoader/dl_mac.xs @@ -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))); diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index dd16515..2d5a54b 100644 --- a/ext/Errno/Errno_pm.PL +++ b/ext/Errno/Errno_pm.PL @@ -41,11 +41,19 @@ sub process_file { return; } } - while() { - $err{$1} = 1 - if /^\s*#\s*define\s+(E\w+)\s+/; - } - close(FH); + + if ($^O eq 'MacOS') { + while() { + $err{$1} = $2 + if /^\s*#\s*define\s+(E\w+)\s+(\d+)/; + } + } else { + while() { + $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() { - my($name,$expr); - next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/; - next if $name eq $expr; - $err{$name} = eval $expr; + while() { + 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 diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm index 7103ee9..b333196 100644 --- a/lib/ExtUtils/Manifest.pm +++ b/lib/ExtUtils/Manifest.pm @@ -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 (){ 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 () { $diff++,last if $_ ne ; } $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__ diff --git a/t/lib/b.t b/t/lib/b.t index 1f7dc14..397fdba 100755 --- 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; } diff --git a/t/lib/errno.t b/t/lib/errno.t index d173cd9..02f5ce2 100755 --- a/t/lib/errno.t +++ b/t/lib/errno.t @@ -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'; + } } }