develooper Front page | perl.perl5.porters | Postings from March 2001

[PATCH] Portability fixes for Mac OS / maint-5.6

Thread Previous | Thread Next
From:
Chris Nandor
Date:
March 10, 2001 11:27
Subject:
[PATCH] Portability fixes for Mac OS / maint-5.6
Message ID:
p0501042db6cf0a8d0b63@[10.0.1.177]
Patches to get B and Errno to build/test, update macros to get dl_mac.xs to pass with DEBUGGING, portability fixes to ExtUtils::Manifest, and integrate perlsfio.h fixes from bleadperl.

--- ext/B/defsubs_h.PL.orig	Fri Feb 23 16:41:28 2001
+++ ext/B/defsubs_h.PL	Fri Mar  9 17:13:46 2001
@@ -21,7 +21,8 @@
  }
 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*(?:$|\/\*)/);
--- ext/DynaLoader/dl_mac.xs.orig	Fri Feb 23 16:42:01 2001
+++ ext/DynaLoader/dl_mac.xs	Fri Mar  9 17:14:01 2001
@@ -63,7 +63,7 @@
     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 @@
     	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 @@
     	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 @@
     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)));
 
--- ext/Errno/Errno_pm.PL.orig	Fri Feb 23 16:42:03 2001
+++ ext/Errno/Errno_pm.PL	Fri Mar  9 18:40:02 2001
@@ -43,11 +43,19 @@
             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;
@@ -92,6 +100,11 @@
 	# 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";
@@ -154,31 +167,33 @@
 
     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
 
--- lib/ExtUtils/Manifest.pm.orig	Fri Feb 23 16:43:41 2001
+++ lib/ExtUtils/Manifest.pm	Sat Mar 10 10:21:26 2001
@@ -15,6 +15,7 @@
 @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 }
 
@@ -49,6 +50,7 @@
 	}
 	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;
@@ -60,10 +62,11 @@
 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;
 }
 
@@ -115,7 +118,8 @@
 	    }
 	    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;
 	    }
 	}
@@ -135,7 +139,13 @@
     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);
@@ -166,7 +176,7 @@
 	chomp;
 	next if /^#/;
 	next if /^\s*$/;
-	push @skip, $_;
+	push @skip, _macify($_);
     }
     close M;
     my $opts = $Is_VMS ? 'oi ' : 'o ';
@@ -189,13 +199,22 @@
     $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);
     }
 }
 
@@ -204,8 +223,8 @@
     -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;
@@ -233,7 +252,7 @@
     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 {
@@ -256,6 +275,42 @@
     } else {
 	ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
     }
+}
+
+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;
--- perlsfio.h.orig	Fri Feb 23 16:33:50 2001
+++ perlsfio.h	Fri Mar  9 18:45:06 2001
@@ -5,7 +5,7 @@
 
 /* sfio 2000 changed _stdopen to _stdfdopen */
 #if SFIO_VERSION >= 20000101L
-#define _stdopen _stdfdopen 
+#define _stdopen _stdfdopen
 #endif
 
 extern Sfio_t*	_stdopen _ARG_((int, const char*));
@@ -18,7 +18,7 @@
 
 #define PerlIO_printf			sfprintf
 #define PerlIO_stdoutf			_stdprintf
-#define PerlIO_vprintf(f,fmt,a)		sfvprintf(f,fmt,a)          
+#define PerlIO_vprintf(f,fmt,a)		sfvprintf(f,fmt,a)
 #define PerlIO_read(f,buf,count)	sfread(f,buf,count)
 #define PerlIO_write(f,buf,count)	sfwrite(f,buf,count)
 #define PerlIO_open(path,mode)		sfopen(NULL,path,mode)
@@ -35,7 +35,12 @@
 #define PerlIO_fileno(f)		sffileno(f)
 #define PerlIO_clearerr(f)		sfclrerr(f)
 #define PerlIO_flush(f)			sfsync(f)
-#define PerlIO_tell(f)                 sfseek(f,0,1|SF_SHARE)
+#if 0
+/* This breaks tests */
+#define PerlIO_tell(f)			sfseek(f,0,1|SF_SHARE)
+#else
+#define PerlIO_tell(f)			sftell(f)
+#endif
 #define PerlIO_seek(f,o,w)		sfseek(f,o,w)
 #define PerlIO_rewind(f)		(void) sfseek((f),0L,0)
 #define PerlIO_tmpfile()		sftmp(0)
@@ -49,15 +54,15 @@
 
 /* Now our interface to equivalent of Configure's FILE_xxx macros */
 
-#define PerlIO_has_cntptr(f)		1       
+#define PerlIO_has_cntptr(f)		1
 #define PerlIO_get_ptr(f)		((f)->next)
 #define PerlIO_get_cnt(f)		((f)->endr - (f)->next)
-#define PerlIO_canset_cnt(f)		0
+#define PerlIO_canset_cnt(f)		1
 #define PerlIO_fast_gets(f)		1
-#define PerlIO_set_ptrcnt(f,p,c)	STMT_START {(f)->next = (unsigned char *)(p); assert(FILE_cnt(f) == (c))} STMT_END
-#define PerlIO_set_cnt(f,c)		Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
+#define PerlIO_set_ptrcnt(f,p,c)	STMT_START {(f)->next = (unsigned char *)(p); assert(PerlIO_get_cnt(f) == (c));} STMT_END
+#define PerlIO_set_cnt(f,c)		STMT_START {(f)->next = (f)->endr - (c);} STMT_END
 
-#define PerlIO_has_base(f)		1         
+#define PerlIO_has_base(f)		1
 #define PerlIO_get_base(f)		((f)->data)
 #define PerlIO_get_bufsiz(f)		((f)->endr - (f)->data)
 
--- t/lib/b.t.orig	Fri Feb 23 16:45:05 2001
+++ t/lib/b.t	Fri Mar  9 17:13:16 2001
@@ -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;
@@ -55,7 +60,12 @@
 
 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'
@@ -72,18 +82,18 @@
 ok;
 
 #6
-$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;
 
 #7
-$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//;
@@ -111,7 +121,7 @@
 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/-uWin32,// if $^O eq 'MSWin32';
 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
@@ -131,7 +141,7 @@
 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;
     } 
--- t/lib/errno.t.orig	Fri Feb 23 16:45:15 2001
+++ t/lib/errno.t	Fri Mar  9 18:39:50 2001
@@ -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'; 
+	}
     }
 }
 

-- 
Chris Nandor                      pudge@pobox.com    http://pudge.net/
Open Source Development Network    pudge@osdn.com     http://osdn.com/

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About