buncha MacPerl patches for bleadperl

Message-Id: <p05010404b6ae6f85e07a@[10.0.1.177]>

p4raw-id: //depot/perl@8792

diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm
index af33ee8..ad6bc40 100644 (file)
--- a/lib/AutoLoader.pm
+++ b/lib/AutoLoader.pm
@@ -6,6 +6,7 @@ our(@EXPORT, @EXPORT_OK, $VERSION);
 my $is_dosish;
 my $is_epoc;
 my $is_vms;
+my $is_macos;
 
 BEGIN {
     require Exporter;
@@ -14,7 +15,8 @@ BEGIN {
     $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32';
     $is_epoc = $^O eq 'epoc';
     $is_vms = $^O eq 'VMS';
-    $VERSION = '5.57';
+    $is_macos = $^O eq 'MacOS';
+    $VERSION = '5.58';
 }
 
 AUTOLOAD {
@@ -38,7 +40,12 @@ AUTOLOAD {
        my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/);
        $pkg =~ s#::#/#g;
        if (defined($filename = $INC{"$pkg.pm"})) {
-           $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s;
+           if ($is_macos) {
+               $pkg =~ tr#/#:#;
+               $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s;
+           } else {
+               $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s;
+           }
 
            # if the file exists, then make sure that it is a
            # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al',
@@ -61,7 +68,7 @@ AUTOLOAD {
                        # XXX todo by VMSmiths
                        $filename = "./$filename";
                    }
-                   else {
+                   elsif (!$is_macos) {
                        $filename = "./$filename";
                    }
                }

diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm
index 8640576..8fcf528 100644 (file)
--- a/lib/AutoSplit.pm
+++ b/lib/AutoSplit.pm
@@ -264,7 +264,7 @@ sub autosplit_file {
                    ($^O eq 'dos') or ($^O eq 'MSWin32') or
                    $Is_VMS && $filename =~ m/$modpname.pm/i);
 
-    my($al_idx_file) = "$autodir/$modpname/$IndexFile";
+    my($al_idx_file) = catfile($autodir, $modpname, $IndexFile);
 
     if ($check_mod_time){
        my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
@@ -279,8 +279,8 @@ sub autosplit_file {
     print "AutoSplitting $filename ($modnamedir)\n"
        if $Verbose;
 
-    unless (-d "$modnamedir"){
-       mkpath("$modnamedir",0,0777);
+    unless (-d $modnamedir){
+       mkpath($modnamedir,0,0777);
     }
 
     # We must try to deal with some SVR3 systems with a limit of 14
@@ -324,7 +324,7 @@ sub autosplit_file {
            my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3));
            $modpname = _modpname($this_package);
            my($modnamedir) = catfile($autodir, $modpname);
-           mkpath("$modnamedir",0,0777);
+           mkpath($modnamedir,0,0777);
            my($lpath) = catfile($modnamedir, "$lname.al");
            my($spath) = catfile($modnamedir, "$sname.al");
            my $path;

diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm
index 9680348..a4cd6f4 100644 (file)
--- a/lib/ExtUtils/MakeMaker.pm
+++ b/lib/ExtUtils/MakeMaker.pm
@@ -205,6 +205,9 @@ sub full_setup {
     PREREQ_PM SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
     XS_VERSION clean depend dist dynamic_lib linkext macro realclean
     tool_autosplit
+
+    MACPERL_SRC MACPERL_LIB MACLIBS_68K MACLIBS_PPC MACLIBS_SC MACLIBS_MRC
+    MACLIBS_ALL_68K MACLIBS_ALL_PPC MACLIBS_SHARED
        /;
 
     # IMPORTS is used under OS/2 and Win32

diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm
index 75996f2..94aac2d 100644 (file)
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -240,7 +240,13 @@ sub dirname {
         if ($_[0] =~ m#/#) { $fstype = '' }
         else { return $dirname || $ENV{DEFAULT} }
     }
-    if ($fstype =~ /MacOS/i) { return $dirname }
+    if ($fstype =~ /MacOS/i) {
+       if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
+           $dirname =~ s/([^:]):\z/$1/s;
+           ($basename,$dirname) = fileparse $dirname;
+       }
+       $dirname .= ":" unless $dirname =~ /:\z/;
+    }
     elsif ($fstype =~ /MSDOS/i) { 
         $dirname =~ s/([^:])[\\\/]*\z/$1/;
         unless( length($basename) ) {
@@ -260,7 +266,7 @@ sub dirname {
         chop $dirname;
         $dirname =~ s#[^:/]+\z## unless length($basename);
     }
-    else { 
+    else {
         $dirname =~ s:(.)/*\z:$1:s;
         unless( length($basename) ) {
            local($File::Basename::Fileparse_fstype) = $fstype;

diff --git a/makedef.pl b/makedef.pl
index 6a30fc6..c677458 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -51,7 +51,7 @@ while (@ARGV) {
     $PLATFORM = $1 if ($flag =~ /^PLATFORM=(\w+)$/);
 }
 
-my @PLATFORM = qw(aix win32 os2);
+my @PLATFORM = qw(aix win32 os2 MacOS);
 my %PLATFORM;
 @PLATFORM{@PLATFORM} = ();
 
@@ -78,8 +78,14 @@ elsif ($PLATFORM eq 'win32') {
        s!^!..\\!;
     }
 }
+elsif ($PLATFORM eq 'MacOS') {
+    foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym,
+               $pp_sym, $globvar_sym, $perlio_sym) {
+       s!^!::!;
+    }
+}
 
-unless ($PLATFORM eq 'win32') {
+unless ($PLATFORM eq 'win32' || $PLATFORM eq 'MacOS') {
     open(CFG,$config_sh) || die "Cannot open $config_sh: $!\n";
     while (<CFG>) {
        if (/^(?:ccflags|optimize)='(.+)'$/) {
@@ -300,6 +306,33 @@ elsif ($PLATFORM eq 'os2') {
                    Perl_hab_GET
                    )]);
 }
+elsif ($PLATFORM eq 'MacOS') {
+    skip_symbols [qw(
+                   Perl_GetVars
+                   PL_cryptseen
+                   PL_cshlen
+                   PL_cshname
+                   PL_statusvalue_vms
+                   PL_sys_intern
+                   PL_opsave
+                   PL_timesbuf
+                   Perl_dump_fds
+                   Perl_my_bcopy
+                   Perl_my_bzero
+                   Perl_my_chsize
+                   Perl_my_htonl
+                   Perl_my_memcmp
+                   Perl_my_memset
+                   Perl_my_ntohl
+                   Perl_my_swap
+                   Perl_safexcalloc
+                   Perl_safexfree
+                   Perl_safexmalloc
+                   Perl_safexrealloc
+                   Perl_unlnk
+                   )];
+}
+
 
 unless ($define{'DEBUGGING'}) {
     skip_symbols [qw(
@@ -498,7 +531,53 @@ if ($define{'PERL_GLOBAL_STRUCT'}) {
 my @syms = ($global_sym, $globvar_sym); # $pp_sym is not part of the API
 
 if ($define{'USE_PERLIO'}) {
-     push @syms, $perlio_sym;
+    push @syms, $perlio_sym;
+    if ($define{'USE_SFIO'}) {
+       # SFIO defines most of the PerlIO routines as macros
+       skip_symbols [qw(
+                        PerlIO_canset_cnt
+                        PerlIO_clearerr
+                        PerlIO_close
+                        PerlIO_eof
+                        PerlIO_error
+                        PerlIO_exportFILE
+                        PerlIO_fast_gets
+                        PerlIO_fdopen
+                        PerlIO_fileno
+                        PerlIO_findFILE
+                        PerlIO_flush
+                        PerlIO_get_base
+                        PerlIO_get_bufsiz
+                        PerlIO_get_cnt
+                        PerlIO_get_ptr
+                        PerlIO_getc
+                        PerlIO_getname
+                        PerlIO_has_base
+                        PerlIO_has_cntptr
+                        PerlIO_importFILE
+                        PerlIO_open
+                        PerlIO_printf
+                        PerlIO_putc
+                        PerlIO_puts
+                        PerlIO_read
+                        PerlIO_releaseFILE
+                        PerlIO_reopen
+                        PerlIO_rewind
+                        PerlIO_seek
+                        PerlIO_set_cnt
+                        PerlIO_set_ptrcnt
+                        PerlIO_setlinebuf
+                        PerlIO_sprintf
+                        PerlIO_stderr
+                        PerlIO_stdin
+                        PerlIO_stdout
+                        PerlIO_stdoutf
+                        PerlIO_tell
+                        PerlIO_ungetc
+                        PerlIO_vprintf
+                        PerlIO_write
+                        )];
+    }
 }
 
 for my $syms (@syms) {
@@ -725,6 +804,15 @@ elsif ($PLATFORM eq 'os2') {
                    keys %export;
     delete $export{$_} foreach @missing;
 }
+elsif ($PLATFORM eq 'MacOS') {
+    open MACSYMS, 'macperl.sym' or die 'Cannot read macperl.sym';
+
+    while (<MACSYMS>) {
+       try_symbol($_);
+    }
+
+    close MACSYMS;
+}
 
 # Now all symbols should be defined because
 # next we are going to output them.
@@ -771,7 +859,7 @@ sub output_symbol {
     elsif ($PLATFORM eq 'os2') {
        print qq(    "$symbol"\n);
     }
-    elsif ($PLATFORM eq 'aix') {
+    elsif ($PLATFORM eq 'aix' || $PLATFORM eq 'MacOS') {
        print "$symbol\n";
     }
 }

diff --git a/perl.c b/perl.c
index b0c1cef..0f0bb55 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2269,7 +2269,7 @@ Perl_moreswitches(pTHX_ char *s)
                      "\n\nCopyright 1987-2001, Larry Wall\n");
 #ifdef MACOS_TRADITIONAL
        PerlIO_printf(PerlIO_stdout(),
-                     "\nMacOS port Copyright (c) 1991-2000, Matthias Neeracher\n");
+                     "\nMac OS port Copyright (c) 1991-2001, Matthias Neeracher\n");
 #endif
 #ifdef MSDOS
        PerlIO_printf(PerlIO_stdout(),
@@ -3045,7 +3045,7 @@ S_find_beginning(pTHX)
 
     forbid_setid("-x");
 #ifdef MACOS_TRADITIONAL
-    /* Since the Mac OS does not honor !# arguments for us, we do it ourselves */
+    /* Since the Mac OS does not honor #! arguments for us, we do it ourselves */
 
     while (PL_doextract || gMacPerl_AlwaysExtract) {
        if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
@@ -3549,13 +3549,15 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
            if (addsubdirs) {
 #ifdef MACOS_TRADITIONAL
 #define PERL_AV_SUFFIX_FMT     ""
-#define PERL_ARCH_FMT          ":%s"
+#define PERL_ARCH_FMT          "%s:"
+#define PERL_ARCH_FMT_PATH     PERL_FS_VER_FMT PERL_AV_SUFFIX_FMT
 #else
 #define PERL_AV_SUFFIX_FMT     "/"
 #define PERL_ARCH_FMT          "/%s"
+#define PERL_ARCH_FMT_PATH     PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT
 #endif
                /* .../version/archname if -d .../version/archname */
-               Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT PERL_ARCH_FMT,
+               Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH PERL_ARCH_FMT,
                                libdir,
                               (int)PERL_REVISION, (int)PERL_VERSION,
                               (int)PERL_SUBVERSION, ARCHNAME);
@@ -3564,7 +3566,7 @@ S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
                    av_push(GvAVn(PL_incgv), newSVsv(subdir));
 
                /* .../version if -d .../version */
-               Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT, libdir,
+               Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH, libdir,
                               (int)PERL_REVISION, (int)PERL_VERSION,
                               (int)PERL_SUBVERSION);
                if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&

diff --git a/pp_ctl.c b/pp_ctl.c
index 487a8d2..74fc32f 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3110,22 +3110,27 @@ PP(pp_require)
 
     /* prepare to compile file */
 
+#ifdef MACOS_TRADITIONAL
     if (PERL_FILE_IS_ABSOLUTE(name)
-       || (*name == '.' && (name[1] == '/' ||
-                            (name[1] == '.' && name[2] == '/'))))
+       || (*name == ':' && name[1] != ':' && strchr(name+2, ':')))
     {
        tryname = name;
        tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
-#ifdef MACOS_TRADITIONAL
        /* We consider paths of the form :a:b ambiguous and interpret them first
           as global then as local
        */
-       if (!tryrsfp && name[0] == ':' && name[1] != ':' && strchr(name+2, ':'))
+       if (!tryrsfp && *name == ':' && name[1] != ':' && strchr(name+2, ':'))
            goto trylocal;
     }
     else
 trylocal: {
 #else
+    if (PERL_FILE_IS_ABSOLUTE(name)
+       || (*name == '.' && (name[1] == '/' ||
+                            (name[1] == '.' && name[2] == '/'))))
+    {
+       tryname = name;
+       tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
     }
     else {
 #endif

diff --git a/t/lib/basename.t b/t/lib/basename.t
index a02aa32..9bee1bf 100755 (executable)
--- a/t/lib/basename.t
+++ b/t/lib/basename.t
@@ -7,7 +7,7 @@ BEGIN {
 
 use File::Basename qw(fileparse basename dirname);
 
-print "1..36\n";
+print "1..41\n";
 
 # import correctly?
 print +(defined(&basename) && !defined(&fileparse_set_fstype) ?
@@ -96,29 +96,34 @@ print +(basename(':arma:virumque:cano.trojae') eq 'cano.trojae' ?
         '' : 'not '),"ok 25\n";
 print +(dirname(':arma:virumque:cano.trojae') eq ':arma:virumque:' ?
         '' : 'not '),"ok 26\n";
-print +(dirname('arma:') eq 'arma:' ? '' : 'not '),"ok 27\n";
-print +(dirname(':') eq ':' ? '' : 'not '),"ok 28\n";
+print +(dirname(':arma:virumque:') eq ':arma:' ? '' : 'not '),"ok 27\n";
+print +(dirname(':arma:virumque') eq ':arma:' ? '' : 'not '),"ok 28\n";
+print +(dirname(':arma:') eq ':' ? '' : 'not '),"ok 29\n";
+print +(dirname(':arma') eq ':' ? '' : 'not '),"ok 30\n";
+print +(dirname('arma:') eq 'arma:' ? '' : 'not '),"ok 31\n";
+print +(dirname('arma') eq ':' ? '' : 'not '),"ok 32\n";
+print +(dirname(':') eq ':' ? '' : 'not '),"ok 33\n";
 
 
 # Check quoting of metacharacters in suffix arg by basename()
 print +(basename(':arma:virumque:cano.trojae','.trojae') eq 'cano' ?
-        '' : 'not '),"ok 29\n";
+        '' : 'not '),"ok 34\n";
 print +(basename(':arma:virumque:cano_trojae','.trojae') eq 'cano_trojae' ?
-        '' : 'not '),"ok 30\n";
+        '' : 'not '),"ok 35\n";
 
 # extra tests for a few specific bugs
 
 File::Basename::fileparse_set_fstype 'MSDOS';
 # perl5.003_18 gives C:/perl/.\
-print +((fileparse 'C:/perl/lib')[1] eq 'C:/perl/' ? '' : 'not '), "ok 31\n";
+print +((fileparse 'C:/perl/lib')[1] eq 'C:/perl/' ? '' : 'not '), "ok 36\n";
 # perl5.003_18 gives C:\perl\
-print +(dirname('C:\\perl\\lib\\') eq 'C:\\perl' ? '' : 'not '), "ok 32\n";
+print +(dirname('C:\\perl\\lib\\') eq 'C:\\perl' ? '' : 'not '), "ok 37\n";
 
 File::Basename::fileparse_set_fstype 'UNIX';
 # perl5.003_18 gives '.'
-print +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 33\n";
+print +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 38\n";
 # perl5.003_18 gives '/perl/lib'
-print +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 34\n";
+print +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 39\n";
 
 #   The empty tainted value, for tainting strings
 my $TAINT = substr($^X, 0, 0);
@@ -134,6 +139,6 @@ sub all_tainted (@) {
     1;
 }
 
-print +(tainted(dirname($TAINT.'/perl/lib//')) ? '' : 'not '), "ok 35\n";
+print +(tainted(dirname($TAINT.'/perl/lib//')) ? '' : 'not '), "ok 40\n";
 print +(all_tainted(fileparse($TAINT.'/dir/draft.book7','\.book\d+'))
-               ? '' : 'not '), "ok 36\n";
+               ? '' : 'not '), "ok 41\n";

diff --git a/toke.c b/toke.c
index 72e6f41..fd93c80 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -472,7 +472,7 @@ S_incline(pTHX_ char *s)
        s += 4;
     else
        return;
-    if (*s == ' ' || *s == '\t')
+    if (SPACE_OR_TAB(*s))
        s++;
     else
        return;
@@ -2115,9 +2115,6 @@ S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
 */
 
 #ifdef USE_PURE_BISON
-#ifdef __SC__
-#pragma segment Perl_yylex_r
-#endif
 int
 Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp)
 {
@@ -7460,6 +7457,9 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     return oldsavestack_ix;
 }
 
+#ifdef __SC__
+#pragma segment Perl_yylex
+#endif
 int
 Perl_yywarn(pTHX_ char *s)
 {
@@ -7548,6 +7548,9 @@ Perl_yyerror(pTHX_ char *s)
     PL_in_my_stash = Nullhv;
     return 0;
 }
+#ifdef __SC__
+#pragma segment Main
+#endif
 
 STATIC char*
 S_swallow_bom(pTHX_ U8 *s)

diff --git a/util.h b/util.h
index e01f0ec..d188e34 100644 (file)
--- a/util.h
+++ b/util.h
@@ -27,7 +27,7 @@
         || ((f)[0] && (f)[1] == ':'))          /* drive name */
 #    else      /* NEITHER DOSISH NOR EPOCISH */
 #      ifdef MACOS_TRADITIONAL
-#        define PERL_FILE_IS_ABSOLUTE(f)       (strchr(f, ':'))
+#        define PERL_FILE_IS_ABSOLUTE(f)       (strchr(f, ':') && *(f) != ':')
 #      else /* !MACOS_TRADITIONAL */
 #        define PERL_FILE_IS_ABSOLUTE(f)       (*(f) == '/')
 #      endif /* MACOS_TRADITIONAL */