From: Nick Ing-Simmons Date: Sat, 27 Apr 2002 12:32:41 +0000 (+0000) Subject: Integrate mainline X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=13e28e4cdde09b7e9e7692148b86222565bcbf1d;p=p5sagit%2Fp5-mst-13.2.git Integrate mainline p4raw-id: //depot/perlio@16209 --- diff --git a/MANIFEST b/MANIFEST index 72c4435..a82187f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2523,7 +2523,6 @@ t/op/subst_amp.t See if $&-related substitution works t/op/subst_wamp.t See if substitution works with $& present t/op/sub_lval.t See if lvalue subroutines work t/op/sysio.t See if sysread and syswrite work -t/op/system_tests Test runner for system.t t/op/taint.t See if tainting works t/op/tie.t See if tie/untie functions work t/op/tiearray.t See if tie for arrays works @@ -2599,6 +2598,7 @@ t/uni/title.t See if Unicode casing works t/uni/upper.t See if Unicode casing works t/win32/longpath.t Test if Win32::GetLongPathName() works t/win32/system.t See if system works in Win* +t/win32/system_tests Test runner for system.t t/x2p/s2p.t See if s2p/psed work taint.c Tainting code thrdvar.h Per-thread variables diff --git a/ext/Digest/MD5/t/files.t b/ext/Digest/MD5/t/files.t index 1a1f032..65ecb54 100644 --- a/ext/Digest/MD5/t/files.t +++ b/ext/Digest/MD5/t/files.t @@ -16,7 +16,7 @@ my $EXPECT; if (ord('A') == 193) { # EBCDIC $EXPECT = < c_r. else echo "$0: You need to install the GNU pth. Aborting." >&4 @@ -101,6 +98,9 @@ esac EOCBU # Recognize the NetBSD packages collection. -# GDBM might be here. -test -d /usr/pkg/lib && loclibpth="$loclibpth /usr/pkg/lib" +# GDBM might be here, pth might be there. +if test -d /usr/pkg/lib; then + loclibpth="$loclibpth /usr/pkg/lib" + ldflags="$ldflags -R/usr/pkg/lib" +fi test -d /usr/pkg/include && locincpth="$locincpth /usr/pkg/include" diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 9a8c4dc..2e11663 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -2296,7 +2296,9 @@ sub installbin { EXE_FILES = @{$self->{EXE_FILES}} } . ($Is_Win32 - ? q{FIXIN = pl2bat.bat + ? exists $ENV{PERL_CORE} + ? q{FIXIN = bin\pl2bat.bat +} : q{FIXIN = pl2bat.bat } : q{FIXIN = $(PERLRUN) "-MExtUtils::MY" \ -e "MY->fixin(shift)" }).qq{ diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm index a8f2e49..faef1d7 100644 --- a/lib/Time/Local.pm +++ b/lib/Time/Local.pm @@ -19,25 +19,36 @@ my $Breakpoint = ($ThisYear + 50) % 100; my $NextCentury = $ThisYear - $ThisYear % 100; $NextCentury += 100 if $Breakpoint < 50; my $Century = $NextCentury - 100; +my $SecOff = 0; my (%Options, %Cheat); +my $MaxInt = ((1<<(8 * $Config{intsize} - 2))-1)*2 + 1; +my $MaxDay = int(($MaxInt-43200)/86400)-1; + # Determine the EPOC day for this machine my $Epoc = 0; if ($^O eq 'vos') { # work around posix-977 -- VOS doesn't handle dates in # the range 1970-1980. $Epoc = _daygm((0, 0, 0, 1, 0, 70, 4, 0)); -} else { +} +elsif ($^O eq 'MacOS') { + no integer; + + $MaxDay *=2 if $^O eq 'MacOS'; # time_t unsigned ... quick hack? + # MacOS time() is seconds since 1 Jan 1904, localtime + # so we need to calculate an offset to apply later + $Epoc = 693901; + $SecOff = timelocal(localtime(0)) - timelocal(gmtime(0)); + $Epoc += _daygm(gmtime(0)); +} +else { $Epoc = _daygm(gmtime(0)); } %Cheat=(); # clear the cache as epoc has changed -my $MaxInt = ((1<<(8 * $Config{intsize} - 2))-1)*2 + 1; -my $MaxDay = int(($MaxInt-43200)/86400)-1; - - sub _daygm { $_[3] + ($Cheat{pack("ss",@_[4,5])} ||= do { my $month = ($_[4] + 10) % 12; @@ -48,7 +59,11 @@ sub _daygm { sub _timegm { - $_[0] + 60 * $_[1] + 3600 * $_[2] + 86400 * &_daygm; + my $sec = $SecOff + $_[0] + 60 * $_[1] + 3600 * $_[2]; + + no integer; + + $sec + 86400 * &_daygm; } @@ -86,7 +101,11 @@ sub timegm { croak "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)"; } - $sec + 60*$min + 3600*$hour + 86400*$days; + $sec += $SecOff + 60*$min + 3600*$hour; + + no integer; + + $sec + 86400*$days; } @@ -97,6 +116,7 @@ sub timegm_nocheck { sub timelocal { + no integer; my $ref_t = &timegm; my $loc_t = _timegm(localtime($ref_t)); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 6ebef87..0ebd999 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2262,6 +2262,12 @@ MPE/iX update after Perl 5.6.0. See README.mpeix. =item * +NetBSD/threads: try installing the GNU pth (should be in the +packages collection, or http://www.gnu.org/software/pth/), +and Configure with -Duseithreads. + +=item * + NetBSD/sparc Perl now works on NetBSD/sparc. diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 60be5b9..0a6b8e1 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -548,6 +548,12 @@ Should overload be 'contagious' through @ISA so that derived classes would inherit their base classes' overload definitions? What to do in case of overload conflicts? +=head2 Taint rethink + +Should taint be stopped from affecting control flow, if ($tainted)? +Should tainted symbolic method calls and subref calls be stopped? +(Look at Ruby's $SAFE levels for inspiration?) + =head1 Vague ideas Ideas which have been discussed, and which may or may not happen. diff --git a/pp_ctl.c b/pp_ctl.c index b2499eb..d461873 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2976,6 +2976,17 @@ PP(pp_require) tryname = name; tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE); } +#ifdef MACOS_TRADITIONAL + if (!tryrsfp) { + char newname[256]; + + MacPerl_CanonDir(name, newname, 1); + if (path_is_absolute(newname)) { + tryname = newname; + tryrsfp = doopen_pmc(newname,PERL_SCRIPT_MODE); + } + } +#endif if (!tryrsfp) { AV *ar = GvAVn(PL_incgv); I32 i; @@ -3109,8 +3120,11 @@ PP(pp_require) ) { char *dir = SvPVx(dirsv, n_a); #ifdef MACOS_TRADITIONAL - char buf[256]; - Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf), name+(name[0] == ':')); + char buf1[256]; + char buf2[256]; + + MacPerl_CanonDir(name, buf2, 1); + Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf1, 0), buf2+(buf2[0] == ':')); #else #ifdef VMS char *unixdir; @@ -3124,14 +3138,6 @@ PP(pp_require) #endif TAINT_PROPER("require"); tryname = SvPVX(namesv); -#ifdef MACOS_TRADITIONAL - { - /* Convert slashes in the name part, but not the directory part, to colons */ - char * colon; - for (colon = tryname+strlen(dir); colon = strchr(colon, '/'); ) - *colon++ = ':'; - } -#endif tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE); if (tryrsfp) { if (tryname[0] == '.' && tryname[1] == '/') @@ -3743,7 +3749,7 @@ S_path_is_absolute(pTHX_ char *name) { if (PERL_FILE_IS_ABSOLUTE(name) #ifdef MACOS_TRADITIONAL - || (*name == ':' && name[1] != ':' && strchr(name+2, ':'))) + || (*name == ':')) #else || (*name == '.' && (name[1] == '/' || (name[1] == '.' && name[2] == '/')))) diff --git a/t/japh/abigail.t b/t/japh/abigail.t index 06bba7a..2391073 100644 --- a/t/japh/abigail.t +++ b/t/japh/abigail.t @@ -223,11 +223,11 @@ plan tests => 130; END {unlink_all $progfile} my @programs = (<< ' --', << ' --'); -#!./perl -- # No trailing newline after the last line! +#!./perl BEGIN{$|=$SIG{__WARN__}=sub{$_=$_[0];y-_- -;print/(.)"$/;seek _,-open(_ ,"+<$0"),2;truncate _,tell _;close _;exec$0}}//rekcaH_lreP_rehtona_tsuJ -- -#!./perl -- # Remove trailing newline! +#!./perl BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/; truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ -- diff --git a/t/lib/warnings/pp_hot b/t/lib/warnings/pp_hot index 11826b9..7df18af 100644 --- a/t/lib/warnings/pp_hot +++ b/t/lib/warnings/pp_hot @@ -105,6 +105,16 @@ print() on closed filehandle STDIN at - line 4. print() on closed filehandle STDIN at - line 6. (Are you trying to call print() on dirhandle STDIN?) ######## +# pp_hot.c [pp_print] +# [ID 20020425.012] from Dave Steiner +# This goes segv on 5.7.3 +use warnings 'closed' ; +my $fh = *STDOUT{IO}; +close STDOUT or die "Can't close STDOUT"; +print $fh "Shouldn't print anything, but shouldn't SEGV either\n"; +EXPECT +print() on closed filehandle at - line 7. +######## # pp_hot.c [pp_rv2av] use warnings 'uninitialized' ; my $a = undef ; diff --git a/t/win32/system.t b/t/win32/system.t index 5384d7c..c08fb13 100644 --- a/t/win32/system.t +++ b/t/win32/system.t @@ -96,7 +96,7 @@ chdir($testdir); END { chdir($cwd) && rmtree("$cwd/$testdir") if -d "$cwd/$testdir"; } -if (open(my $EIN, "$cwd/op/${exename}_exe.uu")) { +if (open(my $EIN, "$cwd/win32/${exename}_exe.uu")) { print "# Unpacking $exename.exe\n"; my $e; { @@ -142,8 +142,8 @@ unless (-x "$testdir/$exename.exe") { exit(0); } -open my $T, "$^X -I../lib -w op/system_tests |" - or die "Can't spawn op/system_tests: $!"; +open my $T, "$^X -I../lib -w win32/system_tests |" + or die "Can't spawn win32/system_tests: $!"; my $expect; my $comment = ""; my $test = 0; diff --git a/t/op/system_tests b/t/win32/system_tests similarity index 100% rename from t/op/system_tests rename to t/win32/system_tests