mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

Integrate mainline

Browse Source 
p4raw-id: //depot/perlio@16209
This commit is contained in:
Nick Ing-Simmons 2002-04-27 12:32:41 +00:00
parent d9dac8cda3
commit 13e28e4cdd
13 changed files with 82 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
MANIFEST
View File

@ -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

2
ext/Digest/MD5/t/files.t
View File

@ -16,7 +16,7 @@ my $EXPECT;
if (ord('A') == 193) { # EBCDIC
$EXPECT = <<EOT;
ee6a09094632cd610199278bbb0f910e ext/Digest/MD5/MD5.pm
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ext/Digest/MD5/MD5.xs
94f873d905cd20a12d8ef4cdbdbcd89f ext/Digest/MD5/MD5.xs
EOT
} else { # ASCII
$EXPECT = <<EOT;

2
ext/Time/HiRes/HiRes.pm
View File

@ -282,7 +282,7 @@ Here is an example of using NVtime from C:
SV **svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
if (!svp) croak("Time::HiRes is required");
if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer");
myNVtime = (double(*)()) SvIV(*svp);
myNVtime = INT2PTR(double(*)(), SvIV(*svp));
printf("The current time is: %f\n", (*myNVtime)());
=head1 CAVEATS

10
hints/netbsd.sh
View File

@ -88,9 +88,6 @@ $define|true|[yY]*)
if pkg_info -qe pth; then
# Add -lpthread.
libswanted="$libswanted pthread"
# -R so that we find the libpthread.so from /usr/pkg/lib
# during Configure and build.
ldflags="-R/usr/pkg/lib $ldflags"
# There is no libc_r as of NetBSD 1.5.2, so no c -> 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"

4
lib/ExtUtils/MM_Unix.pm
View File

@ -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{

34
lib/Time/Local.pm
View File

@ -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));

6
pod/perldelta.pod
View File

@ -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.

6
pod/perltodo.pod
View File

@ -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.

28
pp_ctl.c
View File

@ -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] == '/'))))

4
t/japh/abigail.t
View File

@ -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
--

10
t/lib/warnings/pp_hot
View File

@ -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 <steiner@bakerst.rutgers.edu>
# 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 ;

6
t/win32/system.t
View File

@ -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;

0
t/op/system_tests → t/win32/system_tests
View File