diff options
| -rw-r--r-- | lib/AutoLoader.pm | 13 | ||||
| -rw-r--r-- | lib/AutoSplit.pm | 8 | ||||
| -rw-r--r-- | lib/ExtUtils/MakeMaker.pm | 3 | ||||
| -rw-r--r-- | lib/File/Basename.pm | 10 | ||||
| -rw-r--r-- | makedef.pl | 96 | ||||
| -rw-r--r-- | perl.c | 12 | ||||
| -rw-r--r-- | pp_ctl.c | 13 | ||||
| -rwxr-xr-x | t/lib/basename.t | 27 | ||||
| -rw-r--r-- | toke.c | 11 | ||||
| -rw-r--r-- | util.h | 2 |
10 files changed, 157 insertions, 38 deletions
diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index af33ee80f8..ad6bc4013b 100644 --- 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 8640576cc7..8fcf528101 100644 --- 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 9680348c27..a4cd6f46f7 100644 --- 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 75996f2d08..94aac2dd44 100644 --- 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 6a30fc6ee9..c677458d81 100644 --- 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"; } } @@ -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 && @@ -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 a02aa32cb7..9bee1bfb8b 100755 --- 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"; @@ -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) @@ -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 */ |