Fix CVE-2008-2827, remove old unused patches.
This commit is contained in:
parent
85f75da710
commit
c49219d4ad
16
perl-5.10.0-CVE-2008-2827.patch
Normal file
16
perl-5.10.0-CVE-2008-2827.patch
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
diff -up perl-5.10.0/lib/File/Path.pm.cve perl-5.10.0/lib/File/Path.pm
|
||||||
|
--- perl-5.10.0/lib/File/Path.pm.cve 2007-12-18 11:47:07.000000000 +0100
|
||||||
|
+++ perl-5.10.0/lib/File/Path.pm 2008-06-24 13:25:53.000000000 +0200
|
||||||
|
@@ -351,10 +351,8 @@ sub _rmtree {
|
||||||
|
}
|
||||||
|
|
||||||
|
my $nperm = $perm & 07777 | 0600;
|
||||||
|
- if ($nperm != $perm and not chmod $nperm, $root) {
|
||||||
|
- if ($Force_Writeable) {
|
||||||
|
- _error($arg, "cannot make file writeable", $canon);
|
||||||
|
- }
|
||||||
|
+ if ($Force_Writeable && $nperm != $perm and not chmod $nperm, $root) {
|
||||||
|
+ _error($arg, "cannot make file writeable", $canon);
|
||||||
|
}
|
||||||
|
print "unlink $canon\n" if $arg->{verbose};
|
||||||
|
# delete all versions under VMS
|
@ -1,14 +0,0 @@
|
|||||||
Without this patch, you see weird things like substitutions that turn
|
|
||||||
/var/tmp/nstroot/usr/share/man/man1 to /var/tmp/ntsroot/usr/share/man/$(PREFIX),
|
|
||||||
which is bad.
|
|
||||||
|
|
||||||
--- perl-5.6.0/lib/ExtUtils/MM_Unix.pm Sat Jun 17 16:57:55 2000
|
|
||||||
+++ perl-5.6.0/lib/ExtUtils/MM_Unix.pm Sat Jun 17 16:57:43 2000
|
|
||||||
@@ -3097,6 +3097,7 @@
|
|
||||||
|
|
||||||
sub prefixify {
|
|
||||||
my($self,$var,$sprefix,$rprefix) = @_;
|
|
||||||
+ return if (length($sprefix) <= 0);
|
|
||||||
$self->{uc $var} ||= $Config{lc $var};
|
|
||||||
$self->{uc $var} = VMS::Filespec::unixpath($self->{uc $var}) if $Is_VMS;
|
|
||||||
$self->{uc $var} =~ s/\Q$sprefix\E/$rprefix/s;
|
|
@ -1,30 +0,0 @@
|
|||||||
--- perl-5.7.3/perl.c.syslog Thu May 23 22:26:46 2002
|
|
||||||
+++ perl-5.7.3/perl.c Thu May 23 22:28:55 2002
|
|
||||||
@@ -21,6 +21,10 @@
|
|
||||||
#include <unistd.h>
|
|
||||||
#endif
|
|
||||||
|
|
||||||
+#ifdef I_SYSLOG
|
|
||||||
+#include <syslog.h>
|
|
||||||
+#endif
|
|
||||||
+
|
|
||||||
#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE) && !defined(PERL_MICRO)
|
|
||||||
char *getenv (char *); /* Usually in <stdlib.h> */
|
|
||||||
#endif
|
|
||||||
@@ -3017,6 +3021,16 @@
|
|
||||||
if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
|
|
||||||
tmpstatbuf.st_ino != PL_statbuf.st_ino) {
|
|
||||||
(void)PerlIO_close(PL_rsfp);
|
|
||||||
+#ifdef I_SYSLOG
|
|
||||||
+ openlog("suidperl", LOG_CONS | LOG_PID | LOG_NDELAY, LOG_AUTHPRIV);
|
|
||||||
+ syslog(LOG_ALERT, "User %ld tried to run dev %ld ino %ld in "
|
|
||||||
+ "place of dev %ld ino %ld!", PL_uid,
|
|
||||||
+ (long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
|
|
||||||
+ (long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino);
|
|
||||||
+ syslog(LOG_ALERT, "Filename of setuid script was %s, uid %"
|
|
||||||
+ Uid_t_f" gid %"Gid_t_f".", CopFILE(PL_curcop),
|
|
||||||
+ PL_statbuf.st_uid, PL_statbuf.st_gid);
|
|
||||||
+#endif
|
|
||||||
Perl_croak(aTHX_ "Permission denied\n");
|
|
||||||
}
|
|
||||||
if (
|
|
@ -1,40 +0,0 @@
|
|||||||
--- perl-5.8.0/lib/CPAN/FirstTime.pm.links 2002-08-15 14:58:47.000000000 -0400
|
|
||||||
+++ perl-5.8.0/lib/CPAN/FirstTime.pm 2002-08-15 14:59:07.000000000 -0400
|
|
||||||
@@ -258,7 +258,7 @@
|
|
||||||
my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
|
|
||||||
local $^W = $old_warn;
|
|
||||||
my $progname;
|
|
||||||
- for $progname (qw/gzip tar unzip make lynx wget ncftpget ncftp ftp gpg/){
|
|
||||||
+ for $progname (qw/gzip tar unzip make links wget ncftpget ncftp ftp gpg/){
|
|
||||||
if ($^O eq 'MacOS') {
|
|
||||||
$CPAN::Config->{$progname} = 'not_here';
|
|
||||||
next;
|
|
||||||
--- perl-5.8.0/lib/CPAN.pm.links 2002-08-15 14:58:37.000000000 -0400
|
|
||||||
+++ perl-5.8.0/lib/CPAN.pm 2002-08-15 15:00:08.000000000 -0400
|
|
||||||
@@ -2528,7 +2528,7 @@
|
|
||||||
|
|
||||||
$self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
|
|
||||||
my($f,$funkyftp);
|
|
||||||
- for $f ('lynx','ncftpget','ncftp','wget') {
|
|
||||||
+ for $f ('links','ncftpget','ncftp','wget') {
|
|
||||||
next unless exists $CPAN::Config->{$f};
|
|
||||||
$funkyftp = $CPAN::Config->{$f};
|
|
||||||
next unless defined $funkyftp;
|
|
||||||
@@ -2537,7 +2537,7 @@
|
|
||||||
($asl_ungz = $aslocal) =~ s/\.gz//;
|
|
||||||
$asl_gz = "$asl_ungz.gz";
|
|
||||||
my($src_switch) = "";
|
|
||||||
- if ($f eq "lynx"){
|
|
||||||
+ if ($f eq "links"){
|
|
||||||
$src_switch = " -source";
|
|
||||||
} elsif ($f eq "ncftp"){
|
|
||||||
$src_switch = " -c";
|
|
||||||
@@ -2561,7 +2561,7 @@
|
|
||||||
my($wstatus);
|
|
||||||
if (($wstatus = system($system)) == 0
|
|
||||||
&&
|
|
||||||
- ($f eq "lynx" ?
|
|
||||||
+ ($f eq "links" ?
|
|
||||||
-s $asl_ungz # lynx returns 0 when it fails somewhere
|
|
||||||
: 1
|
|
||||||
)
|
|
@ -1,52 +0,0 @@
|
|||||||
--- perl-5.7.3/Configure.ndbm Mon May 27 13:27:19 2002
|
|
||||||
+++ perl-5.7.3/Configure Mon May 27 13:28:15 2002
|
|
||||||
@@ -1204,7 +1204,7 @@
|
|
||||||
|
|
||||||
: List of libraries we want.
|
|
||||||
: If anyone needs -lnet, put it in a hint file.
|
|
||||||
-libswanted='sfio socket bind inet nsl nm ndbm gdbm dbm db malloc dl'
|
|
||||||
+libswanted='sfio socket bind inet nsl nm gdbm dbm db malloc dl'
|
|
||||||
libswanted="$libswanted dld ld sun m c cposix posix"
|
|
||||||
libswanted="$libswanted ndir dir crypt sec"
|
|
||||||
libswanted="$libswanted ucb bsd BSD PW x util"
|
|
||||||
@@ -18695,40 +18695,6 @@
|
|
||||||
set mntent.h i_mntent
|
|
||||||
eval $inhdr
|
|
||||||
|
|
||||||
-: see if ndbm.h is available
|
|
||||||
-set ndbm.h t_ndbm
|
|
||||||
-eval $inhdr
|
|
||||||
-
|
|
||||||
-case "$t_ndbm" in
|
|
||||||
-$undef)
|
|
||||||
- # Some Linux distributions such as RedHat 7.1 put the
|
|
||||||
- # ndbm.h header in /usr/include/gdbm/ndbm.h.
|
|
||||||
- if $test -f /usr/include/gdbm/ndbm.h; then
|
|
||||||
- echo '<gdbm/ndbm.h> found.'
|
|
||||||
- ccflags="$ccflags -I/usr/include/gdbm"
|
|
||||||
- cppflags="$cppflags -I/usr/include/gdbm"
|
|
||||||
- t_ndbm=$define
|
|
||||||
- fi
|
|
||||||
- ;;
|
|
||||||
-esac
|
|
||||||
-
|
|
||||||
-case "$t_ndbm" in
|
|
||||||
-$define)
|
|
||||||
- : see if dbm_open exists
|
|
||||||
- set dbm_open d_dbm_open
|
|
||||||
- eval $inlibc
|
|
||||||
- case "$d_dbm_open" in
|
|
||||||
- $undef)
|
|
||||||
- t_ndbm="$undef"
|
|
||||||
- echo "We won't be including <ndbm.h>"
|
|
||||||
- ;;
|
|
||||||
- esac
|
|
||||||
- ;;
|
|
||||||
-esac
|
|
||||||
-val="$t_ndbm"
|
|
||||||
-set i_ndbm
|
|
||||||
-eval $setvar
|
|
||||||
-
|
|
||||||
: see if net/errno.h is available
|
|
||||||
val=''
|
|
||||||
set net/errno.h val
|
|
@ -1,15 +0,0 @@
|
|||||||
Remove the THREADS_HAVE_PIDS hint for NTPL-enabled Linux
|
|
||||||
systems. Otherwise ppids are cached too aggressively,
|
|
||||||
resulting in broken behavior.
|
|
||||||
|
|
||||||
--- perl-5.8.0/hints/linux.sh.nptl 2004-12-01 12:38:16.021664783 -0500
|
|
||||||
+++ perl-5.8.0/hints/linux.sh 2004-12-01 12:38:28.213470553 -0500
|
|
||||||
@@ -249,7 +249,7 @@
|
|
||||||
cat > UU/usethreads.cbu <<'EOCBU'
|
|
||||||
case "$usethreads" in
|
|
||||||
$define|true|[yY]*)
|
|
||||||
- ccflags="-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS $ccflags"
|
|
||||||
+ ccflags="-D_REENTRANT -D_GNU_SOURCE $ccflags"
|
|
||||||
set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
|
|
||||||
shift
|
|
||||||
libswanted="$*"
|
|
@ -1,35 +0,0 @@
|
|||||||
Fix for CAN-2004-0452. Change chmod's to make files writable/executable
|
|
||||||
by the current user only and not by the entire world. chmod's necessary
|
|
||||||
in the first place but at least this makes them less dangerous. If, for
|
|
||||||
some reason the rm process dies halfway through, at worst some files and
|
|
||||||
dirs were revoked from others, not made available.
|
|
||||||
|
|
||||||
--- perl-5.8.0/lib/File/Path.pm.chmod 2004-11-23 10:41:57.594065752 -0500
|
|
||||||
+++ perl-5.8.0/lib/File/Path.pm 2004-11-23 10:43:41.453380351 -0500
|
|
||||||
@@ -184,7 +184,7 @@
|
|
||||||
# it's also intended to change it to writable in case we have
|
|
||||||
# to recurse in which case we are better than rm -rf for
|
|
||||||
# subtrees with strange permissions
|
|
||||||
- chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
|
|
||||||
+ chmod(0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
|
|
||||||
or carp "Can't make directory $root read+writeable: $!"
|
|
||||||
unless $safe;
|
|
||||||
|
|
||||||
@@ -218,7 +218,7 @@
|
|
||||||
print "skipped $root\n" if $verbose;
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
- chmod 0777, $root
|
|
||||||
+ chmod 0700, $root
|
|
||||||
or carp "Can't make directory $root writeable: $!"
|
|
||||||
if $force_writeable;
|
|
||||||
print "rmdir $root\n" if $verbose;
|
|
||||||
@@ -240,7 +240,7 @@
|
|
||||||
print "skipped $root\n" if $verbose;
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
- chmod 0666, $root
|
|
||||||
+ chmod 0600, $root
|
|
||||||
or carp "Can't make file $root writeable: $!"
|
|
||||||
if $force_writeable;
|
|
||||||
print "unlink $root\n" if $verbose;
|
|
@ -1,12 +0,0 @@
|
|||||||
--- perl-5.8.0/Makefile.SH.makerpath 2002-12-31 10:15:21.000000000 -0500
|
|
||||||
+++ perl-5.8.0/Makefile.SH 2002-12-31 10:34:13.000000000 -0500
|
|
||||||
@@ -110,6 +110,9 @@
|
|
||||||
case "$osname" in
|
|
||||||
os390) test -f /bin/env && ldlibpth="/bin/env $ldlibpth"
|
|
||||||
;;
|
|
||||||
+linux*)
|
|
||||||
+ ldlibpth="LD_PRELOAD=`pwd`/libperl.so $ldlibpth"
|
|
||||||
+ ;;
|
|
||||||
esac
|
|
||||||
|
|
||||||
: Prepare dependency lists for Makefile.
|
|
@ -1,12 +0,0 @@
|
|||||||
--- perl-5.8.0/Makefile.SH.sharedlinker Tue Jun 18 12:36:27 2002
|
|
||||||
+++ perl-5.8.0/Makefile.SH Tue Jun 18 12:37:31 2002
|
|
||||||
@@ -61,6 +61,9 @@
|
|
||||||
netbsd*|freebsd[234]*|openbsd*)
|
|
||||||
linklibperl="-L. -lperl"
|
|
||||||
;;
|
|
||||||
+ linux*)
|
|
||||||
+ shrpldflags="$shrpldflags $ldflags $perllibs $cryptlib"
|
|
||||||
+ ;;
|
|
||||||
aix*)
|
|
||||||
shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp"
|
|
||||||
case "$osvers" in
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.1-RC4/Configure.fpic 2003-08-02 00:47:58.000000000 -0400
|
|
||||||
+++ perl-5.8.1-RC4/Configure 2003-08-02 00:50:08.000000000 -0400
|
|
||||||
@@ -7501,7 +7501,7 @@
|
|
||||||
;;
|
|
||||||
*) case "$osname" in
|
|
||||||
darwin) dflt='none' ;;
|
|
||||||
- svr4*|esix*|solaris|nonstopux) dflt='-fPIC' ;;
|
|
||||||
+ linux*|svr4*|esix*|solaris|nonstopux) dflt='-fPIC' ;;
|
|
||||||
*) dflt='-fpic' ;;
|
|
||||||
esac ;;
|
|
||||||
esac ;;
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.1-RC4/ext/threads/Makefile.PL.lpthread Wed Aug 6 20:09:07 2003
|
|
||||||
+++ perl-5.8.1-RC4/ext/threads/Makefile.PL Wed Aug 6 20:09:22 2003
|
|
||||||
@@ -10,7 +10,7 @@
|
|
||||||
(ABSTRACT_FROM => 'threads.pm', # retrieve abstract from module
|
|
||||||
AUTHOR => 'Artur Bergman <artur@contiller.se>') : ()),
|
|
||||||
'MAN3PODS' => {}, # Pods will be built by installman
|
|
||||||
- 'LIBS' => [''], # e.g., '-lm'
|
|
||||||
+ 'LIBS' => ['-lpthread'], # e.g., '-lm'
|
|
||||||
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
|
|
||||||
# Insert -I. if you add *.h files later:
|
|
||||||
# 'INC' => '', # e.g., '-I/usr/include/other'
|
|
@ -1,12 +0,0 @@
|
|||||||
--- perl-5.8.3/lib/ExtUtils/MM_Unix.pm.orig 2004-03-05 15:04:56.000000000 +0000
|
|
||||||
+++ perl-5.8.3/lib/ExtUtils/MM_Unix.pm 2004-03-05 15:05:20.000000000 +0000
|
|
||||||
@@ -1135,7 +1135,7 @@
|
|
||||||
}
|
|
||||||
|
|
||||||
push(@m,
|
|
||||||
-' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
|
|
||||||
+' $(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
|
|
||||||
' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) '.$libs.' $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) $(INST_DYNAMIC_FIX)');
|
|
||||||
push @m, '
|
|
||||||
$(CHMOD) $(PERM_RWX) $@
|
|
||||||
|
|
@ -1,40 +0,0 @@
|
|||||||
--- perl-5.8.3/perl.c.fullinc 2004-02-15 10:39:38.947636711 -0500
|
|
||||||
+++ perl-5.8.3/perl.c 2004-02-15 10:40:27.399370941 -0500
|
|
||||||
@@ -4163,23 +4163,17 @@
|
|
||||||
libdir,
|
|
||||||
(int)PERL_REVISION, (int)PERL_VERSION,
|
|
||||||
(int)PERL_SUBVERSION, ARCHNAME);
|
|
||||||
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
|
|
||||||
- S_ISDIR(tmpstatbuf.st_mode))
|
|
||||||
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
|
|
||||||
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
|
|
||||||
|
|
||||||
/* .../version if -d .../version */
|
|
||||||
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 &&
|
|
||||||
- S_ISDIR(tmpstatbuf.st_mode))
|
|
||||||
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
|
|
||||||
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
|
|
||||||
|
|
||||||
/* .../archname if -d .../archname */
|
|
||||||
Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, ARCHNAME);
|
|
||||||
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
|
|
||||||
- S_ISDIR(tmpstatbuf.st_mode))
|
|
||||||
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
|
|
||||||
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
|
|
||||||
}
|
|
||||||
|
|
||||||
#ifdef PERL_INC_VERSION_LIST
|
|
||||||
@@ -4187,9 +4181,7 @@
|
|
||||||
for (incver = incverlist; *incver; incver++) {
|
|
||||||
/* .../xxx if -d .../xxx */
|
|
||||||
Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, *incver);
|
|
||||||
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
|
|
||||||
- S_ISDIR(tmpstatbuf.st_mode))
|
|
||||||
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
|
|
||||||
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#endif
|
|
@ -1,52 +0,0 @@
|
|||||||
--- perl-5.8.0/utils/perlbug.PL.perlbug 2004-10-05 12:07:54.423998839 -0400
|
|
||||||
+++ perl-5.8.0/utils/perlbug.PL 2004-10-05 12:08:37.607393368 -0400
|
|
||||||
@@ -27,8 +27,6 @@
|
|
||||||
open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
|
|
||||||
or die "Can't open patchlevel.h: $!";
|
|
||||||
|
|
||||||
-my $patchlevel_date = (stat PATCH_LEVEL)[9];
|
|
||||||
-
|
|
||||||
while (<PATCH_LEVEL>) {
|
|
||||||
last if $_ =~ /^\s*static\s+char.*?local_patches\[\]\s*=\s*{\s*$/;
|
|
||||||
}
|
|
||||||
@@ -64,9 +62,8 @@
|
|
||||||
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
|
|
||||||
if \$running_under_some_shell;
|
|
||||||
|
|
||||||
-my \$config_tag1 = '$extract_version - $Config{cf_time}';
|
|
||||||
+my \$config_tag1 = '$extract_version';
|
|
||||||
|
|
||||||
-my \$patchlevel_date = $patchlevel_date;
|
|
||||||
my \$patch_tags = '$patch_tags';
|
|
||||||
my \@patches = (
|
|
||||||
$patch_desc
|
|
||||||
@@ -275,17 +272,6 @@
|
|
||||||
$ok = 0;
|
|
||||||
if ($::opt_o) {
|
|
||||||
if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
|
|
||||||
- my $age = time - $patchlevel_date;
|
|
||||||
- if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
|
|
||||||
- my $date = localtime $patchlevel_date;
|
|
||||||
- print <<"EOF";
|
|
||||||
-"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
|
|
||||||
-are more than 60 days old. This Perl version was constructed on
|
|
||||||
-$date. If you really want to report this, use
|
|
||||||
-"perlbug -okay" or "perlbug -nokay".
|
|
||||||
-EOF
|
|
||||||
- exit();
|
|
||||||
- }
|
|
||||||
# force these options
|
|
||||||
unless ($::opt_n) {
|
|
||||||
$::opt_S = 1; # don't prompt for send
|
|
||||||
@@ -592,9 +578,8 @@
|
|
||||||
print OUT <<EFF;
|
|
||||||
---
|
|
||||||
EFF
|
|
||||||
- print OUT "This perlbug was built using Perl $config_tag1\n",
|
|
||||||
- "It is being executed now by Perl $config_tag2.\n\n"
|
|
||||||
- if $config_tag2 ne $config_tag1;
|
|
||||||
+ print OUT "This perlbug was built using Perl $config_tag1 in the Red Hat build system.\n",
|
|
||||||
+ "It is being executed now by Perl $config_tag2.\n\n";
|
|
||||||
|
|
||||||
print OUT <<EOF;
|
|
||||||
Site configuration information for perl $perl_version:
|
|
@ -1,22 +0,0 @@
|
|||||||
Index: perlio.c
|
|
||||||
===================================================================
|
|
||||||
--- perlio.c (revision 4342)
|
|
||||||
+++ perlio.c (revision 4346)
|
|
||||||
@@ -454,7 +454,7 @@
|
|
||||||
va_list ap;
|
|
||||||
dSYS;
|
|
||||||
va_start(ap, fmt);
|
|
||||||
- if (!dbg) {
|
|
||||||
+ if (!dbg && !PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
|
|
||||||
char *s = PerlEnv_getenv("PERLIO_DEBUG");
|
|
||||||
if (s && *s)
|
|
||||||
dbg = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
|
|
||||||
@@ -471,7 +471,7 @@
|
|
||||||
s = CopFILE(PL_curcop);
|
|
||||||
if (!s)
|
|
||||||
s = "(none)";
|
|
||||||
- sprintf(buffer, "%s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
|
|
||||||
+ sprintf(buffer, "%.40s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
|
|
||||||
len = strlen(buffer);
|
|
||||||
vsprintf(buffer+len, fmt, ap);
|
|
||||||
PerlLIO_write(dbg, buffer, strlen(buffer));
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.5/perl.c.dashI 2004-10-01 12:40:40.323519280 -0400
|
|
||||||
+++ perl-5.8.5/perl.c 2004-10-01 12:40:46.159626512 -0400
|
|
||||||
@@ -1421,7 +1421,7 @@
|
|
||||||
char *p;
|
|
||||||
STRLEN len = strlen(s);
|
|
||||||
p = savepvn(s, len);
|
|
||||||
- incpush(p, TRUE, TRUE, FALSE);
|
|
||||||
+ incpush(p, FALSE, FALSE, FALSE);
|
|
||||||
sv_catpvn(sv, "-I", 2);
|
|
||||||
sv_catpvn(sv, p, len);
|
|
||||||
sv_catpvn(sv, " ", 1);
|
|
@ -1,46 +0,0 @@
|
|||||||
--- perl-5.8.5/perl.c.incorder 2005-03-08 16:11:32.722330404 -0500
|
|
||||||
+++ perl-5.8.5/perl.c 2005-03-08 16:12:04.738580672 -0500
|
|
||||||
@@ -4287,9 +4287,6 @@
|
|
||||||
incpush(APPLLIB_EXP, TRUE, TRUE, TRUE);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-#ifdef ARCHLIB_EXP
|
|
||||||
- incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE);
|
|
||||||
-#endif
|
|
||||||
#ifdef MACOS_TRADITIONAL
|
|
||||||
{
|
|
||||||
Stat_t tmpstatbuf;
|
|
||||||
@@ -4311,14 +4308,6 @@
|
|
||||||
if (!PL_tainting)
|
|
||||||
incpush(":", FALSE, FALSE, TRUE);
|
|
||||||
#else
|
|
||||||
-#ifndef PRIVLIB_EXP
|
|
||||||
-# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
|
|
||||||
-#endif
|
|
||||||
-#if defined(WIN32)
|
|
||||||
- incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE);
|
|
||||||
-#else
|
|
||||||
- incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE);
|
|
||||||
-#endif
|
|
||||||
|
|
||||||
#ifdef SITEARCH_EXP
|
|
||||||
/* sitearch is always relative to sitelib on Windows for
|
|
||||||
@@ -4367,6 +4356,18 @@
|
|
||||||
incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
+#ifdef ARCHLIB_EXP
|
|
||||||
+ incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE);
|
|
||||||
+#endif
|
|
||||||
+#ifndef PRIVLIB_EXP
|
|
||||||
+# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
|
|
||||||
+#endif
|
|
||||||
+#if defined(WIN32)
|
|
||||||
+ incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE);
|
|
||||||
+#else
|
|
||||||
+ incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE);
|
|
||||||
+#endif
|
|
||||||
+
|
|
||||||
if (!PL_tainting)
|
|
||||||
incpush(".", FALSE, FALSE, TRUE);
|
|
||||||
#endif /* MACOS_TRADITIONAL */
|
|
@ -1,142 +0,0 @@
|
|||||||
https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=158036
|
|
||||||
|
|
||||||
diff -ruN perl-5.8.6-cgi308/lib/CGI/t/form.t perl-5.8.6-cgi310/lib/CGI/t/form.t
|
|
||||||
--- perl-5.8.6-cgi308/lib/CGI/t/form.t 2005-05-15 01:20:29.910116896 +0100
|
|
||||||
+++ perl-5.8.6-cgi310/lib/CGI/t/form.t 2005-05-05 21:14:56.000000000 +0100
|
|
||||||
@@ -33,43 +33,43 @@
|
|
||||||
"start_form()");
|
|
||||||
|
|
||||||
is(submit(),
|
|
||||||
- qq(<input type="submit" tabindex="0" name=".submit" />),
|
|
||||||
+ qq(<input type="submit" tabindex="1" name=".submit" />),
|
|
||||||
"submit()");
|
|
||||||
|
|
||||||
is(submit(-name => 'foo',
|
|
||||||
-value => 'bar'),
|
|
||||||
- qq(<input type="submit" tabindex="1" name="foo" value="bar" />),
|
|
||||||
+ qq(<input type="submit" tabindex="2" name="foo" value="bar" />),
|
|
||||||
"submit(-name,-value)");
|
|
||||||
|
|
||||||
is(submit({-name => 'foo',
|
|
||||||
-value => 'bar'}),
|
|
||||||
- qq(<input type="submit" tabindex="2" name="foo" value="bar" />),
|
|
||||||
+ qq(<input type="submit" tabindex="3" name="foo" value="bar" />),
|
|
||||||
"submit({-name,-value})");
|
|
||||||
|
|
||||||
is(textfield(-name => 'weather'),
|
|
||||||
- qq(<input type="text" name="weather" tabindex="3" value="dull" />),
|
|
||||||
+ qq(<input type="text" name="weather" tabindex="4" value="dull" />),
|
|
||||||
"textfield({-name})");
|
|
||||||
|
|
||||||
is(textfield(-name => 'weather',
|
|
||||||
-value => 'nice'),
|
|
||||||
- qq(<input type="text" name="weather" tabindex="4" value="dull" />),
|
|
||||||
+ qq(<input type="text" name="weather" tabindex="5" value="dull" />),
|
|
||||||
"textfield({-name,-value})");
|
|
||||||
|
|
||||||
is(textfield(-name => 'weather',
|
|
||||||
-value => 'nice',
|
|
||||||
-override => 1),
|
|
||||||
- qq(<input type="text" name="weather" tabindex="5" value="nice" />),
|
|
||||||
+ qq(<input type="text" name="weather" tabindex="6" value="nice" />),
|
|
||||||
"textfield({-name,-value,-override})");
|
|
||||||
|
|
||||||
is(checkbox(-name => 'weather',
|
|
||||||
-value => 'nice'),
|
|
||||||
- qq(<label><input type="checkbox" name="weather" value="nice" tabindex="6" />weather</label>),
|
|
||||||
+ qq(<label><input type="checkbox" name="weather" value="nice" tabindex="7" />weather</label>),
|
|
||||||
"checkbox()");
|
|
||||||
|
|
||||||
is(checkbox(-name => 'weather',
|
|
||||||
-value => 'nice',
|
|
||||||
-label => 'forecast'),
|
|
||||||
- qq(<label><input type="checkbox" name="weather" value="nice" tabindex="7" />forecast</label>),
|
|
||||||
+ qq(<label><input type="checkbox" name="weather" value="nice" tabindex="8" />forecast</label>),
|
|
||||||
"checkbox()");
|
|
||||||
|
|
||||||
is(checkbox(-name => 'weather',
|
|
||||||
@@ -77,41 +77,41 @@
|
|
||||||
-label => 'forecast',
|
|
||||||
-checked => 1,
|
|
||||||
-override => 1),
|
|
||||||
- qq(<label><input type="checkbox" name="weather" value="nice" tabindex="8" checked="checked" />forecast</label>),
|
|
||||||
+ qq(<label><input type="checkbox" name="weather" value="nice" tabindex="9" checked="checked" />forecast</label>),
|
|
||||||
"checkbox()");
|
|
||||||
|
|
||||||
is(checkbox(-name => 'weather',
|
|
||||||
-value => 'dull',
|
|
||||||
-label => 'forecast'),
|
|
||||||
- qq(<label><input type="checkbox" name="weather" value="dull" tabindex="9" checked="checked" />forecast</label>),
|
|
||||||
+ qq(<label><input type="checkbox" name="weather" value="dull" tabindex="10" checked="checked" />forecast</label>),
|
|
||||||
"checkbox()");
|
|
||||||
|
|
||||||
is(radio_group(-name => 'game'),
|
|
||||||
- qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="10" />chess</label> <label><input type="radio" name="game" value="checkers" tabindex="11" />checkers</label>),
|
|
||||||
+ qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="11" />chess</label> <label><input type="radio" name="game" value="checkers" tabindex="12" />checkers</label>),
|
|
||||||
'radio_group()');
|
|
||||||
|
|
||||||
is(radio_group(-name => 'game',
|
|
||||||
-labels => {'chess' => 'ping pong'}),
|
|
||||||
- qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="12" />ping pong</label> <label><input type="radio" name="game" value="checkers" tabindex="13" />checkers</label>),
|
|
||||||
+ qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="13" />ping pong</label> <label><input type="radio" name="game" value="checkers" tabindex="14" />checkers</label>),
|
|
||||||
'radio_group()');
|
|
||||||
|
|
||||||
is(checkbox_group(-name => 'game',
|
|
||||||
-Values => [qw/checkers chess cribbage/]),
|
|
||||||
- qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="14" />checkers</label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="15" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="16" />cribbage</label>),
|
|
||||||
+ qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="15" />checkers</label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="16" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="17" />cribbage</label>),
|
|
||||||
'checkbox_group()');
|
|
||||||
|
|
||||||
is(checkbox_group(-name => 'game',
|
|
||||||
'-values' => [qw/checkers chess cribbage/],
|
|
||||||
'-defaults' => ['cribbage'],
|
|
||||||
-override=>1),
|
|
||||||
- qq(<label><input type="checkbox" name="game" value="checkers" tabindex="17" />checkers</label> <label><input type="checkbox" name="game" value="chess" tabindex="18" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" tabindex="19" />cribbage</label>),
|
|
||||||
+ qq(<label><input type="checkbox" name="game" value="checkers" tabindex="18" />checkers</label> <label><input type="checkbox" name="game" value="chess" tabindex="19" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" tabindex="20" />cribbage</label>),
|
|
||||||
'checkbox_group()');
|
|
||||||
|
|
||||||
is(popup_menu(-name => 'game',
|
|
||||||
'-values' => [qw/checkers chess cribbage/],
|
|
||||||
-default => 'cribbage',
|
|
||||||
-override => 1),
|
|
||||||
- '<select name="game" tabindex="20">
|
|
||||||
+ '<select name="game" tabindex="21">
|
|
||||||
<option value="checkers">checkers</option>
|
|
||||||
<option value="chess">chess</option>
|
|
||||||
<option selected="selected" value="cribbage">cribbage</option>
|
|
||||||
diff -ruN perl-5.8.6-cgi308/lib/CGI.pm perl-5.8.6-cgi310/lib/CGI.pm
|
|
||||||
--- perl-5.8.6-cgi308/lib/CGI.pm 2005-05-15 01:20:29.955110056 +0100
|
|
||||||
+++ perl-5.8.6-cgi310/lib/CGI.pm 2005-05-13 22:46:21.000000000 +0100
|
|
||||||
@@ -18,8 +18,8 @@
|
|
||||||
# The most recent version and complete docs are available at:
|
|
||||||
# http://stein.cshl.org/WWW/software/CGI/
|
|
||||||
|
|
||||||
-$CGI::revision = '$Id: CGI.pm,v 1.179 2005/04/07 22:40:37 lstein Exp $';
|
|
||||||
-$CGI::VERSION=3.08;
|
|
||||||
+$CGI::revision = '$Id: CGI.pm,v 1.181 2005/05/13 21:45:26 lstein Exp $';
|
|
||||||
+$CGI::VERSION='3.10';
|
|
||||||
|
|
||||||
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
|
|
||||||
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
|
|
||||||
@@ -179,11 +179,12 @@
|
|
||||||
if (exists $ENV{MOD_PERL}) {
|
|
||||||
# mod_perl handlers may run system() on scripts using CGI.pm;
|
|
||||||
# Make sure so we don't get fooled by inherited $ENV{MOD_PERL}
|
|
||||||
- if ($ENV{MOD_PERL_API_VERSION} == 2) {
|
|
||||||
+ if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
|
|
||||||
$MOD_PERL = 2;
|
|
||||||
require Apache2::Response;
|
|
||||||
require Apache2::RequestRec;
|
|
||||||
require Apache2::RequestUtil;
|
|
||||||
+ require Apache2::RequestIO;
|
|
||||||
require APR::Pool;
|
|
||||||
} else {
|
|
||||||
$MOD_PERL = 1;
|
|
||||||
@@ -888,6 +889,7 @@
|
|
||||||
|
|
||||||
sub element_tab {
|
|
||||||
my ($self,$new_value) = self_or_default(@_);
|
|
||||||
+ $self->{'.etab'} ||= 1;
|
|
||||||
$self->{'.etab'} = $new_value if defined $new_value;
|
|
||||||
$self->{'.etab'}++;
|
|
||||||
}
|
|
@ -1,12 +0,0 @@
|
|||||||
diff -ruN Filter-Simple-0.78/lib/Filter/Simple.pm Filter-Simple-0.79/lib/Filter/Simple.pm
|
|
||||||
--- Filter-Simple-0.78/lib/Filter/Simple.pm 2002-05-17 00:38:58.000000000 +0100
|
|
||||||
+++ Filter-Simple-0.79/lib/Filter/Simple.pm 2003-09-20 21:02:17.000000000 +0100
|
|
||||||
@@ -4,7 +4,7 @@
|
|
||||||
|
|
||||||
use vars qw{ $VERSION @EXPORT };
|
|
||||||
|
|
||||||
-$VERSION = '0.78';
|
|
||||||
+$VERSION = '0.79';
|
|
||||||
|
|
||||||
use Filter::Util::Call;
|
|
||||||
use Carp;
|
|
@ -1,17 +0,0 @@
|
|||||||
diff -ruN perl-5.8.6-orig/lib/FindBin.pm perl-5.8.6/lib/FindBin.pm
|
|
||||||
--- perl-5.8.6-orig/lib/FindBin.pm 2003-12-27 14:52:04.000000000 +0000
|
|
||||||
+++ perl-5.8.6/lib/FindBin.pm 2005-05-16 04:15:54.000000000 +0100
|
|
||||||
@@ -179,7 +179,12 @@
|
|
||||||
}
|
|
||||||
|
|
||||||
# Get absolute paths to directories
|
|
||||||
- $Bin = abs_path($Bin) if($Bin);
|
|
||||||
+ if ($Bin)
|
|
||||||
+ {
|
|
||||||
+ my $BinOld = $Bin;
|
|
||||||
+ $Bin = abs_path($Bin);
|
|
||||||
+ defined $Bin or $Bin = File::Spec->canonpath($BinOld);
|
|
||||||
+ }
|
|
||||||
$RealBin = abs_path($RealBin) if($RealBin);
|
|
||||||
}
|
|
||||||
}
|
|
@ -1,115 +0,0 @@
|
|||||||
--- perl-5.8.8/config_h.SH.bz172396 2005-10-31 13:13:05.000000000 -0500
|
|
||||||
+++ perl-5.8.8/config_h.SH 2006-05-11 16:20:36.000000000 -0400
|
|
||||||
@@ -1912,7 +1912,18 @@
|
|
||||||
*/
|
|
||||||
#$d_localtime_r HAS_LOCALTIME_R /**/
|
|
||||||
#define LOCALTIME_R_PROTO $localtime_r_proto /**/
|
|
||||||
-
|
|
||||||
+/* LOCALTIME_R_NEEDS_TZSET :
|
|
||||||
+ * many libc's localtime_r implementations do not call tzset,
|
|
||||||
+ * making them differ from localtime(), and making timezone
|
|
||||||
+ * changes using $ENV{TZ} without explicitly calling tzset
|
|
||||||
+ * impossible. This symbol makes us call tzset before localtime_r:
|
|
||||||
+ */
|
|
||||||
+#$d_localtime_r_needs_tzset LOCALTIME_R_NEEDS_TZSET /**/
|
|
||||||
+#ifdef LOCALTIME_R_NEEDS_TZSET
|
|
||||||
+#define L_R_TZSET tzset(),
|
|
||||||
+#else
|
|
||||||
+#define L_R_TZSET
|
|
||||||
+#endif
|
|
||||||
/* HAS_LONG_DOUBLE:
|
|
||||||
* This symbol will be defined if the C compiler supports long
|
|
||||||
* doubles.
|
|
||||||
--- perl-5.8.8/reentr.inc.bz172396 2006-05-11 16:20:36.000000000 -0400
|
|
||||||
+++ perl-5.8.8/reentr.inc 2006-05-11 16:20:36.000000000 -0400
|
|
||||||
@@ -1368,10 +1368,10 @@
|
|
||||||
#ifdef HAS_LOCALTIME_R
|
|
||||||
# undef localtime
|
|
||||||
# if !defined(localtime) && LOCALTIME_R_PROTO == REENTRANT_PROTO_S_TS
|
|
||||||
-# define localtime(a) (localtime_r(a, &PL_reentrant_buffer->_localtime_struct) ? &PL_reentrant_buffer->_localtime_struct : 0)
|
|
||||||
+# define localtime(a) ( L_R_TZSET localtime_r(a, &PL_reentrant_buffer->_localtime_struct) ? &PL_reentrant_buffer->_localtime_struct : 0)
|
|
||||||
# endif
|
|
||||||
# if !defined(localtime) && LOCALTIME_R_PROTO == REENTRANT_PROTO_I_TS
|
|
||||||
-# define localtime(a) (localtime_r(a, &PL_reentrant_buffer->_localtime_struct) == 0 ? &PL_reentrant_buffer->_localtime_struct : 0)
|
|
||||||
+# define localtime(a) ( L_R_TZSET localtime_r(a, &PL_reentrant_buffer->_localtime_struct) == 0 ? &PL_reentrant_buffer->_localtime_struct : 0)
|
|
||||||
# endif
|
|
||||||
#endif /* HAS_LOCALTIME_R */
|
|
||||||
|
|
||||||
--- perl-5.8.8/Configure.bz172396 2006-05-11 16:20:36.000000000 -0400
|
|
||||||
+++ perl-5.8.8/Configure 2006-05-11 16:21:47.000000000 -0400
|
|
||||||
@@ -542,6 +542,7 @@
|
|
||||||
d_libm_lib_version=''
|
|
||||||
d_link=''
|
|
||||||
d_localtime_r=''
|
|
||||||
+d_localtime_r_needs_tzset=''
|
|
||||||
localtime_r_proto=''
|
|
||||||
d_locconv=''
|
|
||||||
d_lockf=''
|
|
||||||
@@ -14261,7 +14262,59 @@
|
|
||||||
*) localtime_r_proto=0
|
|
||||||
;;
|
|
||||||
esac
|
|
||||||
+: see if localtime_r calls tzset
|
|
||||||
+case "$localtime_r_proto" in
|
|
||||||
+REENTRANT_PROTO*)
|
|
||||||
+ $cat >try.c <<EOCP
|
|
||||||
+/* Does our libc's localtime_r call tzset ?
|
|
||||||
+ * return 0 if so, 1 otherwise.
|
|
||||||
+ */
|
|
||||||
+#include <sys/types.h>
|
|
||||||
+#include <unistd.h>
|
|
||||||
+#include <time.h>
|
|
||||||
+#include <string.h>
|
|
||||||
+#include <malloc.h>
|
|
||||||
+int main()
|
|
||||||
+{
|
|
||||||
+ time_t t = time(0L);
|
|
||||||
+ char w_tz[]="TZ=GMT+5",
|
|
||||||
+ e_tz[]="TZ=GMT-5",
|
|
||||||
+ *tz_e = (char*)malloc(16),
|
|
||||||
+ *tz_w = (char*)malloc(16);
|
|
||||||
+ struct tm tm_e, tm_w;
|
|
||||||
+ memset(&tm_e,'\0',sizeof(struct tm));
|
|
||||||
+ memset(&tm_w,'\0',sizeof(struct tm));
|
|
||||||
+ strcpy(tz_e,e_tz);
|
|
||||||
+ strcpy(tz_w,w_tz);
|
|
||||||
|
|
||||||
+ putenv(tz_e);
|
|
||||||
+ localtime_r(&t, &tm_e);
|
|
||||||
+
|
|
||||||
+ putenv(tz_w);
|
|
||||||
+ localtime_r(&t, &tm_w);
|
|
||||||
+
|
|
||||||
+ if( memcmp(&tm_e, &tm_w, sizeof(struct tm)) == 0 )
|
|
||||||
+ return 1;
|
|
||||||
+ return 0;
|
|
||||||
+}
|
|
||||||
+EOCP
|
|
||||||
+ set try
|
|
||||||
+ if eval $compile; then
|
|
||||||
+ if ./try; then
|
|
||||||
+ d_localtime_r_needs_tzset=undef;
|
|
||||||
+ else
|
|
||||||
+ d_localtime_r_needs_tzset=define;
|
|
||||||
+ fi;
|
|
||||||
+ rm -f ./try;
|
|
||||||
+ else
|
|
||||||
+ d_localtime_r_needs_tzset=undef;
|
|
||||||
+ fi;
|
|
||||||
+ rm -f try.c;
|
|
||||||
+ ;;
|
|
||||||
+ *)
|
|
||||||
+ d_localtime_r_needs_tzset=undef;
|
|
||||||
+ ;;
|
|
||||||
+esac
|
|
||||||
: see if localeconv exists
|
|
||||||
set localeconv d_locconv
|
|
||||||
eval $inlibc
|
|
||||||
@@ -21220,6 +21273,7 @@
|
|
||||||
d_libm_lib_version='$d_libm_lib_version'
|
|
||||||
d_link='$d_link'
|
|
||||||
d_localtime_r='$d_localtime_r'
|
|
||||||
+d_localtime_r_needs_tzset='$d_localtime_r_needs_tzset'
|
|
||||||
d_locconv='$d_locconv'
|
|
||||||
d_lockf='$d_lockf'
|
|
||||||
d_longdbl='$d_longdbl'
|
|
File diff suppressed because it is too large
Load Diff
@ -1,184 +0,0 @@
|
|||||||
--- perl-5.8.7/utils/c2ph.PL.CAN-2004-0976 2004-10-19 15:45:42.000000000 -0400
|
|
||||||
+++ perl-5.8.7/utils/c2ph.PL 2005-11-08 12:53:30.000000000 -0500
|
|
||||||
@@ -1320,7 +1320,7 @@
|
|
||||||
$intrinsics{$_[1]} = $template{$_[0]};
|
|
||||||
}
|
|
||||||
close(PIPE) || die "couldn't read intrinsics!";
|
|
||||||
- unlink($TMP, '$SAFEDIR/a.out');
|
|
||||||
+ unlink($TMP, "$SAFEDIR/a.out");
|
|
||||||
print STDERR "done\n" if $trace;
|
|
||||||
}
|
|
||||||
|
|
||||||
--- perl-5.8.7/lib/Memoize/t/tie_storable.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
|
|
||||||
+++ perl-5.8.7/lib/Memoize/t/tie_storable.t 2005-11-08 13:06:13.000000000 -0500
|
|
||||||
@@ -33,14 +33,7 @@
|
|
||||||
|
|
||||||
print "1..4\n";
|
|
||||||
|
|
||||||
-
|
|
||||||
-if (eval {require File::Spec::Functions}) {
|
|
||||||
- File::Spec::Functions->import();
|
|
||||||
-} else {
|
|
||||||
- *catfile = sub { join '/', @_ };
|
|
||||||
-}
|
|
||||||
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
|
|
||||||
-$file = catfile($tmpdir, "storable$$");
|
|
||||||
+$file = "storable$$";
|
|
||||||
1 while unlink $file;
|
|
||||||
tryout('Memoize::Storable', $file, 1); # Test 1..4
|
|
||||||
1 while unlink $file;
|
|
||||||
--- perl-5.8.7/lib/Memoize/t/tie_ndbm.t.CAN-2004-0976 2005-04-22 07:36:58.000000000 -0400
|
|
||||||
+++ perl-5.8.7/lib/Memoize/t/tie_ndbm.t 2005-11-08 13:04:45.000000000 -0500
|
|
||||||
@@ -28,14 +28,7 @@
|
|
||||||
|
|
||||||
print "1..4\n";
|
|
||||||
|
|
||||||
-
|
|
||||||
-if (eval {require File::Spec::Functions}) {
|
|
||||||
- File::Spec::Functions->import();
|
|
||||||
-} else {
|
|
||||||
- *catfile = sub { join '/', @_ };
|
|
||||||
-}
|
|
||||||
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
|
|
||||||
-$file = catfile($tmpdir, "md$$");
|
|
||||||
+$file = "md$$";
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag", "$file.db";
|
|
||||||
tryout('Memoize::NDBM_File', $file, 1); # Test 1..4
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag", "$file.db";
|
|
||||||
--- perl-5.8.7/lib/Memoize/t/tie.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
|
|
||||||
+++ perl-5.8.7/lib/Memoize/t/tie.t 2005-11-08 13:03:20.000000000 -0500
|
|
||||||
@@ -29,14 +29,7 @@
|
|
||||||
$_[0]+1;
|
|
||||||
}
|
|
||||||
|
|
||||||
-if (eval {require File::Spec::Functions}) {
|
|
||||||
- File::Spec::Functions->import('tmpdir', 'catfile');
|
|
||||||
- $tmpdir = tmpdir();
|
|
||||||
-} else {
|
|
||||||
- *catfile = sub { join '/', @_ };
|
|
||||||
- $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
|
|
||||||
-}
|
|
||||||
-$file = catfile($tmpdir, "md$$");
|
|
||||||
+$file = "md$$";
|
|
||||||
@files = ($file, "$file.db", "$file.dir", "$file.pag");
|
|
||||||
1 while unlink @files;
|
|
||||||
|
|
||||||
--- perl-5.8.7/lib/Memoize/t/tie_sdbm.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
|
|
||||||
+++ perl-5.8.7/lib/Memoize/t/tie_sdbm.t 2005-11-08 13:05:32.000000000 -0500
|
|
||||||
@@ -28,14 +28,7 @@
|
|
||||||
|
|
||||||
print "1..4\n";
|
|
||||||
|
|
||||||
-if (eval {require File::Spec::Functions}) {
|
|
||||||
- File::Spec::Functions->import('tmpdir', 'catfile');
|
|
||||||
- $tmpdir = tmpdir();
|
|
||||||
-} else {
|
|
||||||
- *catfile = sub { join '/', @_ };
|
|
||||||
- $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
|
|
||||||
-}
|
|
||||||
-$file = catfile($tmpdir, "md$$");
|
|
||||||
+$file = "md$$";
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag";
|
|
||||||
tryout('Memoize::SDBM_File', $file, 1); # Test 1..4
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag";
|
|
||||||
--- perl-5.8.7/lib/Memoize/t/tie_gdbm.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
|
|
||||||
+++ perl-5.8.7/lib/Memoize/t/tie_gdbm.t 2005-11-08 13:04:03.000000000 -0500
|
|
||||||
@@ -26,13 +26,7 @@
|
|
||||||
|
|
||||||
print "1..4\n";
|
|
||||||
|
|
||||||
-if (eval {require File::Spec::Functions}) {
|
|
||||||
- File::Spec::Functions->import();
|
|
||||||
-} else {
|
|
||||||
- *catfile = sub { join '/', @_ };
|
|
||||||
-}
|
|
||||||
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
|
|
||||||
-$file = catfile($tmpdir, "md$$");
|
|
||||||
+$file = "md$$";
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag";
|
|
||||||
tryout('GDBM_File', $file, 1); # Test 1..4
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag";
|
|
||||||
--- perl-5.8.7/lib/ExtUtils/instmodsh.CAN-2004-0976 2004-01-05 17:34:59.000000000 -0500
|
|
||||||
+++ perl-5.8.7/lib/ExtUtils/instmodsh 2005-11-08 12:42:25.000000000 -0500
|
|
||||||
@@ -2,6 +2,7 @@
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
use IO::File;
|
|
||||||
+use File::Temp;
|
|
||||||
use ExtUtils::Packlist;
|
|
||||||
use ExtUtils::Installed;
|
|
||||||
|
|
||||||
@@ -58,15 +59,14 @@
|
|
||||||
$reply =~ /^t\s*/ and do
|
|
||||||
{
|
|
||||||
my $file = (split(' ', $reply))[1];
|
|
||||||
- my $tmp = "/tmp/inst.$$";
|
|
||||||
- if (my $fh = IO::File->new($tmp, "w"))
|
|
||||||
- {
|
|
||||||
- $fh->print(join("\n", $Inst->files($module)));
|
|
||||||
- $fh->close();
|
|
||||||
- system("tar cvf $file -I $tmp");
|
|
||||||
- unlink($tmp);
|
|
||||||
- last CASE;
|
|
||||||
- }
|
|
||||||
+ my ($fh, $tmp) = File::Temp::tempfile(UNLINK => 1);
|
|
||||||
+ $fh->print(join("\n", $Inst->files($module)));
|
|
||||||
+ $fh->close();
|
|
||||||
+ # This used to use -I which is wrong for GNU tar.
|
|
||||||
+ system("tar cvf $file -T $tmp");
|
|
||||||
+ unlink($tmp);
|
|
||||||
+ last CASE;
|
|
||||||
+ }
|
|
||||||
else { print("Can't open $file: $!\n"); }
|
|
||||||
last CASE;
|
|
||||||
};
|
|
||||||
--- perl-5.8.7/lib/ExtUtils/MakeMaker.pm.CAN-2004-0976 2004-01-05 17:34:59.000000000 -0500
|
|
||||||
+++ perl-5.8.7/lib/ExtUtils/MakeMaker.pm 2005-11-08 13:07:36.000000000 -0500
|
|
||||||
@@ -1013,7 +1013,7 @@
|
|
||||||
The Makefile to be produced may be altered by adding arguments of the
|
|
||||||
form C<KEY=VALUE>. E.g.
|
|
||||||
|
|
||||||
- perl Makefile.PL PREFIX=/tmp/myperl5
|
|
||||||
+ perl Makefile.PL PREFIX=~/myperl5
|
|
||||||
|
|
||||||
Other interesting targets in the generated Makefile are
|
|
||||||
|
|
||||||
@@ -1355,13 +1355,13 @@
|
|
||||||
|
|
||||||
This is the root directory into which the code will be installed. It
|
|
||||||
I<prepends itself to the normal prefix>. For example, if your code
|
|
||||||
-would normally go into /usr/local/lib/perl you could set DESTDIR=/tmp/
|
|
||||||
-and installation would go into /tmp/usr/local/lib/perl.
|
|
||||||
+would normally go into /usr/local/lib/perl you could set DESTDIR=~/myperl/
|
|
||||||
+and installation would go into ~/myperl/usr/local/lib/perl.
|
|
||||||
|
|
||||||
This is primarily of use for people who repackage Perl modules.
|
|
||||||
|
|
||||||
NOTE: Due to the nature of make, it is important that you put the trailing
|
|
||||||
-slash on your DESTDIR. "/tmp/" not "/tmp".
|
|
||||||
+slash on your DESTDIR. "~/myperl/" not "~/myperl".
|
|
||||||
|
|
||||||
=item DIR
|
|
||||||
|
|
||||||
--- perl-5.8.7/lib/CGI/Cookie.pm.CAN-2004-0976 2005-05-16 04:41:03.000000000 -0400
|
|
||||||
+++ perl-5.8.7/lib/CGI/Cookie.pm 2005-11-08 14:56:15.141710000 -0500
|
|
||||||
@@ -407,7 +407,7 @@
|
|
||||||
You may also retrieve cookies that were stored in some external
|
|
||||||
form using the parse() class method:
|
|
||||||
|
|
||||||
- $COOKIES = `cat /usr/tmp/Cookie_stash`;
|
|
||||||
+ $COOKIES = `cat /var/run/www/Cookie_stash`;
|
|
||||||
%cookies = parse CGI::Cookie($COOKIES);
|
|
||||||
|
|
||||||
If you are in a mod_perl environment, you can save some overhead by
|
|
||||||
--- perl-5.8.7/lib/Shell.pm.CAN-2004-0976 2004-06-01 05:42:17.000000000 -0400
|
|
||||||
+++ perl-5.8.7/lib/Shell.pm 2005-11-08 15:01:36.434664000 -0500
|
|
||||||
@@ -127,7 +127,7 @@
|
|
||||||
use Shell qw(cat ps cp);
|
|
||||||
$passwd = cat('</etc/passwd');
|
|
||||||
@pslines = ps('-ww'),
|
|
||||||
- cp("/etc/passwd", "/tmp/passwd");
|
|
||||||
+ cp("/etc/passwd", "/etc/passwd.orig");
|
|
||||||
|
|
||||||
# object oriented
|
|
||||||
my $sh = Shell->new;
|
|
@ -1,474 +0,0 @@
|
|||||||
--- perl-5.8.7/t/lib/warnings/sv.CVE-2005-3962-bz174684 2004-03-18 07:51:14.000000000 -0500
|
|
||||||
+++ perl-5.8.7/t/lib/warnings/sv 2005-12-14 12:40:55.000000000 -0500
|
|
||||||
@@ -301,12 +301,12 @@
|
|
||||||
printf F "%\x02" ;
|
|
||||||
$a = sprintf "%\x02" ;
|
|
||||||
EXPECT
|
|
||||||
-Invalid conversion in sprintf: "%z" at - line 5.
|
|
||||||
-Invalid conversion in sprintf: end of string at - line 7.
|
|
||||||
-Invalid conversion in sprintf: "%\002" at - line 9.
|
|
||||||
Invalid conversion in printf: "%z" at - line 4.
|
|
||||||
+Invalid conversion in sprintf: "%z" at - line 5.
|
|
||||||
Invalid conversion in printf: end of string at - line 6.
|
|
||||||
+Invalid conversion in sprintf: end of string at - line 7.
|
|
||||||
Invalid conversion in printf: "%\002" at - line 8.
|
|
||||||
+Invalid conversion in sprintf: "%\002" at - line 9.
|
|
||||||
########
|
|
||||||
# sv.c
|
|
||||||
use warnings 'misc' ;
|
|
||||||
--- perl-5.8.7/t/op/sprintf.t.CVE-2005-3962-bz174684 2003-09-01 03:41:07.000000000 -0400
|
|
||||||
+++ perl-5.8.7/t/op/sprintf.t 2005-12-14 12:53:09.000000000 -0500
|
|
||||||
@@ -385,3 +385,8 @@
|
|
||||||
>%4$K %d< >[45, 67]< >%4$K 45 INVALID<
|
|
||||||
>%d %K %d< >[23, 45]< >23 %K 45 INVALID<
|
|
||||||
>%*v*999\$d %d %d< >[11, 22, 33]< >%*v*999\$d 11 22 INVALID<
|
|
||||||
+>%#b< >0< >0<
|
|
||||||
+>%#o< >0< >0<
|
|
||||||
+>%#x< >0< >0<
|
|
||||||
+>%2918905856$v2d< >''< ><
|
|
||||||
+>%*2918905856$v2d< >''< > UNINIT<
|
|
||||||
--- perl-5.8.7/t/op/sprintf2.t.CVE-2005-3962-bz174684 2004-02-09 16:37:13.000000000 -0500
|
|
||||||
+++ perl-5.8.7/t/op/sprintf2.t 2005-12-14 12:50:39.000000000 -0500
|
|
||||||
@@ -6,7 +6,7 @@
|
|
||||||
require './test.pl';
|
|
||||||
}
|
|
||||||
|
|
||||||
-plan tests => 3;
|
|
||||||
+plan tests => 7 + 256;
|
|
||||||
|
|
||||||
is(
|
|
||||||
sprintf("%.40g ",0.01),
|
|
||||||
@@ -26,3 +26,43 @@
|
|
||||||
q(width calculation under utf8 upgrade)
|
|
||||||
);
|
|
||||||
}
|
|
||||||
+
|
|
||||||
+# Used to mangle PL_sv_undef
|
|
||||||
+fresh_perl_is(
|
|
||||||
+ 'print sprintf "xxx%n\n"; print undef',
|
|
||||||
+ 'Modification of a read-only value attempted at - line 1.',
|
|
||||||
+ { switches => [ '-w' ] },
|
|
||||||
+ q(%n should not be able to modify read-only constants),
|
|
||||||
+);
|
|
||||||
+
|
|
||||||
+# check %NNN$ for range bounds, especially negative 2's complement
|
|
||||||
+{
|
|
||||||
+ my ($warn, $bad) = (0,0);
|
|
||||||
+ local $SIG{__WARN__} = sub {
|
|
||||||
+ if ($_[0] =~ /uninitialized/) {
|
|
||||||
+ $warn++
|
|
||||||
+ }
|
|
||||||
+ else {
|
|
||||||
+ $bad++
|
|
||||||
+ }
|
|
||||||
+ };
|
|
||||||
+ my $result = sprintf join('', map("%$_\$s%" . ~$_ . '$s', 1..20)),
|
|
||||||
+ qw(a b c d);
|
|
||||||
+ is($result, "abcd", "only four valid values");
|
|
||||||
+ is($warn, 36, "expected warnings");
|
|
||||||
+ is($bad, 0, "unexpected warnings");
|
|
||||||
+}
|
|
||||||
+{
|
|
||||||
+ foreach my $ord (0 .. 255) {
|
|
||||||
+ my $bad = 0;
|
|
||||||
+ local $SIG{__WARN__} = sub {
|
|
||||||
+ unless ($_[0] =~ /^Invalid conversion in sprintf/ ||
|
|
||||||
+ $_[0] =~ /^Use of uninitialized value in sprintf/) {
|
|
||||||
+ warn $_[0];
|
|
||||||
+ $bad++;
|
|
||||||
+ }
|
|
||||||
+ };
|
|
||||||
+ my $r = eval {sprintf '%v' . chr $ord};
|
|
||||||
+ is ($bad, 0, "pattern '%v' . chr $ord");
|
|
||||||
+ }
|
|
||||||
+}
|
|
||||||
--- perl-5.8.7/opcode.h.CVE-2005-3962-bz174684 2005-05-27 12:29:50.000000000 -0400
|
|
||||||
+++ perl-5.8.7/opcode.h 2005-12-14 12:40:55.000000000 -0500
|
|
||||||
@@ -1585,7 +1585,7 @@
|
|
||||||
0x0022281c, /* vec */
|
|
||||||
0x0122291c, /* index */
|
|
||||||
0x0122291c, /* rindex */
|
|
||||||
- 0x0004280f, /* sprintf */
|
|
||||||
+ 0x0004280d, /* sprintf - WAS 0x0004280f before patch #26283 */
|
|
||||||
0x00042805, /* formline */
|
|
||||||
0x0001379e, /* ord */
|
|
||||||
0x0001378e, /* chr */
|
|
||||||
--- perl-5.8.7/op.c.CVE-2005-3962-bz174684 2005-04-22 10:12:32.000000000 -0400
|
|
||||||
+++ perl-5.8.7/op.c 2005-12-14 12:40:55.000000000 -0500
|
|
||||||
@@ -2076,7 +2076,9 @@
|
|
||||||
/* XXX might want a ck_negate() for this */
|
|
||||||
cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
|
|
||||||
break;
|
|
||||||
- case OP_SPRINTF:
|
|
||||||
+/* Removed as part of fix for CVE-2005-3962 / Upstream patch 26283 :
|
|
||||||
+ * case OP_SPRINTF:
|
|
||||||
+ */
|
|
||||||
case OP_UCFIRST:
|
|
||||||
case OP_LCFIRST:
|
|
||||||
case OP_UC:
|
|
||||||
--- perl-5.8.7/makedef.pl.CVE-2005-3962-bz174684 2005-05-09 09:27:41.000000000 -0400
|
|
||||||
+++ perl-5.8.7/makedef.pl 2005-12-14 12:40:55.000000000 -0500
|
|
||||||
@@ -635,11 +635,13 @@
|
|
||||||
)];
|
|
||||||
}
|
|
||||||
|
|
||||||
-if ($define{'PERL_MALLOC_WRAP'}) {
|
|
||||||
- emit_symbols [qw(
|
|
||||||
- PL_memory_wrap
|
|
||||||
- )];
|
|
||||||
-}
|
|
||||||
+# Removed as part of fix for CVE-2005-3962 / CVE-2005-3962 /
|
|
||||||
+# Upstream patch #26283
|
|
||||||
+# if ($define{'PERL_MALLOC_WRAP'}) {
|
|
||||||
+# emit_symbols [qw(
|
|
||||||
+# PL_memory_wrap
|
|
||||||
+# )];
|
|
||||||
+#}
|
|
||||||
|
|
||||||
unless ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) {
|
|
||||||
skip_symbols [qw(
|
|
||||||
--- perl-5.8.7/ext/Sys/Syslog/Syslog.pm.CVE-2005-3962-bz174684 2005-04-22 07:53:56.000000000 -0400
|
|
||||||
+++ perl-5.8.7/ext/Sys/Syslog/Syslog.pm 2005-12-14 12:40:55.000000000 -0500
|
|
||||||
@@ -1,14 +1,13 @@
|
|
||||||
package Sys::Syslog;
|
|
||||||
require 5.006;
|
|
||||||
require Exporter;
|
|
||||||
-require DynaLoader;
|
|
||||||
use Carp;
|
|
||||||
use strict;
|
|
||||||
|
|
||||||
-our @ISA = qw(Exporter DynaLoader);
|
|
||||||
+our @ISA = qw(Exporter);
|
|
||||||
our @EXPORT = qw(openlog closelog setlogmask syslog);
|
|
||||||
our @EXPORT_OK = qw(setlogsock);
|
|
||||||
-our $VERSION = '0.06';
|
|
||||||
+our $VERSION = '0.08';
|
|
||||||
|
|
||||||
# it would be nice to try stream/unix first, since that will be
|
|
||||||
# most efficient. However streams are dodgy - see _syslog_send_stream
|
|
||||||
@@ -54,26 +53,38 @@
|
|
||||||
|
|
||||||
=item openlog $ident, $logopt, $facility
|
|
||||||
|
|
||||||
+Opens the syslog.
|
|
||||||
I<$ident> is prepended to every message. I<$logopt> contains zero or
|
|
||||||
more of the words I<pid>, I<ndelay>, I<nowait>. The cons option is
|
|
||||||
ignored, since the failover mechanism will drop down to the console
|
|
||||||
automatically if all other media fail. I<$facility> specifies the
|
|
||||||
part of the system to report about, for example LOG_USER or LOG_LOCAL0:
|
|
||||||
see your C<syslog(3)> documentation for the facilities available in
|
|
||||||
-your system.
|
|
||||||
+your system. This function will croak if it can't connect to the syslog
|
|
||||||
+daemon.
|
|
||||||
|
|
||||||
B<You should use openlog() before calling syslog().>
|
|
||||||
|
|
||||||
+=item syslog $priority, $message
|
|
||||||
+
|
|
||||||
=item syslog $priority, $format, @args
|
|
||||||
|
|
||||||
-If I<$priority> permits, logs I<($format, @args)>
|
|
||||||
-printed as by C<printf(3V)>, with the addition that I<%m>
|
|
||||||
-is replaced with C<"$!"> (the latest error message).
|
|
||||||
+If I<$priority> permits, logs I<$message> or I<sprintf($format, @args)>
|
|
||||||
+with the addition that I<%m> in $message or $format is replaced with
|
|
||||||
+C<"$!"> (the latest error message).
|
|
||||||
|
|
||||||
If you didn't use openlog() before using syslog(), syslog will try to
|
|
||||||
guess the I<$ident> by extracting the shortest prefix of I<$format>
|
|
||||||
that ends in a ":".
|
|
||||||
|
|
||||||
+Note that Sys::Syslog version v0.07 and older passed the $message as
|
|
||||||
+the formatting string to sprintf() even when no formatting arguments
|
|
||||||
+were provided. If the code calling syslog() might execute with older
|
|
||||||
+versions of this module, make sure to call the function as
|
|
||||||
+syslog($priority, "%s", $message) instead of syslog($priority,
|
|
||||||
+$message). This protects against hostile formatting sequences that
|
|
||||||
+might show up if $message contains tainted data.
|
|
||||||
+
|
|
||||||
=item setlogmask $mask_priority
|
|
||||||
|
|
||||||
Sets log mask I<$mask_priority> and returns the old mask.
|
|
||||||
@@ -175,7 +186,8 @@
|
|
||||||
goto &$AUTOLOAD;
|
|
||||||
}
|
|
||||||
|
|
||||||
-bootstrap Sys::Syslog $VERSION;
|
|
||||||
+require XSLoader;
|
|
||||||
+XSLoader::load('Sys::Syslog', $VERSION);
|
|
||||||
|
|
||||||
our $maskpri = &LOG_UPTO(&LOG_DEBUG);
|
|
||||||
|
|
||||||
@@ -316,9 +328,16 @@
|
|
||||||
|
|
||||||
$whoami .= "[$$]" if our $lo_pid;
|
|
||||||
|
|
||||||
- $mask =~ s/(?<!%)%m/$!/g;
|
|
||||||
+ if ($mask =~ /%m/) {
|
|
||||||
+ my $err = $!;
|
|
||||||
+ # escape percent signs if sprintf will be called
|
|
||||||
+ $err =~ s/%/%%/g if @_;
|
|
||||||
+ # replace %m with $err, if preceded by an even number of percent signs
|
|
||||||
+ $mask =~ s/(?<!%)((?:%%)*)%m/$1$err/g;
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
$mask .= "\n" unless $mask =~ /\n$/;
|
|
||||||
- $message = sprintf ($mask, @_);
|
|
||||||
+ $message = @_ ? sprintf($mask, @_) : $mask;
|
|
||||||
|
|
||||||
$sum = $numpri + $numfac;
|
|
||||||
my $buf = "<$sum>$whoami: $message\0";
|
|
||||||
--- perl-5.8.7/opcode.pl.CVE-2005-3962-bz174684 2004-12-01 08:54:30.000000000 -0500
|
|
||||||
+++ perl-5.8.7/opcode.pl 2005-12-14 12:40:55.000000000 -0500
|
|
||||||
@@ -606,7 +606,7 @@
|
|
||||||
index index ck_index isT@ S S S?
|
|
||||||
rindex rindex ck_index isT@ S S S?
|
|
||||||
|
|
||||||
-sprintf sprintf ck_fun mfst@ S L
|
|
||||||
+sprintf sprintf ck_fun mst@ S L
|
|
||||||
formline formline ck_fun ms@ S L
|
|
||||||
ord ord ck_fun ifsTu% S?
|
|
||||||
chr chr ck_fun fsTu% S?
|
|
||||||
--- perl-5.8.7/handy.h.CVE-2005-3962-bz174684 2005-04-20 12:33:28.000000000 -0400
|
|
||||||
+++ perl-5.8.7/handy.h 2005-12-14 12:40:55.000000000 -0500
|
|
||||||
@@ -598,91 +598,65 @@
|
|
||||||
|
|
||||||
=cut */
|
|
||||||
|
|
||||||
-#ifndef lint
|
|
||||||
-
|
|
||||||
#define NEWSV(x,len) newSV(len)
|
|
||||||
|
|
||||||
#ifdef PERL_MALLOC_WRAP
|
|
||||||
#define MEM_WRAP_CHECK(n,t) \
|
|
||||||
- (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(PL_memory_wrap),0):0)
|
|
||||||
+ (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(PL_memory_wrap),0):0)
|
|
||||||
#define MEM_WRAP_CHECK_1(n,t,a) \
|
|
||||||
- (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a),0):0)
|
|
||||||
+ (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a),0):0)
|
|
||||||
#define MEM_WRAP_CHECK_2(n,t,a,b) \
|
|
||||||
- (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a,b),0):0)
|
|
||||||
+ (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a,b),0):0)
|
|
||||||
+#define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,t),
|
|
||||||
|
|
||||||
-#define New(x,v,n,t) (v = (MEM_WRAP_CHECK(n,t), (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
|
|
||||||
-#define Newc(x,v,n,t,c) (v = (MEM_WRAP_CHECK(n,t), (c*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
|
|
||||||
-#define Newz(x,v,n,t) (v = (MEM_WRAP_CHECK(n,t), (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))), \
|
|
||||||
- memzero((char*)(v), (n)*sizeof(t))
|
|
||||||
-#define Renew(v,n,t) \
|
|
||||||
- (v = (MEM_WRAP_CHECK(n,t), (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
|
|
||||||
-#define Renewc(v,n,t,c) \
|
|
||||||
- (v = (MEM_WRAP_CHECK(n,t), (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
|
|
||||||
-#define Safefree(d) safefree((Malloc_t)(d))
|
|
||||||
-
|
|
||||||
-#define Move(s,d,n,t) (MEM_WRAP_CHECK(n,t), (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t)))
|
|
||||||
-#define Copy(s,d,n,t) (MEM_WRAP_CHECK(n,t), (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)))
|
|
||||||
-#define Zero(d,n,t) (MEM_WRAP_CHECK(n,t), (void)memzero((char*)(d), (n) * sizeof(t)))
|
|
||||||
-
|
|
||||||
-#define MoveD(s,d,n,t) (MEM_WRAP_CHECK(n,t), memmove((char*)(d),(char*)(s), (n) * sizeof(t)))
|
|
||||||
-#define CopyD(s,d,n,t) (MEM_WRAP_CHECK(n,t), memcpy((char*)(d),(char*)(s), (n) * sizeof(t)))
|
|
||||||
-#ifdef HAS_MEMSET
|
|
||||||
-#define ZeroD(d,n,t) (MEM_WRAP_CHECK(n,t), memzero((char*)(d), (n) * sizeof(t)))
|
|
||||||
-#else
|
|
||||||
-/* Using bzero(), which returns void. */
|
|
||||||
-#define ZeroD(d,n,t) (MEM_WRAP_CHECK(n,t), memzero((char*)(d), (n) * sizeof(t)),d)
|
|
||||||
-#endif
|
|
||||||
-
|
|
||||||
-#define Poison(d,n,t) (MEM_WRAP_CHECK(n,t), (void)memset((char*)(d), 0xAB, (n) * sizeof(t)))
|
|
||||||
+#define PERL_STRLEN_ROUNDUP(n) ((void)(((n) > (MEM_SIZE)~0 - 2 * PERL_STRLEN_ROUNDUP_QUANTUM) ? (Perl_croak_nocontext(PL_memory_wrap),0):0),((n-1+PERL_STRLEN_ROUNDUP_QUANTUM)&~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM-1)))
|
|
||||||
|
|
||||||
#else
|
|
||||||
|
|
||||||
#define MEM_WRAP_CHECK(n,t)
|
|
||||||
#define MEM_WRAP_CHECK_1(n,t,a)
|
|
||||||
#define MEM_WRAP_CHECK_2(n,t,a,b)
|
|
||||||
+#define MEM_WRAP_CHECK_(n,t)
|
|
||||||
+
|
|
||||||
+#define PERL_STRLEN_ROUNDUP(n) (((n-1+PERL_STRLEN_ROUNDUP_QUANTUM)&~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM-1)))
|
|
||||||
|
|
||||||
-#define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
|
|
||||||
-#define Newc(x,v,n,t,c) (v = (c*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
|
|
||||||
-#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))), \
|
|
||||||
+#endif
|
|
||||||
+
|
|
||||||
+#define Newx(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
|
|
||||||
+#define Newxc(v,n,t,c) (v = (MEM_WRAP_CHECK_(n,t) (c*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
|
|
||||||
+#define Newxz(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))), \
|
|
||||||
memzero((char*)(v), (n)*sizeof(t))
|
|
||||||
+/* pre 5.9.x compatibility */
|
|
||||||
+#define New(x,v,n,t) Newx(v,n,t)
|
|
||||||
+#define Newc(x,v,n,t,c) Newxc(v,n,t,c)
|
|
||||||
+#define Newz(x,v,n,t) Newxz(v,n,t)
|
|
||||||
+
|
|
||||||
#define Renew(v,n,t) \
|
|
||||||
- (v = (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
|
|
||||||
+ (v = (MEM_WRAP_CHECK_(n,t) (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
|
|
||||||
#define Renewc(v,n,t,c) \
|
|
||||||
- (v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
|
|
||||||
-#define Safefree(d) safefree((Malloc_t)(d))
|
|
||||||
-
|
|
||||||
-#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
|
|
||||||
-#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
|
|
||||||
-#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t))
|
|
||||||
+ (v = (MEM_WRAP_CHECK_(n,t) (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
|
|
||||||
|
|
||||||
-#define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
|
|
||||||
-#define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
|
|
||||||
-#ifdef HAS_MEMSET
|
|
||||||
-#define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
|
|
||||||
+#ifdef PERL_POISON
|
|
||||||
+#define Safefree(d) \
|
|
||||||
+ (d ? (void)(safefree((Malloc_t)(d)), Poison(&(d), 1, Malloc_t)) : (void) 0)
|
|
||||||
#else
|
|
||||||
-#define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d)
|
|
||||||
+#define Safefree(d) safefree((Malloc_t)(d))
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-#define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
|
|
||||||
+#define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
|
|
||||||
+#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
|
|
||||||
+#define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memzero((char*)(d), (n) * sizeof(t)))
|
|
||||||
|
|
||||||
+#define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
|
|
||||||
+#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
|
|
||||||
+#ifdef HAS_MEMSET
|
|
||||||
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)))
|
|
||||||
+#else
|
|
||||||
+/* Using bzero(), which returns void. */
|
|
||||||
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)),d)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-#else /* lint */
|
|
||||||
-
|
|
||||||
-#define New(x,v,n,s) (v = Null(s *))
|
|
||||||
-#define Newc(x,v,n,s,c) (v = Null(s *))
|
|
||||||
-#define Newz(x,v,n,s) (v = Null(s *))
|
|
||||||
-#define Renew(v,n,s) (v = Null(s *))
|
|
||||||
-#define Move(s,d,n,t)
|
|
||||||
-#define Copy(s,d,n,t)
|
|
||||||
-#define Zero(d,n,t)
|
|
||||||
-#define MoveD(s,d,n,t) d
|
|
||||||
-#define CopyD(s,d,n,t) d
|
|
||||||
-#define ZeroD(d,n,t) d
|
|
||||||
-#define Poison(d,n,t)
|
|
||||||
-#define Safefree(d) (d) = (d)
|
|
||||||
-
|
|
||||||
-#endif /* lint */
|
|
||||||
+#define Poison(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)))
|
|
||||||
|
|
||||||
#ifdef USE_STRUCT_COPY
|
|
||||||
#define StructCopy(s,d,t) (*((t*)(d)) = *((t*)(s)))
|
|
||||||
--- perl-5.8.7/perl.h.CVE-2005-3962-bz174684 2005-12-14 12:40:55.000000000 -0500
|
|
||||||
+++ perl-5.8.7/perl.h 2005-12-14 12:40:55.000000000 -0500
|
|
||||||
@@ -720,6 +720,13 @@
|
|
||||||
|
|
||||||
#define MEM_SIZE Size_t
|
|
||||||
|
|
||||||
+/* Round all values passed to malloc up, by default to a multiple of
|
|
||||||
+ sizeof(size_t)
|
|
||||||
+*/
|
|
||||||
+#ifndef PERL_STRLEN_ROUNDUP_QUANTUM
|
|
||||||
+#define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size
|
|
||||||
+#endif
|
|
||||||
+
|
|
||||||
#if defined(STANDARD_C) && defined(I_STDDEF)
|
|
||||||
# include <stddef.h>
|
|
||||||
# define STRUCT_OFFSET(s,m) offsetof(s,m)
|
|
||||||
@@ -3332,10 +3339,8 @@
|
|
||||||
INIT("\"my\" variable %s can't be in a package");
|
|
||||||
EXTCONST char PL_no_localize_ref[]
|
|
||||||
INIT("Can't localize through a reference");
|
|
||||||
-#ifdef PERL_MALLOC_WRAP
|
|
||||||
EXTCONST char PL_memory_wrap[]
|
|
||||||
INIT("panic: memory wrap");
|
|
||||||
-#endif
|
|
||||||
|
|
||||||
EXTCONST char PL_uuemap[65]
|
|
||||||
INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
|
|
||||||
--- perl-5.8.7/sv.c.CVE-2005-3962-bz174684 2005-05-27 06:38:11.000000000 -0400
|
|
||||||
+++ perl-5.8.7/sv.c 2005-12-14 12:48:45.000000000 -0500
|
|
||||||
@@ -8589,9 +8589,12 @@
|
|
||||||
if (vectorarg) {
|
|
||||||
if (args)
|
|
||||||
vecsv = va_arg(*args, SV*);
|
|
||||||
- else
|
|
||||||
- vecsv = (evix ? evix <= svmax : svix < svmax) ?
|
|
||||||
- svargs[evix ? evix-1 : svix++] : &PL_sv_undef;
|
|
||||||
+ else if (evix) {
|
|
||||||
+ vecsv = (evix > 0 && evix <= svmax)
|
|
||||||
+ ? svargs[evix-1] : &PL_sv_undef;
|
|
||||||
+ } else {
|
|
||||||
+ vecsv = svix < svmax ? svargs[svix++] : &PL_sv_undef;
|
|
||||||
+ }
|
|
||||||
dotstr = SvPVx(vecsv, dotstrlen);
|
|
||||||
if (DO_UTF8(vecsv))
|
|
||||||
is_utf8 = TRUE;
|
|
||||||
@@ -8601,12 +8604,13 @@
|
|
||||||
vecstr = (U8*)SvPVx(vecsv,veclen);
|
|
||||||
vec_utf8 = DO_UTF8(vecsv);
|
|
||||||
}
|
|
||||||
- else if (efix ? efix <= svmax : svix < svmax) {
|
|
||||||
+ else if (efix ? (efix > 0 && efix <= svmax) : svix < svmax) {
|
|
||||||
vecsv = svargs[efix ? efix-1 : svix++];
|
|
||||||
vecstr = (U8*)SvPVx(vecsv,veclen);
|
|
||||||
vec_utf8 = DO_UTF8(vecsv);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
+ vecsv = &PL_sv_undef;
|
|
||||||
vecstr = (U8*)"";
|
|
||||||
veclen = 0;
|
|
||||||
}
|
|
||||||
@@ -8707,9 +8711,15 @@
|
|
||||||
|
|
||||||
if (vectorize)
|
|
||||||
argsv = vecsv;
|
|
||||||
- else if (!args)
|
|
||||||
- argsv = (efix ? efix <= svmax : svix < svmax) ?
|
|
||||||
- svargs[efix ? efix-1 : svix++] : &PL_sv_undef;
|
|
||||||
+ else if (!args) {
|
|
||||||
+ if (efix) {
|
|
||||||
+ const I32 i = efix-1;
|
|
||||||
+ argsv = (i >= 0 && i < svmax) ? svargs[i] : &PL_sv_undef;
|
|
||||||
+ } else {
|
|
||||||
+ argsv = (svix >= 0 && svix < svmax)
|
|
||||||
+ ? svargs[svix++] : &PL_sv_undef;
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
|
|
||||||
switch (c = *q++) {
|
|
||||||
|
|
||||||
@@ -8972,6 +8982,8 @@
|
|
||||||
*--eptr = '0';
|
|
||||||
break;
|
|
||||||
case 2:
|
|
||||||
+ if (!uv)
|
|
||||||
+ alt = FALSE;
|
|
||||||
do {
|
|
||||||
dig = uv & 1;
|
|
||||||
*--eptr = '0' + dig;
|
|
||||||
@@ -9274,6 +9286,8 @@
|
|
||||||
|
|
||||||
/* calculate width before utf8_upgrade changes it */
|
|
||||||
have = esignlen + zeros + elen;
|
|
||||||
+ if (have < zeros)
|
|
||||||
+ Perl_croak_nocontext(PL_memory_wrap);
|
|
||||||
|
|
||||||
if (is_utf8 != has_utf8) {
|
|
||||||
if (is_utf8) {
|
|
||||||
@@ -9301,6 +9315,9 @@
|
|
||||||
need = (have > width ? have : width);
|
|
||||||
gap = need - have;
|
|
||||||
|
|
||||||
+ if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
|
|
||||||
+ Perl_croak_nocontext(PL_memory_wrap);
|
|
||||||
+
|
|
||||||
SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
|
|
||||||
p = SvEND(sv);
|
|
||||||
if (esignlen && fill == '0') {
|
|
||||||
--- perl-5.8.7/globvar.sym.CVE-2005-3962-bz174684 2000-08-14 11:22:14.000000000 -0400
|
|
||||||
+++ perl-5.8.7/globvar.sym 2005-12-14 12:51:12.000000000 -0500
|
|
||||||
@@ -66,3 +66,4 @@
|
|
||||||
vtbl_collxfrm
|
|
||||||
vtbl_amagic
|
|
||||||
vtbl_amagicelem
|
|
||||||
+memory_wrap
|
|
@ -1,23 +0,0 @@
|
|||||||
--- perl-5.8.7/perl.h.IOC_SIZE 2005-05-07 16:11:45.000000000 -0400
|
|
||||||
+++ perl-5.8.7/perl.h 2005-10-25 16:56:10.000000000 -0400
|
|
||||||
@@ -2508,11 +2508,17 @@
|
|
||||||
|
|
||||||
#ifndef IOCPARM_LEN
|
|
||||||
# ifdef IOCPARM_MASK
|
|
||||||
- /* on BSDish systes we're safe */
|
|
||||||
+ /* on BSDish systems we're safe */
|
|
||||||
# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK)
|
|
||||||
# else
|
|
||||||
- /* otherwise guess at what's safe */
|
|
||||||
-# define IOCPARM_LEN(x) 256
|
|
||||||
+# ifdef _IOC_SIZE
|
|
||||||
+ /* on Linux systems we're safe */
|
|
||||||
+# define IOCPARM_LEN(x) _IOC_SIZE(x)
|
|
||||||
+# else
|
|
||||||
+ /* otherwise guess at what's safe (we're UNSAFE!) */
|
|
||||||
+# warning "unsafe assumption of IOCPARM_LEN=256"
|
|
||||||
+# define IOCPARM_LEN(x) 256
|
|
||||||
+# endif
|
|
||||||
# endif
|
|
||||||
#endif
|
|
||||||
|
|
@ -1,38 +0,0 @@
|
|||||||
--- perl-5.8.7/lib/ExtUtils/MM_Unix.pm.136009 2005-11-08 20:08:30.000000000 -0500
|
|
||||||
+++ perl-5.8.7/lib/ExtUtils/MM_Unix.pm 2005-11-09 12:54:41.000000000 -0500
|
|
||||||
@@ -413,11 +413,18 @@
|
|
||||||
};
|
|
||||||
my($tmp);
|
|
||||||
for $tmp (qw/
|
|
||||||
- EXTRALIBS LDLOADLIBS BSLOADLIBS LD_RUN_PATH
|
|
||||||
+ EXTRALIBS LDLOADLIBS BSLOADLIBS
|
|
||||||
/) {
|
|
||||||
next unless defined $self->{$tmp};
|
|
||||||
push @m, "$tmp = $self->{$tmp}\n";
|
|
||||||
}
|
|
||||||
+ # don't set LD_RUN_PATH if empty
|
|
||||||
+ for $tmp (qw/
|
|
||||||
+ LD_RUN_PATH
|
|
||||||
+ /) {
|
|
||||||
+ next unless $self->{$tmp};
|
|
||||||
+ push @m, "$tmp = $self->{$tmp}\n";
|
|
||||||
+ }
|
|
||||||
return join "", @m;
|
|
||||||
}
|
|
||||||
|
|
||||||
@@ -1134,9 +1141,13 @@
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
+ my $ld_run_path_shell = "";
|
|
||||||
+ if ($self->{LD_RUN_PATH} ne "") {
|
|
||||||
+ $ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
|
|
||||||
+ }
|
|
||||||
push(@m,
|
|
||||||
-' $(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
|
|
||||||
-' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) '.$libs.' $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) $(INST_DYNAMIC_FIX)');
|
|
||||||
+ ' '.$ld_run_path_shell.'$(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
|
|
||||||
+ ' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) '.$libs.' $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) $(INST_DYNAMIC_FIX)');
|
|
||||||
push @m, '
|
|
||||||
$(CHMOD) $(PERM_RWX) $@
|
|
||||||
';
|
|
@ -1,115 +0,0 @@
|
|||||||
--- perl-5.8.7/lib/ExtUtils/MakeMaker.pm.USE_MM_LD_RUN_PATH 2005-12-08 15:10:24.000000000 -0500
|
|
||||||
+++ perl-5.8.7/lib/ExtUtils/MakeMaker.pm 2005-12-08 19:36:26.000000000 -0500
|
|
||||||
@@ -226,7 +226,7 @@
|
|
||||||
PERL_SRC PERM_RW PERM_RWX
|
|
||||||
PL_FILES PM PM_FILTER PMLIBDIRS POLLUTE PPM_INSTALL_EXEC
|
|
||||||
PPM_INSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ
|
|
||||||
- SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
|
|
||||||
+ SKIP TYPEMAPS USE_MM_LD_RUN_PATH VERSION VERSION_FROM XS XSOPT XSPROTOARG
|
|
||||||
XS_VERSION clean depend dist dynamic_lib linkext macro realclean
|
|
||||||
tool_autosplit
|
|
||||||
|
|
||||||
@@ -362,7 +362,27 @@
|
|
||||||
print join(" ", map { "perl($_)>=$self->{PREREQ_PM}->{$_} " }
|
|
||||||
sort keys %{$self->{PREREQ_PM}}), "\n";
|
|
||||||
exit 0;
|
|
||||||
- }
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
+ # USE_MM_LD_RUN_PATH - another RedHatism to disable automatic RPATH generation
|
|
||||||
+ if ( ( ! $self->{USE_MM_LD_RUN_PATH} )
|
|
||||||
+ &&( ("@ARGV" =~ /\bUSE_MM_LD_RUN_PATH(=([01]))?\b/)
|
|
||||||
+ ||( exists( $ENV{USE_MM_LD_RUN_PATH} )
|
|
||||||
+ &&( $ENV{USE_MM_LD_RUN_PATH} =~ /([01])?$/ )
|
|
||||||
+ )
|
|
||||||
+ )
|
|
||||||
+ )
|
|
||||||
+ {
|
|
||||||
+ my $v = $1;
|
|
||||||
+ if( $v )
|
|
||||||
+ {
|
|
||||||
+ $v = ($v=~/=([01])$/)[0];
|
|
||||||
+ }else
|
|
||||||
+ {
|
|
||||||
+ $v = 1;
|
|
||||||
+ };
|
|
||||||
+ $self->{USE_MM_LD_RUN_PATH}=$v;
|
|
||||||
+ }
|
|
||||||
|
|
||||||
print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose;
|
|
||||||
if (-f "MANIFEST" && ! -f "Makefile"){
|
|
||||||
@@ -2007,6 +2027,40 @@
|
|
||||||
precedence, even if it isn't listed in TYPEMAPS. The default system
|
|
||||||
typemap has lowest precedence.
|
|
||||||
|
|
||||||
+=item USE_MM_LD_RUN_PATH
|
|
||||||
+
|
|
||||||
+boolean
|
|
||||||
+The Red Hat perl MakeMaker distribution differs from the standard
|
|
||||||
+upstream release in that it disables use of the MakeMaker generated
|
|
||||||
+LD_RUN_PATH by default, UNLESS this attribute is specified , or the
|
|
||||||
+USE_MM_LD_RUN_PATH environment variable is set during the MakeMaker run.
|
|
||||||
+
|
|
||||||
+The upstream MakeMaker will set the ld(1) environment variable LD_RUN_PATH
|
|
||||||
+to the concatenation of every -L ld(1) option directory in which a -l ld(1)
|
|
||||||
+option library is found, which is used as the ld(1) -rpath option if none
|
|
||||||
+is specified. This means that, if your application builds shared libraries
|
|
||||||
+and your MakeMaker application links to them, that the absolute paths of the
|
|
||||||
+libraries in the build tree will be inserted into the RPATH header of all
|
|
||||||
+MakeMaker generated binaries, and that such binaries will be unable to link
|
|
||||||
+to these libraries if they do not still reside in the build tree directories
|
|
||||||
+(unlikely) or in the system library directories (/lib or /usr/lib), regardless
|
|
||||||
+of any LD_LIBRARY_PATH setting. So if you specified -L../mylib -lmylib , and
|
|
||||||
+ your 'libmylib.so' gets installed into /some_directory_other_than_usr_lib,
|
|
||||||
+ your MakeMaker application will be unable to link to it, even if LD_LIBRARY_PATH
|
|
||||||
+is set to include /some_directory_other_than_usr_lib, because RPATH overrides
|
|
||||||
+LD_LIBRARY_PATH.
|
|
||||||
+
|
|
||||||
+So for Red Hat MakeMaker builds LD_RUN_PATH is NOT generated by default for
|
|
||||||
+every link. You can still use explicit -rpath ld options or the LD_RUN_PATH
|
|
||||||
+environment variable during the build to generate an RPATH for the binaries.
|
|
||||||
+
|
|
||||||
+You can set the USE_MM_LD_RUN_PATH attribute to 1 on the MakeMaker command
|
|
||||||
+line or in the WriteMakefile arguments to enable generation of LD_RUN_PATH
|
|
||||||
+for every link command.
|
|
||||||
+
|
|
||||||
+USE_MM_LD_RUN_PATH will default to 1 (LD_RUN_PATH will be used) IF the
|
|
||||||
+$USE_MM_LD_RUN_PATH environment variable is set during a MakeMaker run.
|
|
||||||
+
|
|
||||||
=item VENDORPREFIX
|
|
||||||
|
|
||||||
Like PERLPREFIX, but only for the vendor install locations.
|
|
||||||
--- perl-5.8.7/lib/ExtUtils/MM_Unix.pm.USE_MM_LD_RUN_PATH 2005-12-08 15:10:24.000000000 -0500
|
|
||||||
+++ perl-5.8.7/lib/ExtUtils/MM_Unix.pm 2005-12-08 18:35:13.000000000 -0500
|
|
||||||
@@ -1142,7 +1142,7 @@
|
|
||||||
}
|
|
||||||
|
|
||||||
my $ld_run_path_shell = "";
|
|
||||||
- if ($self->{LD_RUN_PATH} ne "") {
|
|
||||||
+ if (($self->{LD_RUN_PATH} ne "") && ($self->{USE_MM_LD_RUN_PATH})) {
|
|
||||||
$ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
|
|
||||||
}
|
|
||||||
push(@m,
|
|
||||||
--- perl-5.8.7/lib/ExtUtils/Liblist.pm.USE_MM_LD_RUN_PATH 2003-04-07 14:58:17.000000000 -0400
|
|
||||||
+++ perl-5.8.7/lib/ExtUtils/Liblist.pm 2005-12-08 19:39:28.000000000 -0500
|
|
||||||
@@ -51,6 +51,8 @@
|
|
||||||
specifics below. The list of the filenames is returned only if
|
|
||||||
$need_names argument is true.
|
|
||||||
|
|
||||||
+NOTE: if the LD_RUN_PATH me
|
|
||||||
+
|
|
||||||
Dependent libraries can be linked in one of three ways:
|
|
||||||
|
|
||||||
=over 2
|
|
||||||
@@ -87,6 +89,11 @@
|
|
||||||
in LDLOADLIBS. It is passed as an environment variable to the process
|
|
||||||
that links the shared library.
|
|
||||||
|
|
||||||
+Red Hat extension: This generation of LD_RUN_PATH is disabled by default.
|
|
||||||
+To use the generated LD_RUN_PATH for all links, set the USE_MM_LD_RUN_PATH
|
|
||||||
+MakeMaker object attribute / argument, (or set the $USE_MM_LD_RUN_PATH
|
|
||||||
+environment variable).
|
|
||||||
+
|
|
||||||
=head2 BSLOADLIBS
|
|
||||||
|
|
||||||
List of those libraries that are needed but can be linked in
|
|
@ -1,21 +0,0 @@
|
|||||||
--- perl-5.8.7/utils/h2ph.PL.bz172236 2005-04-04 17:47:17.000000000 -0400
|
|
||||||
+++ perl-5.8.7/utils/h2ph.PL 2005-11-01 17:42:36.000000000 -0500
|
|
||||||
@@ -734,9 +734,15 @@
|
|
||||||
# non-GCC?) C compilers, but gcc uses an additional include directory.
|
|
||||||
sub inc_dirs
|
|
||||||
{
|
|
||||||
- my $from_gcc = `$Config{cc} -v 2>&1`;
|
|
||||||
- $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s;
|
|
||||||
-
|
|
||||||
+ my $from_gcc = `LC_ALL=C $Config{cc} -v 2>&1`;
|
|
||||||
+ if( !( $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s ) )
|
|
||||||
+ { # gcc-4+ :
|
|
||||||
+ $from_gcc = `LC_ALL=C $Config{cc} -print-search-dirs 2>&1`;
|
|
||||||
+ if ( !($from_gcc =~ s/^install:\s*([^\s]+[^\s\/])([\s\/]*).*$/$1\/include/s) )
|
|
||||||
+ {
|
|
||||||
+ $from_gcc = '';
|
|
||||||
+ };
|
|
||||||
+ };
|
|
||||||
length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
|
|
||||||
}
|
|
||||||
|
|
@ -1,114 +0,0 @@
|
|||||||
--- perl-5.8.7/pp_sort.c.bz172587 2005-04-08 05:31:47.000000000 -0400
|
|
||||||
+++ perl-5.8.7/pp_sort.c 2005-11-07 12:57:07.000000000 -0500
|
|
||||||
@@ -1510,6 +1510,7 @@
|
|
||||||
|
|
||||||
if (gimme != G_ARRAY) {
|
|
||||||
SP = MARK;
|
|
||||||
+ EXTEND(SP,1);
|
|
||||||
RETPUSHUNDEF;
|
|
||||||
}
|
|
||||||
|
|
||||||
--- perl-5.8.7/pp_hot.c.bz172587 2005-04-22 10:12:27.000000000 -0400
|
|
||||||
+++ perl-5.8.7/pp_hot.c 2005-11-07 12:55:16.000000000 -0500
|
|
||||||
@@ -639,12 +639,12 @@
|
|
||||||
}
|
|
||||||
}
|
|
||||||
SP = ORIGMARK;
|
|
||||||
- PUSHs(&PL_sv_yes);
|
|
||||||
+ XPUSHs(&PL_sv_yes);
|
|
||||||
RETURN;
|
|
||||||
|
|
||||||
just_say_no:
|
|
||||||
SP = ORIGMARK;
|
|
||||||
- PUSHs(&PL_sv_undef);
|
|
||||||
+ XPUSHs(&PL_sv_undef);
|
|
||||||
RETURN;
|
|
||||||
}
|
|
||||||
|
|
||||||
--- perl-5.8.7/pp_sys.c.bz172587 2005-04-27 18:12:46.000000000 -0400
|
|
||||||
+++ perl-5.8.7/pp_sys.c 2005-11-07 13:03:39.000000000 -0500
|
|
||||||
@@ -429,13 +429,16 @@
|
|
||||||
SV *tmpsv;
|
|
||||||
char *tmps;
|
|
||||||
STRLEN len;
|
|
||||||
- if (SP - MARK != 1) {
|
|
||||||
+ if (SP - MARK > 1) {
|
|
||||||
dTARGET;
|
|
||||||
do_join(TARG, &PL_sv_no, MARK, SP);
|
|
||||||
tmpsv = TARG;
|
|
||||||
SP = MARK + 1;
|
|
||||||
- }
|
|
||||||
- else {
|
|
||||||
+ }
|
|
||||||
+ else if (SP == MARK ) {
|
|
||||||
+ tmpsv = &PL_sv_no;
|
|
||||||
+ EXTEND(SP, 1);
|
|
||||||
+ } else {
|
|
||||||
tmpsv = TOPs;
|
|
||||||
}
|
|
||||||
tmps = SvPV(tmpsv, len);
|
|
||||||
@@ -3517,7 +3520,7 @@
|
|
||||||
I32 value = (I32)apply(PL_op->op_type, MARK, SP);
|
|
||||||
|
|
||||||
SP = MARK;
|
|
||||||
- PUSHi(value);
|
|
||||||
+ XPUSHi(value);
|
|
||||||
RETURN;
|
|
||||||
#else
|
|
||||||
DIE(aTHX_ PL_no_func, "chown");
|
|
||||||
@@ -4127,7 +4130,7 @@
|
|
||||||
if (errno != EAGAIN) {
|
|
||||||
value = -1;
|
|
||||||
SP = ORIGMARK;
|
|
||||||
- PUSHi(value);
|
|
||||||
+ XPUSHi(value);
|
|
||||||
if (did_pipes) {
|
|
||||||
PerlLIO_close(pp[0]);
|
|
||||||
PerlLIO_close(pp[1]);
|
|
||||||
@@ -4176,7 +4179,7 @@
|
|
||||||
STATUS_CURRENT = -1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
- PUSHi(STATUS_CURRENT);
|
|
||||||
+ XPUSHi(STATUS_CURRENT);
|
|
||||||
RETURN;
|
|
||||||
}
|
|
||||||
if (did_pipes) {
|
|
||||||
@@ -4222,7 +4225,7 @@
|
|
||||||
STATUS_NATIVE_SET(value);
|
|
||||||
do_execfree();
|
|
||||||
SP = ORIGMARK;
|
|
||||||
- PUSHi(result ? value : STATUS_CURRENT);
|
|
||||||
+ XPUSHi(result ? value : STATUS_CURRENT);
|
|
||||||
#endif /* !FORK or VMS */
|
|
||||||
RETURN;
|
|
||||||
}
|
|
||||||
@@ -4275,7 +4278,7 @@
|
|
||||||
}
|
|
||||||
|
|
||||||
SP = ORIGMARK;
|
|
||||||
- PUSHi(value);
|
|
||||||
+ XPUSHi(value);
|
|
||||||
RETURN;
|
|
||||||
}
|
|
||||||
|
|
||||||
--- perl-5.8.7/pp.c.bz172587 2005-05-16 11:30:13.000000000 -0400
|
|
||||||
+++ perl-5.8.7/pp.c 2005-11-07 12:56:32.000000000 -0500
|
|
||||||
@@ -721,7 +721,7 @@
|
|
||||||
while (MARK < SP)
|
|
||||||
do_chop(TARG, *++MARK);
|
|
||||||
SP = ORIGMARK;
|
|
||||||
- PUSHTARG;
|
|
||||||
+ XPUSHTARG;
|
|
||||||
RETURN;
|
|
||||||
}
|
|
||||||
|
|
||||||
@@ -739,7 +739,7 @@
|
|
||||||
|
|
||||||
while (SP > MARK)
|
|
||||||
count += do_chomp(POPs);
|
|
||||||
- PUSHi(count);
|
|
||||||
+ XPUSHi(count);
|
|
||||||
RETURN;
|
|
||||||
}
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.7/util.c.25160 2005-05-30 08:44:15.000000000 -0400
|
|
||||||
+++ perl-5.8.7/util.c 2005-11-08 18:58:36.000000000 -0500
|
|
||||||
@@ -1290,6 +1290,8 @@
|
|
||||||
SV *msg;
|
|
||||||
|
|
||||||
ENTER;
|
|
||||||
+ SAVESPTR(PL_warnhook);
|
|
||||||
+ PL_warnhook = Nullsv;
|
|
||||||
save_re_context();
|
|
||||||
msg = newSVpvn(message, msglen);
|
|
||||||
SvFLAGS(msg) |= utf8;
|
|
@ -1,63 +0,0 @@
|
|||||||
--- perl-5.8.7/perl.c.orig 2005-04-22 17:14:27.000000000 +0300
|
|
||||||
+++ perl-5.8.7/perl.c 2005-06-17 22:31:31.000000000 +0300
|
|
||||||
@@ -109,6 +109,7 @@
|
|
||||||
#endif
|
|
||||||
|
|
||||||
static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
|
|
||||||
+STATIC void incpush_oldversion(pTHX_ char *dir);
|
|
||||||
|
|
||||||
#ifdef IAMSUID
|
|
||||||
#ifndef DOSUID
|
|
||||||
@@ -4435,6 +4436,7 @@
|
|
||||||
* DLL-based path intuition to work correctly */
|
|
||||||
# if !defined(WIN32)
|
|
||||||
incpush(SITEARCH_EXP, FALSE, FALSE, TRUE);
|
|
||||||
+ incpush_oldversion(aTHX_ SITEARCH_EXP);
|
|
||||||
# endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
@@ -4456,6 +4458,7 @@
|
|
||||||
* DLL-based path intuition to work correctly */
|
|
||||||
# if !defined(WIN32)
|
|
||||||
incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE);
|
|
||||||
+ incpush_oldversion(aTHX_ PERL_VENDORARCH_EXP);
|
|
||||||
# endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
@@ -4497,6 +4500,36 @@
|
|
||||||
# define PERLLIB_MANGLE(s,n) (s)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
+#define VERSION_DIRECTORY_STRING "/5.8.7"
|
|
||||||
+STATIC void
|
|
||||||
+incpush_oldversion(pTHX_ char *dir)
|
|
||||||
+{
|
|
||||||
+#ifdef PERL_INC_VERSION_LIST
|
|
||||||
+ const char *incverlist[] = { PERL_INC_VERSION_LIST };
|
|
||||||
+ const char **incver;
|
|
||||||
+ const char *verdir;
|
|
||||||
+
|
|
||||||
+ verdir = strstr(dir, VERSION_DIRECTORY_STRING);
|
|
||||||
+ if (!verdir)
|
|
||||||
+ return;
|
|
||||||
+
|
|
||||||
+ for (incver = incverlist; *incver; incver++) {
|
|
||||||
+ char *new_dir = malloc(strlen(dir) + strlen(*incver) + 2);
|
|
||||||
+ char *p = new_dir;
|
|
||||||
+
|
|
||||||
+ strcpy(new_dir, dir);
|
|
||||||
+ p += verdir - dir + 1; /* advance to char following '/' in VERSION_DIRECTORY_STRING */
|
|
||||||
+ memcpy(p, *incver, strlen(*incver)); /* copy incver there instead */
|
|
||||||
+ p += strlen(*incver); /* advance past version we just copied */
|
|
||||||
+ strcpy(p, verdir + strlen(VERSION_DIRECTORY_STRING)); /* and copy the rest of the original dir */
|
|
||||||
+
|
|
||||||
+ incpush(new_dir, FALSE, FALSE, FALSE);
|
|
||||||
+ free(new_dir);
|
|
||||||
+ }
|
|
||||||
+#endif
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
+
|
|
||||||
/* Push a directory onto @INC if it exists.
|
|
||||||
Generate a new SV if we do this, to save needing to copy the SV we push
|
|
||||||
onto @INC */
|
|
@ -1,12 +0,0 @@
|
|||||||
--- perl-5.8.7/Configure.orig 2005-08-28 18:48:03.000000000 -0400
|
|
||||||
+++ perl-5.8.7/Configure 2005-08-28 18:49:28.000000000 -0400
|
|
||||||
@@ -4707,9 +4707,6 @@
|
|
||||||
case "$gccversion" in
|
|
||||||
1*) dflt='-fpcc-struct-return' ;;
|
|
||||||
esac
|
|
||||||
- case "$optimize" in
|
|
||||||
- *-g*) dflt="$dflt -DDEBUGGING";;
|
|
||||||
- esac
|
|
||||||
case "$gccversion" in
|
|
||||||
2*) if test -d /etc/conf/kconfig.d &&
|
|
||||||
$contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1
|
|
@ -1,122 +0,0 @@
|
|||||||
--- perl-5.8.8-RC1/utils/c2ph.PL.CAN-2004-0976 2004-10-19 15:45:42.000000000 -0400
|
|
||||||
+++ perl-5.8.8-RC1/utils/c2ph.PL 2006-01-20 15:51:09.000000000 -0500
|
|
||||||
@@ -1320,7 +1320,7 @@
|
|
||||||
$intrinsics{$_[1]} = $template{$_[0]};
|
|
||||||
}
|
|
||||||
close(PIPE) || die "couldn't read intrinsics!";
|
|
||||||
- unlink($TMP, '$SAFEDIR/a.out');
|
|
||||||
+ unlink($TMP, "$SAFEDIR/a.out");
|
|
||||||
print STDERR "done\n" if $trace;
|
|
||||||
}
|
|
||||||
|
|
||||||
--- perl-5.8.8-RC1/lib/CGI/Cookie.pm.CAN-2004-0976 2006-01-08 11:39:14.000000000 -0500
|
|
||||||
+++ perl-5.8.8-RC1/lib/CGI/Cookie.pm 2006-01-20 15:51:09.000000000 -0500
|
|
||||||
@@ -407,7 +407,7 @@
|
|
||||||
You may also retrieve cookies that were stored in some external
|
|
||||||
form using the parse() class method:
|
|
||||||
|
|
||||||
- $COOKIES = `cat /usr/tmp/Cookie_stash`;
|
|
||||||
+ $COOKIES = `cat /var/run/www/Cookie_stash`;
|
|
||||||
%cookies = parse CGI::Cookie($COOKIES);
|
|
||||||
|
|
||||||
If you are in a mod_perl environment, you can save some overhead by
|
|
||||||
--- perl-5.8.8-RC1/lib/Memoize/t/tie_storable.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
|
|
||||||
+++ perl-5.8.8-RC1/lib/Memoize/t/tie_storable.t 2006-01-20 15:51:09.000000000 -0500
|
|
||||||
@@ -33,14 +33,7 @@
|
|
||||||
|
|
||||||
print "1..4\n";
|
|
||||||
|
|
||||||
-
|
|
||||||
-if (eval {require File::Spec::Functions}) {
|
|
||||||
- File::Spec::Functions->import();
|
|
||||||
-} else {
|
|
||||||
- *catfile = sub { join '/', @_ };
|
|
||||||
-}
|
|
||||||
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
|
|
||||||
-$file = catfile($tmpdir, "storable$$");
|
|
||||||
+$file = "storable$$";
|
|
||||||
1 while unlink $file;
|
|
||||||
tryout('Memoize::Storable', $file, 1); # Test 1..4
|
|
||||||
1 while unlink $file;
|
|
||||||
--- perl-5.8.8-RC1/lib/Memoize/t/tie_ndbm.t.CAN-2004-0976 2005-04-22 07:36:58.000000000 -0400
|
|
||||||
+++ perl-5.8.8-RC1/lib/Memoize/t/tie_ndbm.t 2006-01-20 15:51:09.000000000 -0500
|
|
||||||
@@ -28,14 +28,7 @@
|
|
||||||
|
|
||||||
print "1..4\n";
|
|
||||||
|
|
||||||
-
|
|
||||||
-if (eval {require File::Spec::Functions}) {
|
|
||||||
- File::Spec::Functions->import();
|
|
||||||
-} else {
|
|
||||||
- *catfile = sub { join '/', @_ };
|
|
||||||
-}
|
|
||||||
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
|
|
||||||
-$file = catfile($tmpdir, "md$$");
|
|
||||||
+$file = "md$$";
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag", "$file.db";
|
|
||||||
tryout('Memoize::NDBM_File', $file, 1); # Test 1..4
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag", "$file.db";
|
|
||||||
--- perl-5.8.8-RC1/lib/Memoize/t/tie.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
|
|
||||||
+++ perl-5.8.8-RC1/lib/Memoize/t/tie.t 2006-01-20 15:51:09.000000000 -0500
|
|
||||||
@@ -29,14 +29,7 @@
|
|
||||||
$_[0]+1;
|
|
||||||
}
|
|
||||||
|
|
||||||
-if (eval {require File::Spec::Functions}) {
|
|
||||||
- File::Spec::Functions->import('tmpdir', 'catfile');
|
|
||||||
- $tmpdir = tmpdir();
|
|
||||||
-} else {
|
|
||||||
- *catfile = sub { join '/', @_ };
|
|
||||||
- $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
|
|
||||||
-}
|
|
||||||
-$file = catfile($tmpdir, "md$$");
|
|
||||||
+$file = "md$$";
|
|
||||||
@files = ($file, "$file.db", "$file.dir", "$file.pag");
|
|
||||||
1 while unlink @files;
|
|
||||||
|
|
||||||
--- perl-5.8.8-RC1/lib/Memoize/t/tie_sdbm.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
|
|
||||||
+++ perl-5.8.8-RC1/lib/Memoize/t/tie_sdbm.t 2006-01-20 15:51:09.000000000 -0500
|
|
||||||
@@ -28,14 +28,7 @@
|
|
||||||
|
|
||||||
print "1..4\n";
|
|
||||||
|
|
||||||
-if (eval {require File::Spec::Functions}) {
|
|
||||||
- File::Spec::Functions->import('tmpdir', 'catfile');
|
|
||||||
- $tmpdir = tmpdir();
|
|
||||||
-} else {
|
|
||||||
- *catfile = sub { join '/', @_ };
|
|
||||||
- $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
|
|
||||||
-}
|
|
||||||
-$file = catfile($tmpdir, "md$$");
|
|
||||||
+$file = "md$$";
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag";
|
|
||||||
tryout('Memoize::SDBM_File', $file, 1); # Test 1..4
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag";
|
|
||||||
--- perl-5.8.8-RC1/lib/Memoize/t/tie_gdbm.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
|
|
||||||
+++ perl-5.8.8-RC1/lib/Memoize/t/tie_gdbm.t 2006-01-20 15:51:09.000000000 -0500
|
|
||||||
@@ -26,13 +26,7 @@
|
|
||||||
|
|
||||||
print "1..4\n";
|
|
||||||
|
|
||||||
-if (eval {require File::Spec::Functions}) {
|
|
||||||
- File::Spec::Functions->import();
|
|
||||||
-} else {
|
|
||||||
- *catfile = sub { join '/', @_ };
|
|
||||||
-}
|
|
||||||
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
|
|
||||||
-$file = catfile($tmpdir, "md$$");
|
|
||||||
+$file = "md$$";
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag";
|
|
||||||
tryout('GDBM_File', $file, 1); # Test 1..4
|
|
||||||
1 while unlink $file, "$file.dir", "$file.pag";
|
|
||||||
--- perl-5.8.8-RC1/lib/Shell.pm.CAN-2004-0976 2004-06-01 05:42:17.000000000 -0400
|
|
||||||
+++ perl-5.8.8-RC1/lib/Shell.pm 2006-01-20 15:51:09.000000000 -0500
|
|
||||||
@@ -127,7 +127,7 @@
|
|
||||||
use Shell qw(cat ps cp);
|
|
||||||
$passwd = cat('</etc/passwd');
|
|
||||||
@pslines = ps('-ww'),
|
|
||||||
- cp("/etc/passwd", "/tmp/passwd");
|
|
||||||
+ cp("/etc/passwd", "/etc/passwd.orig");
|
|
||||||
|
|
||||||
# object oriented
|
|
||||||
my $sh = Shell->new;
|
|
@ -1,110 +0,0 @@
|
|||||||
diff -up perl-5.8.8/ext/DB_File/Changes.BAD perl-5.8.8/ext/DB_File/Changes
|
|
||||||
--- perl-5.8.8/ext/DB_File/Changes.BAD 2007-10-01 12:31:56.000000000 -0400
|
|
||||||
+++ perl-5.8.8/ext/DB_File/Changes 2007-10-01 12:32:19.000000000 -0400
|
|
||||||
@@ -1,5 +1,12 @@
|
|
||||||
|
|
||||||
|
|
||||||
+1.815 4 February 2007
|
|
||||||
+
|
|
||||||
+ * A few casting cleanups for building with C++ from Steve Peters.
|
|
||||||
+
|
|
||||||
+ * Fixed problem with recno which happened if you changed directory after
|
|
||||||
+ opening the database. Problem reported by Andrew Pam.
|
|
||||||
+
|
|
||||||
1.814 11 November 2005
|
|
||||||
|
|
||||||
* Fix from Dominic Dunlop to tidy up an OS-X specific warning in
|
|
||||||
diff -up perl-5.8.8/ext/DB_File/DB_File.pm.BAD perl-5.8.8/ext/DB_File/DB_File.pm
|
|
||||||
--- perl-5.8.8/ext/DB_File/DB_File.pm.BAD 2007-10-01 12:32:36.000000000 -0400
|
|
||||||
+++ perl-5.8.8/ext/DB_File/DB_File.pm 2007-10-01 12:33:41.000000000 -0400
|
|
||||||
@@ -1,10 +1,10 @@
|
|
||||||
# DB_File.pm -- Perl 5 interface to Berkeley DB
|
|
||||||
#
|
|
||||||
# written by Paul Marquess (pmqs@cpan.org)
|
|
||||||
-# last modified 11th November 2005
|
|
||||||
-# version 1.814
|
|
||||||
+# last modified 4th February 2007
|
|
||||||
+# version 1.815
|
|
||||||
#
|
|
||||||
-# Copyright (c) 1995-2005 Paul Marquess. All rights reserved.
|
|
||||||
+# Copyright (c) 1995-2007 Paul Marquess. All rights reserved.
|
|
||||||
# This program is free software; you can redistribute it and/or
|
|
||||||
# modify it under the same terms as Perl itself.
|
|
||||||
|
|
||||||
@@ -165,7 +165,7 @@ our ($db_version, $use_XSLoader, $splice
|
|
||||||
use Carp;
|
|
||||||
|
|
||||||
|
|
||||||
-$VERSION = "1.814" ;
|
|
||||||
+$VERSION = "1.815" ;
|
|
||||||
|
|
||||||
{
|
|
||||||
local $SIG{__WARN__} = sub {$splice_end_array = "@_";};
|
|
||||||
@@ -260,6 +260,10 @@ sub tie_hash_or_array
|
|
||||||
my (@arg) = @_ ;
|
|
||||||
my $tieHASH = ( (caller(1))[3] =~ /TIEHASH/ ) ;
|
|
||||||
|
|
||||||
+ use File::Spec;
|
|
||||||
+ $arg[1] = File::Spec->rel2abs($arg[1])
|
|
||||||
+ if defined $arg[1] ;
|
|
||||||
+
|
|
||||||
$arg[4] = tied %{ $arg[4] }
|
|
||||||
if @arg >= 5 && ref $arg[4] && $arg[4] =~ /=HASH/ && tied %{ $arg[4] } ;
|
|
||||||
|
|
||||||
diff -up perl-5.8.8/ext/DB_File/DB_File.xs.BAD perl-5.8.8/ext/DB_File/DB_File.xs
|
|
||||||
--- perl-5.8.8/ext/DB_File/DB_File.xs.BAD 2007-10-01 12:33:52.000000000 -0400
|
|
||||||
+++ perl-5.8.8/ext/DB_File/DB_File.xs 2007-10-01 12:35:50.000000000 -0400
|
|
||||||
@@ -3,8 +3,8 @@
|
|
||||||
DB_File.xs -- Perl 5 interface to Berkeley DB
|
|
||||||
|
|
||||||
written by Paul Marquess <pmqs@cpan.org>
|
|
||||||
- last modified 11th November 2005
|
|
||||||
- version 1.814
|
|
||||||
+ last modified 4th February 2007
|
|
||||||
+ version 1.815
|
|
||||||
|
|
||||||
All comments/suggestions/problems are welcome
|
|
||||||
|
|
||||||
@@ -114,6 +114,7 @@
|
|
||||||
1.812 - no change
|
|
||||||
1.813 - no change
|
|
||||||
1.814 - no change
|
|
||||||
+ 1.814 - C++ casting fixes
|
|
||||||
|
|
||||||
*/
|
|
||||||
|
|
||||||
@@ -410,12 +411,12 @@ typedef struct {
|
|
||||||
typedef DB_File_type * DB_File ;
|
|
||||||
typedef DBT DBTKEY ;
|
|
||||||
|
|
||||||
-#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
|
|
||||||
+#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (const char *)""), s)
|
|
||||||
|
|
||||||
#define OutputValue(arg, name) \
|
|
||||||
{ if (RETVAL == 0) { \
|
|
||||||
SvGETMAGIC(arg) ; \
|
|
||||||
- my_sv_setpvn(arg, name.data, name.size) ; \
|
|
||||||
+ my_sv_setpvn(arg, (const char *)name.data, name.size) ; \
|
|
||||||
TAINT; \
|
|
||||||
SvTAINTED_on(arg); \
|
|
||||||
SvUTF8_off(arg); \
|
|
||||||
@@ -428,7 +429,7 @@ typedef DBT DBTKEY ;
|
|
||||||
{ \
|
|
||||||
SvGETMAGIC(arg) ; \
|
|
||||||
if (db->type != DB_RECNO) { \
|
|
||||||
- my_sv_setpvn(arg, name.data, name.size); \
|
|
||||||
+ my_sv_setpvn(arg, (const char *)name.data, name.size); \
|
|
||||||
} \
|
|
||||||
else \
|
|
||||||
sv_setiv(arg, (I32)*(I32*)name.data - 1); \
|
|
||||||
@@ -597,8 +598,8 @@ const DBT * key2 ;
|
|
||||||
|
|
||||||
PUSHMARK(SP) ;
|
|
||||||
EXTEND(SP,2) ;
|
|
||||||
- PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
|
|
||||||
- PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
|
|
||||||
+ PUSHs(sv_2mortal(newSVpvn((const char*)data1,key1->size)));
|
|
||||||
+ PUSHs(sv_2mortal(newSVpvn((const char*)data2,key2->size)));
|
|
||||||
PUTBACK ;
|
|
||||||
|
|
||||||
count = perl_call_sv(CurrentDB->compare, G_SCALAR);
|
|
@ -1,135 +0,0 @@
|
|||||||
--- perl-5.8.8/pod/perlrun.pod.-R-switch 2006-01-13 11:29:17.000000000 -0500
|
|
||||||
+++ perl-5.8.8/pod/perlrun.pod 2006-06-02 00:29:17.000000000 -0400
|
|
||||||
@@ -11,6 +11,7 @@
|
|
||||||
S<[ B<-I>I<dir> ] [ B<-m>[B<->]I<module> ] [ B<-M>[B<->]I<'module...'> ] [ B<-f> ]>
|
|
||||||
S<[ B<-C [I<number/list>] >]>
|
|
||||||
S<[ B<-P> ]>
|
|
||||||
+ S<[ B<-R> ]>
|
|
||||||
S<[ B<-S> ]>
|
|
||||||
S<[ B<-x>[I<dir>] ]>
|
|
||||||
S<[ B<-i>[I<extension>] ]>
|
|
||||||
@@ -813,6 +814,26 @@
|
|
||||||
before being searched for on the PATH. On Unix platforms, the
|
|
||||||
program will be searched for strictly on the PATH.
|
|
||||||
|
|
||||||
+=item B<-R>
|
|
||||||
+X<-R>
|
|
||||||
+
|
|
||||||
+Disables the Red Hat module compatibility default search path.
|
|
||||||
+
|
|
||||||
+By default, the Red Hat perl distribution will prepend to the default
|
|
||||||
+search path (@INC) the -V:archname subdirectory of each member of
|
|
||||||
+the -V:inc_version_list under the perl vendor and site installation
|
|
||||||
+directories.
|
|
||||||
+i.e. in shell notation:
|
|
||||||
+ {-V:vendorlib_stem,-V:sitelib_stem}/{-V:inc_version_list}/-V:archname
|
|
||||||
+where inc_version_list includes every previous perl version shipped
|
|
||||||
+by Red Hat, to provide compatibility for binary modules installed under
|
|
||||||
+previous perl versions. This can be quite a long list of directories
|
|
||||||
+to search, which can slow down module loading. You can disable searching
|
|
||||||
+these previous perl version architecture specific directories by specifying
|
|
||||||
+the -R switch - then the default search path will be as for the default
|
|
||||||
+upstream perl release.
|
|
||||||
+
|
|
||||||
+
|
|
||||||
=item B<-t>
|
|
||||||
X<-t>
|
|
||||||
|
|
||||||
--- perl-5.8.8/proto.h.-R-switch 2006-06-01 19:13:32.000000000 -0400
|
|
||||||
+++ perl-5.8.8/proto.h 2006-06-01 23:15:04.000000000 -0400
|
|
||||||
@@ -1620,7 +1620,7 @@
|
|
||||||
STATIC void S_init_ids(pTHX);
|
|
||||||
STATIC void S_init_lexer(pTHX);
|
|
||||||
STATIC void S_init_main_stash(pTHX);
|
|
||||||
-STATIC void S_init_perllib(pTHX);
|
|
||||||
+STATIC void S_init_perllib(pTHX,bool rhi);
|
|
||||||
STATIC void S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env);
|
|
||||||
STATIC void S_init_predump_symbols(pTHX);
|
|
||||||
STATIC void S_my_exit_jump(pTHX)
|
|
||||||
--- perl-5.8.8/embed.fnc.-R-switch 2006-06-01 19:13:32.000000000 -0400
|
|
||||||
+++ perl-5.8.8/embed.fnc 2006-06-01 23:21:25.000000000 -0400
|
|
||||||
@@ -1080,7 +1080,7 @@
|
|
||||||
s |void |init_ids
|
|
||||||
s |void |init_lexer
|
|
||||||
s |void |init_main_stash
|
|
||||||
-s |void |init_perllib
|
|
||||||
+s |void |init_perllib |bool redhat_incpush
|
|
||||||
s |void |init_postdump_symbols|int argc|NN char **argv|NULLOK char **env
|
|
||||||
s |void |init_predump_symbols
|
|
||||||
rs |void |my_exit_jump
|
|
||||||
--- perl-5.8.8/embed.h.-R-switch 2006-06-01 19:13:32.000000000 -0400
|
|
||||||
+++ perl-5.8.8/embed.h 2006-06-01 23:13:11.000000000 -0400
|
|
||||||
@@ -3170,7 +3170,7 @@
|
|
||||||
#define init_ids() S_init_ids(aTHX)
|
|
||||||
#define init_lexer() S_init_lexer(aTHX)
|
|
||||||
#define init_main_stash() S_init_main_stash(aTHX)
|
|
||||||
-#define init_perllib() S_init_perllib(aTHX)
|
|
||||||
+#define init_perllib(rhi) S_init_perllib(aTHX,rhi)
|
|
||||||
#define init_postdump_symbols(a,b,c) S_init_postdump_symbols(aTHX_ a,b,c)
|
|
||||||
#define init_predump_symbols() S_init_predump_symbols(aTHX)
|
|
||||||
#define my_exit_jump() S_my_exit_jump(aTHX)
|
|
||||||
--- perl-5.8.8/perl.c.-R-switch 2006-06-01 23:08:08.000000000 -0400
|
|
||||||
+++ perl-5.8.8/perl.c 2006-06-02 00:00:23.000000000 -0400
|
|
||||||
@@ -1649,6 +1649,7 @@
|
|
||||||
#ifdef USE_SITECUSTOMIZE
|
|
||||||
bool minus_f = FALSE;
|
|
||||||
#endif
|
|
||||||
+ bool redhat_incpush = TRUE;
|
|
||||||
|
|
||||||
PL_fdscript = -1;
|
|
||||||
PL_suidscript = -1;
|
|
||||||
@@ -1770,11 +1771,15 @@
|
|
||||||
PL_preprocess = TRUE;
|
|
||||||
s++;
|
|
||||||
goto reswitch;
|
|
||||||
+ case 'R':
|
|
||||||
+ redhat_incpush = FALSE;
|
|
||||||
+ s++;
|
|
||||||
+ goto reswitch;
|
|
||||||
case 'S':
|
|
||||||
forbid_setid("-S");
|
|
||||||
dosearch = TRUE;
|
|
||||||
s++;
|
|
||||||
- goto reswitch;
|
|
||||||
+ goto reswitch;
|
|
||||||
case 'V':
|
|
||||||
{
|
|
||||||
SV *opts_prog;
|
|
||||||
@@ -2062,7 +2067,7 @@
|
|
||||||
scriptname = "-";
|
|
||||||
}
|
|
||||||
|
|
||||||
- init_perllib();
|
|
||||||
+ init_perllib(redhat_incpush);
|
|
||||||
|
|
||||||
open_script(scriptname,dosearch,sv);
|
|
||||||
|
|
||||||
@@ -4736,7 +4741,7 @@
|
|
||||||
}
|
|
||||||
|
|
||||||
STATIC void
|
|
||||||
-S_init_perllib(pTHX)
|
|
||||||
+S_init_perllib(pTHX, bool redhat_incpush)
|
|
||||||
{
|
|
||||||
char *s;
|
|
||||||
if (!PL_tainting) {
|
|
||||||
@@ -4803,7 +4808,8 @@
|
|
||||||
* DLL-based path intuition to work correctly */
|
|
||||||
# if !defined(WIN32)
|
|
||||||
incpush(SITEARCH_EXP, FALSE, FALSE, TRUE);
|
|
||||||
- incpush_oldversion(aTHX_ SITEARCH_EXP);
|
|
||||||
+ if ( redhat_incpush )
|
|
||||||
+ incpush_oldversion(aTHX_ SITEARCH_EXP);
|
|
||||||
# endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
@@ -4825,7 +4831,8 @@
|
|
||||||
* DLL-based path intuition to work correctly */
|
|
||||||
# if !defined(WIN32)
|
|
||||||
incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE);
|
|
||||||
- incpush_oldversion(aTHX_ PERL_VENDORARCH_EXP);
|
|
||||||
+ if ( redhat_incpush )
|
|
||||||
+ incpush_oldversion(aTHX_ PERL_VENDORARCH_EXP);
|
|
||||||
# endif
|
|
||||||
#endif
|
|
||||||
|
|
@ -1,44 +0,0 @@
|
|||||||
--- perl-5.8.8/t/op/index.t.U27116 2005-10-31 09:11:17.000000000 -0500
|
|
||||||
+++ perl-5.8.8/t/op/index.t 2006-06-01 18:20:53.000000000 -0400
|
|
||||||
@@ -7,7 +7,7 @@
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
require './test.pl';
|
|
||||||
-plan( tests => 58 );
|
|
||||||
+plan( tests => 66 );
|
|
||||||
|
|
||||||
my $foo = 'Now is the time for all good men to come to the aid of their country.';
|
|
||||||
|
|
||||||
@@ -121,3 +121,15 @@
|
|
||||||
is (index($text, $search_octets), -1);
|
|
||||||
is (rindex($text, $search_octets), -1);
|
|
||||||
}
|
|
||||||
+
|
|
||||||
+foreach my $utf8 ('', ', utf-8') {
|
|
||||||
+ foreach my $arraybase (0, 1, -1, -2) {
|
|
||||||
+ my $expect_pos = 2 + $arraybase;
|
|
||||||
+
|
|
||||||
+ my $prog = "\$[ = $arraybase; \$big = \"N\\xabN\\xab\"; ";
|
|
||||||
+ $prog .= '$big .= chr 256; chop $big; ' if $utf8;
|
|
||||||
+ $prog .= 'print rindex $big, "N", 2 + $[';
|
|
||||||
+
|
|
||||||
+ fresh_perl_is($prog, $expect_pos, {}, "\$[ = $arraybase$utf8");
|
|
||||||
+ }
|
|
||||||
+}
|
|
||||||
--- perl-5.8.8/pp.c.U27116 2006-06-01 17:04:25.000000000 -0400
|
|
||||||
+++ perl-5.8.8/pp.c 2006-06-01 18:19:16.000000000 -0400
|
|
||||||
@@ -3258,9 +3258,13 @@
|
|
||||||
if (MAXARG < 3)
|
|
||||||
offset = blen;
|
|
||||||
else {
|
|
||||||
+ /* arybase is in characters, like offset, so combine prior to the
|
|
||||||
+ UTF-8 to bytes calculation. */
|
|
||||||
+ offset -= arybase;
|
|
||||||
if (offset > 0 && big_utf8)
|
|
||||||
sv_pos_u2b(big, &offset, 0);
|
|
||||||
- offset = offset - arybase + llen;
|
|
||||||
+ /* llen is in bytes. */
|
|
||||||
+ offset += llen;
|
|
||||||
}
|
|
||||||
if (offset < 0)
|
|
||||||
offset = 0;
|
|
@ -1,112 +0,0 @@
|
|||||||
--- perl-5.8.8/t/op/lc.t.U27329 2005-11-07 09:22:36.000000000 -0500
|
|
||||||
+++ perl-5.8.8/t/op/lc.t 2006-06-01 22:02:13.000000000 -0400
|
|
||||||
@@ -6,7 +6,7 @@
|
|
||||||
require './test.pl';
|
|
||||||
}
|
|
||||||
|
|
||||||
-plan tests => 59;
|
|
||||||
+plan tests => 77;
|
|
||||||
|
|
||||||
$a = "HELLO.* world";
|
|
||||||
$b = "hello.* WORLD";
|
|
||||||
@@ -163,3 +163,38 @@
|
|
||||||
is($a, v10, "[perl #18857]");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
+
|
|
||||||
+
|
|
||||||
+# [perl #38619] Bug in lc and uc (interaction between UTF-8, substr, and lc/uc)
|
|
||||||
+
|
|
||||||
+for ("a\x{100}", "xyz\x{100}") {
|
|
||||||
+ is(substr(uc($_), 0), uc($_), "[perl #38619] uc");
|
|
||||||
+}
|
|
||||||
+for ("A\x{100}", "XYZ\x{100}") {
|
|
||||||
+ is(substr(lc($_), 0), lc($_), "[perl #38619] lc");
|
|
||||||
+}
|
|
||||||
+for ("a\x{100}", "ßyz\x{100}") { # ß to Ss (different length)
|
|
||||||
+ is(substr(ucfirst($_), 0), ucfirst($_), "[perl #38619] ucfirst");
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
+# Related to [perl #38619]
|
|
||||||
+# the original report concerns PERL_MAGIC_utf8.
|
|
||||||
+# these cases concern PERL_MAGIC_regex_global.
|
|
||||||
+
|
|
||||||
+for (map { $_ } "a\x{100}", "abc\x{100}", "\x{100}") {
|
|
||||||
+ chop; # get ("a", "abc", "") in utf8
|
|
||||||
+ my $return = uc($_) =~ /\G(.?)/g;
|
|
||||||
+ my $result = $return ? $1 : "not";
|
|
||||||
+ my $expect = (uc($_) =~ /(.?)/g)[0];
|
|
||||||
+ is($return, 1, "[perl #38619]");
|
|
||||||
+ is($result, $expect, "[perl #38619]");
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
+for (map { $_ } "A\x{100}", "ABC\x{100}", "\x{100}") {
|
|
||||||
+ chop; # get ("A", "ABC", "") in utf8
|
|
||||||
+ my $return = lc($_) =~ /\G(.?)/g;
|
|
||||||
+ my $result = $return ? $1 : "not";
|
|
||||||
+ my $expect = (lc($_) =~ /(.?)/g)[0];
|
|
||||||
+ is($return, 1, "[perl #38619]");
|
|
||||||
+ is($result, $expect, "[perl #38619]");
|
|
||||||
+}
|
|
||||||
--- perl-5.8.8/pp.c.U27329 2006-06-01 21:30:14.000000000 -0400
|
|
||||||
+++ perl-5.8.8/pp.c 2006-06-01 21:53:37.000000000 -0400
|
|
||||||
@@ -3447,7 +3447,8 @@
|
|
||||||
if (slen > ulen)
|
|
||||||
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
|
|
||||||
SvUTF8_on(TARG);
|
|
||||||
- SETs(TARG);
|
|
||||||
+ sv = TARG;
|
|
||||||
+ SETs(sv);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
s = (U8*)SvPV_force_nomg(sv, slen);
|
|
||||||
@@ -3502,7 +3503,8 @@
|
|
||||||
if (slen > ulen)
|
|
||||||
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
|
|
||||||
SvUTF8_on(TARG);
|
|
||||||
- SETs(TARG);
|
|
||||||
+ sv = TARG;
|
|
||||||
+ SETs(sv);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
s = (U8*)SvPV_force_nomg(sv, slen);
|
|
||||||
@@ -3552,7 +3554,8 @@
|
|
||||||
if (!len) {
|
|
||||||
SvUTF8_off(TARG); /* decontaminate */
|
|
||||||
sv_setpvn(TARG, "", 0);
|
|
||||||
- SETs(TARG);
|
|
||||||
+ sv = TARG;
|
|
||||||
+ SETs(sv);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
STRLEN min = len + 1;
|
|
||||||
@@ -3585,7 +3588,8 @@
|
|
||||||
*d = '\0';
|
|
||||||
SvUTF8_on(TARG);
|
|
||||||
SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
|
|
||||||
- SETs(TARG);
|
|
||||||
+ sv = TARG;
|
|
||||||
+ SETs(sv);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
@@ -3636,7 +3640,8 @@
|
|
||||||
if (!len) {
|
|
||||||
SvUTF8_off(TARG); /* decontaminate */
|
|
||||||
sv_setpvn(TARG, "", 0);
|
|
||||||
- SETs(TARG);
|
|
||||||
+ sv = TARG;
|
|
||||||
+ SETs(sv);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
STRLEN min = len + 1;
|
|
||||||
@@ -3688,7 +3693,8 @@
|
|
||||||
*d = '\0';
|
|
||||||
SvUTF8_on(TARG);
|
|
||||||
SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
|
|
||||||
- SETs(TARG);
|
|
||||||
+ sv = TARG;
|
|
||||||
+ SETs(sv);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else {
|
|
@ -1,495 +0,0 @@
|
|||||||
--- perl-5.8.8/t/op/bop.t.U27391 2006-01-06 17:44:14.000000000 -0500
|
|
||||||
+++ perl-5.8.8/t/op/bop.t 2006-06-01 18:43:20.000000000 -0400
|
|
||||||
@@ -15,7 +15,7 @@
|
|
||||||
# If you find tests are failing, please try adding names to tests to track
|
|
||||||
# down where the failure is, and supply your new names as a patch.
|
|
||||||
# (Just-in-time test naming)
|
|
||||||
-plan tests => 49;
|
|
||||||
+plan tests => 148;
|
|
||||||
|
|
||||||
# numerics
|
|
||||||
ok ((0xdead & 0xbeef) == 0x9ead);
|
|
||||||
@@ -197,3 +197,149 @@
|
|
||||||
$b &= "b";
|
|
||||||
ok($b =~ /b+$/, 'Unicode "b" is NUL-terminated');
|
|
||||||
}
|
|
||||||
+
|
|
||||||
+require "./test.pl";
|
|
||||||
+curr_test(50);
|
|
||||||
+
|
|
||||||
+# double magic tests
|
|
||||||
+
|
|
||||||
+sub TIESCALAR { bless { value => $_[1], orig => $_[1] } }
|
|
||||||
+sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] }
|
|
||||||
+sub FETCH { $_[0]{fetch}++; $_[0]{value} }
|
|
||||||
+sub stores { tied($_[0])->{value} = tied($_[0])->{orig};
|
|
||||||
+ delete(tied($_[0])->{store}) || 0 }
|
|
||||||
+sub fetches { delete(tied($_[0])->{fetch}) || 0 }
|
|
||||||
+
|
|
||||||
+# numeric double magic tests
|
|
||||||
+
|
|
||||||
+tie $x, "main", 1;
|
|
||||||
+tie $y, "main", 3;
|
|
||||||
+
|
|
||||||
+is(($x | $y), 3);
|
|
||||||
+is(fetches($x), 1);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 0);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x & $y), 1);
|
|
||||||
+is(fetches($x), 1);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 0);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x ^ $y), 2);
|
|
||||||
+is(fetches($x), 1);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 0);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x |= $y), 3);
|
|
||||||
+is(fetches($x), 2);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x &= $y), 1);
|
|
||||||
+is(fetches($x), 2);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x ^= $y), 2);
|
|
||||||
+is(fetches($x), 2);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(~~$y, 3);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+{ use integer;
|
|
||||||
+
|
|
||||||
+is(($x | $y), 3);
|
|
||||||
+is(fetches($x), 1);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 0);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x & $y), 1);
|
|
||||||
+is(fetches($x), 1);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 0);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x ^ $y), 2);
|
|
||||||
+is(fetches($x), 1);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 0);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x |= $y), 3);
|
|
||||||
+is(fetches($x), 2);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x &= $y), 1);
|
|
||||||
+is(fetches($x), 2);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x ^= $y), 2);
|
|
||||||
+is(fetches($x), 2);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(~$y, -4);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+} # end of use integer;
|
|
||||||
+
|
|
||||||
+# stringwise double magic tests
|
|
||||||
+
|
|
||||||
+tie $x, "main", "a";
|
|
||||||
+tie $y, "main", "c";
|
|
||||||
+
|
|
||||||
+is(($x | $y), ("a" | "c"));
|
|
||||||
+is(fetches($x), 1);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 0);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x & $y), ("a" & "c"));
|
|
||||||
+is(fetches($x), 1);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 0);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x ^ $y), ("a" ^ "c"));
|
|
||||||
+is(fetches($x), 1);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 0);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x |= $y), ("a" | "c"));
|
|
||||||
+is(fetches($x), 2);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x &= $y), ("a" & "c"));
|
|
||||||
+is(fetches($x), 2);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(($x ^= $y), ("a" ^ "c"));
|
|
||||||
+is(fetches($x), 2);
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($x), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
+
|
|
||||||
+is(~~$y, "c");
|
|
||||||
+is(fetches($y), 1);
|
|
||||||
+is(stores($y), 0);
|
|
||||||
--- perl-5.8.8/pp.c.U27391 2006-06-01 18:19:16.000000000 -0400
|
|
||||||
+++ perl-5.8.8/pp.c 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
@@ -2229,13 +2229,15 @@
|
|
||||||
dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
|
|
||||||
{
|
|
||||||
dPOPTOPssrl;
|
|
||||||
+ if (SvGMAGICAL(left)) mg_get(left);
|
|
||||||
+ if (SvGMAGICAL(right)) mg_get(right);
|
|
||||||
if (SvNIOKp(left) || SvNIOKp(right)) {
|
|
||||||
if (PL_op->op_private & HINT_INTEGER) {
|
|
||||||
- const IV i = SvIV(left) & SvIV(right);
|
|
||||||
+ const IV i = SvIV_nomg(left) & SvIV_nomg(right);
|
|
||||||
SETi(i);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
- const UV u = SvUV(left) & SvUV(right);
|
|
||||||
+ const UV u = SvUV_nomg(left) & SvUV_nomg(right);
|
|
||||||
SETu(u);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@@ -2252,13 +2254,15 @@
|
|
||||||
dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
|
|
||||||
{
|
|
||||||
dPOPTOPssrl;
|
|
||||||
+ if (SvGMAGICAL(left)) mg_get(left);
|
|
||||||
+ if (SvGMAGICAL(right)) mg_get(right);
|
|
||||||
if (SvNIOKp(left) || SvNIOKp(right)) {
|
|
||||||
if (PL_op->op_private & HINT_INTEGER) {
|
|
||||||
- const IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
|
|
||||||
+ const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right);
|
|
||||||
SETi(i);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
- const UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
|
|
||||||
+ const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) ^ SvUV_nomg(right);
|
|
||||||
SETu(u);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@@ -2275,13 +2279,15 @@
|
|
||||||
dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
|
|
||||||
{
|
|
||||||
dPOPTOPssrl;
|
|
||||||
+ if (SvGMAGICAL(left)) mg_get(left);
|
|
||||||
+ if (SvGMAGICAL(right)) mg_get(right);
|
|
||||||
if (SvNIOKp(left) || SvNIOKp(right)) {
|
|
||||||
if (PL_op->op_private & HINT_INTEGER) {
|
|
||||||
- const IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
|
|
||||||
+ const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right);
|
|
||||||
SETi(i);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
- const UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
|
|
||||||
+ const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) | SvUV_nomg(right);
|
|
||||||
SETu(u);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@@ -2376,13 +2382,15 @@
|
|
||||||
dSP; dTARGET; tryAMAGICun(compl);
|
|
||||||
{
|
|
||||||
dTOPss;
|
|
||||||
+ if (SvGMAGICAL(sv))
|
|
||||||
+ mg_get(sv);
|
|
||||||
if (SvNIOKp(sv)) {
|
|
||||||
if (PL_op->op_private & HINT_INTEGER) {
|
|
||||||
- const IV i = ~SvIV(sv);
|
|
||||||
+ const IV i = ~SvIV_nomg(sv);
|
|
||||||
SETi(i);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
- const UV u = ~SvUV(sv);
|
|
||||||
+ const UV u = ~SvUV_nomg(sv);
|
|
||||||
SETu(u);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@@ -2392,7 +2400,7 @@
|
|
||||||
STRLEN len;
|
|
||||||
|
|
||||||
(void)SvPV_nomg_const(sv,len); /* force check for uninit var */
|
|
||||||
- SvSetSV(TARG, sv);
|
|
||||||
+ sv_setsv_nomg(TARG, sv);
|
|
||||||
tmps = (U8*)SvPV_force(TARG, len);
|
|
||||||
anum = len;
|
|
||||||
if (SvUTF8(TARG)) {
|
|
||||||
--- perl-5.8.8/global.sym.U27391 2006-01-31 10:50:34.000000000 -0500
|
|
||||||
+++ perl-5.8.8/global.sym 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
@@ -432,6 +432,7 @@
|
|
||||||
Perl_sv_2cv
|
|
||||||
Perl_sv_2io
|
|
||||||
Perl_sv_2iv
|
|
||||||
+Perl_sv_2iv_flags
|
|
||||||
Perl_sv_2mortal
|
|
||||||
Perl_sv_2nv
|
|
||||||
Perl_sv_2pv
|
|
||||||
@@ -439,6 +440,7 @@
|
|
||||||
Perl_sv_2pvbyte
|
|
||||||
Perl_sv_pvn_nomg
|
|
||||||
Perl_sv_2uv
|
|
||||||
+Perl_sv_2uv_flags
|
|
||||||
Perl_sv_iv
|
|
||||||
Perl_sv_uv
|
|
||||||
Perl_sv_nv
|
|
||||||
--- perl-5.8.8/proto.h.U27391 2006-01-31 10:50:34.000000000 -0500
|
|
||||||
+++ perl-5.8.8/proto.h 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
@@ -1139,14 +1139,16 @@
|
|
||||||
PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV* sv);
|
|
||||||
PERL_CALLCONV CV* Perl_sv_2cv(pTHX_ SV* sv, HV** st, GV** gvp, I32 lref);
|
|
||||||
PERL_CALLCONV IO* Perl_sv_2io(pTHX_ SV* sv);
|
|
||||||
-PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV* sv);
|
|
||||||
+/* PERL_CALLCONV IV sv_2iv(pTHX_ SV* sv); */
|
|
||||||
+PERL_CALLCONV IV Perl_sv_2iv_flags(pTHX_ SV* sv, I32 flags);
|
|
||||||
PERL_CALLCONV SV* Perl_sv_2mortal(pTHX_ SV* sv);
|
|
||||||
PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV* sv);
|
|
||||||
/* PERL_CALLCONV char* sv_2pv(pTHX_ SV* sv, STRLEN* lp); */
|
|
||||||
PERL_CALLCONV char* Perl_sv_2pvutf8(pTHX_ SV* sv, STRLEN* lp);
|
|
||||||
PERL_CALLCONV char* Perl_sv_2pvbyte(pTHX_ SV* sv, STRLEN* lp);
|
|
||||||
PERL_CALLCONV char* Perl_sv_pvn_nomg(pTHX_ SV* sv, STRLEN* lp);
|
|
||||||
-PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV* sv);
|
|
||||||
+/* PERL_CALLCONV UV sv_2uv(pTHX_ SV* sv); */
|
|
||||||
+PERL_CALLCONV UV Perl_sv_2uv_flags(pTHX_ SV* sv, I32 flags);
|
|
||||||
PERL_CALLCONV IV Perl_sv_iv(pTHX_ SV* sv);
|
|
||||||
PERL_CALLCONV UV Perl_sv_uv(pTHX_ SV* sv);
|
|
||||||
PERL_CALLCONV NV Perl_sv_nv(pTHX_ SV* sv);
|
|
||||||
--- perl-5.8.8/embed.fnc.U27391 2006-01-31 09:40:27.000000000 -0500
|
|
||||||
+++ perl-5.8.8/embed.fnc 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
@@ -727,14 +727,16 @@
|
|
||||||
Apd |bool |sv_2bool |NN SV* sv
|
|
||||||
Apd |CV* |sv_2cv |NULLOK SV* sv|NN HV** st|NN GV** gvp|I32 lref
|
|
||||||
Apd |IO* |sv_2io |NN SV* sv
|
|
||||||
-Apd |IV |sv_2iv |NN SV* sv
|
|
||||||
+Amb |IV |sv_2iv |NN SV* sv
|
|
||||||
+Apd |IV |sv_2iv_flags |NN SV* sv|I32 flags
|
|
||||||
Apd |SV* |sv_2mortal |NULLOK SV* sv
|
|
||||||
Apd |NV |sv_2nv |NN SV* sv
|
|
||||||
Amb |char* |sv_2pv |NN SV* sv|NULLOK STRLEN* lp
|
|
||||||
Apd |char* |sv_2pvutf8 |NN SV* sv|NULLOK STRLEN* lp
|
|
||||||
Apd |char* |sv_2pvbyte |NN SV* sv|NULLOK STRLEN* lp
|
|
||||||
Ap |char* |sv_pvn_nomg |NN SV* sv|NULLOK STRLEN* lp
|
|
||||||
-Apd |UV |sv_2uv |NN SV* sv
|
|
||||||
+Amb |UV |sv_2uv |NN SV* sv
|
|
||||||
+Apd |UV |sv_2uv_flags |NN SV* sv|I32 flags
|
|
||||||
Apd |IV |sv_iv |NN SV* sv
|
|
||||||
Apd |UV |sv_uv |NN SV* sv
|
|
||||||
Apd |NV |sv_nv |NN SV* sv
|
|
||||||
--- perl-5.8.8/embed.h.U27391 2006-01-31 10:50:34.000000000 -0500
|
|
||||||
+++ perl-5.8.8/embed.h 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
@@ -780,13 +780,13 @@
|
|
||||||
#define sv_2bool Perl_sv_2bool
|
|
||||||
#define sv_2cv Perl_sv_2cv
|
|
||||||
#define sv_2io Perl_sv_2io
|
|
||||||
-#define sv_2iv Perl_sv_2iv
|
|
||||||
+#define sv_2iv_flags Perl_sv_2iv_flags
|
|
||||||
#define sv_2mortal Perl_sv_2mortal
|
|
||||||
#define sv_2nv Perl_sv_2nv
|
|
||||||
#define sv_2pvutf8 Perl_sv_2pvutf8
|
|
||||||
#define sv_2pvbyte Perl_sv_2pvbyte
|
|
||||||
#define sv_pvn_nomg Perl_sv_pvn_nomg
|
|
||||||
-#define sv_2uv Perl_sv_2uv
|
|
||||||
+#define sv_2uv_flags Perl_sv_2uv_flags
|
|
||||||
#define sv_iv Perl_sv_iv
|
|
||||||
#define sv_uv Perl_sv_uv
|
|
||||||
#define sv_nv Perl_sv_nv
|
|
||||||
@@ -2831,13 +2831,13 @@
|
|
||||||
#define sv_2bool(a) Perl_sv_2bool(aTHX_ a)
|
|
||||||
#define sv_2cv(a,b,c,d) Perl_sv_2cv(aTHX_ a,b,c,d)
|
|
||||||
#define sv_2io(a) Perl_sv_2io(aTHX_ a)
|
|
||||||
-#define sv_2iv(a) Perl_sv_2iv(aTHX_ a)
|
|
||||||
+#define sv_2iv_flags(a,b) Perl_sv_2iv_flags(aTHX_ a,b)
|
|
||||||
#define sv_2mortal(a) Perl_sv_2mortal(aTHX_ a)
|
|
||||||
#define sv_2nv(a) Perl_sv_2nv(aTHX_ a)
|
|
||||||
#define sv_2pvutf8(a,b) Perl_sv_2pvutf8(aTHX_ a,b)
|
|
||||||
#define sv_2pvbyte(a,b) Perl_sv_2pvbyte(aTHX_ a,b)
|
|
||||||
#define sv_pvn_nomg(a,b) Perl_sv_pvn_nomg(aTHX_ a,b)
|
|
||||||
-#define sv_2uv(a) Perl_sv_2uv(aTHX_ a)
|
|
||||||
+#define sv_2uv_flags(a,b) Perl_sv_2uv_flags(aTHX_ a,b)
|
|
||||||
#define sv_iv(a) Perl_sv_iv(aTHX_ a)
|
|
||||||
#define sv_uv(a) Perl_sv_uv(aTHX_ a)
|
|
||||||
#define sv_nv(a) Perl_sv_nv(aTHX_ a)
|
|
||||||
--- perl-5.8.8/sv.h.U27391 2006-01-02 09:51:46.000000000 -0500
|
|
||||||
+++ perl-5.8.8/sv.h 2006-06-01 18:43:20.000000000 -0400
|
|
||||||
@@ -953,6 +953,9 @@
|
|
||||||
=for apidoc Am|char*|SvPVx|SV* sv|STRLEN len
|
|
||||||
A version of C<SvPV> which guarantees to evaluate sv only once.
|
|
||||||
|
|
||||||
+=for apidoc Am|char*|SvPV_nomg|SV* sv|STRLEN len
|
|
||||||
+Like C<SvPV> but doesn't process magic.
|
|
||||||
+
|
|
||||||
=for apidoc Am|char*|SvPV_nolen|SV* sv
|
|
||||||
Returns a pointer to the string in the SV, or a stringified form of
|
|
||||||
the SV if the SV does not contain a string. The SV may cache the
|
|
||||||
@@ -962,6 +965,9 @@
|
|
||||||
Coerces the given SV to an integer and returns it. See C<SvIVx> for a
|
|
||||||
version which guarantees to evaluate sv only once.
|
|
||||||
|
|
||||||
+=for apidoc Am|IV|SvIV_nomg|SV* sv
|
|
||||||
+Like C<SvIV> but doesn't process magic.
|
|
||||||
+
|
|
||||||
=for apidoc Am|IV|SvIVx|SV* sv
|
|
||||||
Coerces the given SV to an integer and returns it. Guarantees to evaluate
|
|
||||||
sv only once. Use the more efficient C<SvIV> otherwise.
|
|
||||||
@@ -978,6 +984,9 @@
|
|
||||||
Coerces the given SV to an unsigned integer and returns it. See C<SvUVx>
|
|
||||||
for a version which guarantees to evaluate sv only once.
|
|
||||||
|
|
||||||
+=for apidoc Am|UV|SvUV_nomg|SV* sv
|
|
||||||
+Like C<SvUV> but doesn't process magic.
|
|
||||||
+
|
|
||||||
=for apidoc Am|UV|SvUVx|SV* sv
|
|
||||||
Coerces the given SV to an unsigned integer and returns it. Guarantees to
|
|
||||||
evaluate sv only once. Use the more efficient C<SvUV> otherwise.
|
|
||||||
@@ -1050,6 +1059,9 @@
|
|
||||||
#define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
|
|
||||||
#define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv))
|
|
||||||
|
|
||||||
+#define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0))
|
|
||||||
+#define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
|
|
||||||
+
|
|
||||||
/* ----*/
|
|
||||||
|
|
||||||
#define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC)
|
|
||||||
@@ -1251,6 +1263,8 @@
|
|
||||||
#define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0)
|
|
||||||
#define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC)
|
|
||||||
#define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC)
|
|
||||||
+#define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC)
|
|
||||||
+#define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC)
|
|
||||||
|
|
||||||
/* Should be named SvCatPVN_utf8_upgrade? */
|
|
||||||
#define sv_catpvn_utf8_upgrade(dsv, sstr, slen, nsv) \
|
|
||||||
--- perl-5.8.8/sv.c.U27391 2006-01-16 07:22:21.000000000 -0500
|
|
||||||
+++ perl-5.8.8/sv.c 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
@@ -2062,22 +2062,34 @@
|
|
||||||
}
|
|
||||||
#endif /* !NV_PRESERVES_UV*/
|
|
||||||
|
|
||||||
+/* sv_2iv() is now a macro using Perl_sv_2iv_flags();
|
|
||||||
+ * this function provided for binary compatibility only
|
|
||||||
+ */
|
|
||||||
+
|
|
||||||
+IV
|
|
||||||
+Perl_sv_2iv(pTHX_ register SV *sv)
|
|
||||||
+{
|
|
||||||
+ return sv_2iv_flags(sv, SV_GMAGIC);
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
/*
|
|
||||||
-=for apidoc sv_2iv
|
|
||||||
+=for apidoc sv_2iv_flags
|
|
||||||
|
|
||||||
-Return the integer value of an SV, doing any necessary string conversion,
|
|
||||||
-magic etc. Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
|
|
||||||
+Return the integer value of an SV, doing any necessary string
|
|
||||||
+conversion. If flags includes SV_GMAGIC, does an mg_get() first.
|
|
||||||
+Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
|
|
||||||
|
|
||||||
=cut
|
|
||||||
*/
|
|
||||||
|
|
||||||
IV
|
|
||||||
-Perl_sv_2iv(pTHX_ register SV *sv)
|
|
||||||
+Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
|
|
||||||
{
|
|
||||||
if (!sv)
|
|
||||||
return 0;
|
|
||||||
if (SvGMAGICAL(sv)) {
|
|
||||||
- mg_get(sv);
|
|
||||||
+ if (flags & SV_GMAGIC)
|
|
||||||
+ mg_get(sv);
|
|
||||||
if (SvIOKp(sv))
|
|
||||||
return SvIVX(sv);
|
|
||||||
if (SvNOKp(sv)) {
|
|
||||||
@@ -2361,23 +2373,34 @@
|
|
||||||
return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
|
|
||||||
}
|
|
||||||
|
|
||||||
+/* sv_2uv() is now a macro using Perl_sv_2uv_flags();
|
|
||||||
+ * this function provided for binary compatibility only
|
|
||||||
+ */
|
|
||||||
+
|
|
||||||
+UV
|
|
||||||
+Perl_sv_2uv(pTHX_ register SV *sv)
|
|
||||||
+{
|
|
||||||
+ return sv_2uv_flags(sv, SV_GMAGIC);
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
/*
|
|
||||||
-=for apidoc sv_2uv
|
|
||||||
+=for apidoc sv_2uv_flags
|
|
||||||
|
|
||||||
Return the unsigned integer value of an SV, doing any necessary string
|
|
||||||
-conversion, magic etc. Normally used via the C<SvUV(sv)> and C<SvUVx(sv)>
|
|
||||||
-macros.
|
|
||||||
+conversion. If flags includes SV_GMAGIC, does an mg_get() first.
|
|
||||||
+Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
|
|
||||||
|
|
||||||
=cut
|
|
||||||
*/
|
|
||||||
|
|
||||||
UV
|
|
||||||
-Perl_sv_2uv(pTHX_ register SV *sv)
|
|
||||||
+Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
|
|
||||||
{
|
|
||||||
if (!sv)
|
|
||||||
return 0;
|
|
||||||
if (SvGMAGICAL(sv)) {
|
|
||||||
- mg_get(sv);
|
|
||||||
+ if (flags & SV_GMAGIC)
|
|
||||||
+ mg_get(sv);
|
|
||||||
if (SvIOKp(sv))
|
|
||||||
return SvUVX(sv);
|
|
||||||
if (SvNOKp(sv))
|
|
||||||
--- perl-5.8.8/doop.c.U27391 2006-01-08 15:58:53.000000000 -0500
|
|
||||||
+++ perl-5.8.8/doop.c 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
@@ -1171,8 +1171,8 @@
|
|
||||||
|
|
||||||
if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
|
|
||||||
sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */
|
|
||||||
- lsave = lc = SvPV_const(left, leftlen);
|
|
||||||
- rsave = rc = SvPV_const(right, rightlen);
|
|
||||||
+ lsave = lc = SvPV_nomg_const(left, leftlen);
|
|
||||||
+ rsave = rc = SvPV_nomg_const(right, rightlen);
|
|
||||||
len = leftlen < rightlen ? leftlen : rightlen;
|
|
||||||
lensave = len;
|
|
||||||
if ((left_utf || right_utf) && (sv == left || sv == right)) {
|
|
||||||
@@ -1180,9 +1180,7 @@
|
|
||||||
Newxz(dc, needlen + 1, char);
|
|
||||||
}
|
|
||||||
else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
|
|
||||||
- /* Fix this to nong when change 22613 is integrated.
|
|
||||||
- (Which in turn awaits merging sv_2iv and sv_2uv) */
|
|
||||||
- dc = SvPV_force_nolen(sv);
|
|
||||||
+ dc = SvPV_force_nomg_nolen(sv);
|
|
||||||
if (SvLEN(sv) < (STRLEN)(len + 1)) {
|
|
||||||
dc = SvGROW(sv, (STRLEN)(len + 1));
|
|
||||||
(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
|
|
@ -1,12 +0,0 @@
|
|||||||
--- perl-5.8.8/perl.c.U27426 2006-06-01 17:04:25.000000000 -0400
|
|
||||||
+++ perl-5.8.8/perl.c 2006-06-01 19:00:57.000000000 -0400
|
|
||||||
@@ -3076,8 +3076,7 @@
|
|
||||||
PL_minus_F = TRUE;
|
|
||||||
PL_splitstr = ++s;
|
|
||||||
while (*s && !isSPACE(*s)) ++s;
|
|
||||||
- *s = '\0';
|
|
||||||
- PL_splitstr = savepv(PL_splitstr);
|
|
||||||
+ PL_splitstr = savepvn(PL_splitstr, s - PL_splitstr);
|
|
||||||
return s;
|
|
||||||
case 'a':
|
|
||||||
PL_minus_a = TRUE;
|
|
File diff suppressed because it is too large
Load Diff
@ -1,115 +0,0 @@
|
|||||||
--- perl-5.8.8/sv.c.U27512 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
+++ perl-5.8.8/sv.c 2006-06-01 19:13:32.000000000 -0400
|
|
||||||
@@ -7993,6 +7993,52 @@
|
|
||||||
return rv;
|
|
||||||
}
|
|
||||||
|
|
||||||
+/* This is a hack to cope with reblessing from class with overloading magic to
|
|
||||||
+ one without (or the other way). Search for every reference pointing to the
|
|
||||||
+ object. Can't use S_visit() because we would need to pass a parameter to
|
|
||||||
+ our function. */
|
|
||||||
+static void
|
|
||||||
+S_reset_amagic(pTHX_ SV *rv, const bool on) {
|
|
||||||
+ /* It is assumed that you've already turned magic on/off on rv */
|
|
||||||
+ SV* sva;
|
|
||||||
+ SV *const target = SvRV(rv);
|
|
||||||
+ /* Less 1 for the reference we've already dealt with. */
|
|
||||||
+ U32 how_many = SvREFCNT(target) - 1;
|
|
||||||
+ MAGIC *mg;
|
|
||||||
+
|
|
||||||
+ if (SvMAGICAL(target) && (mg = mg_find(target, PERL_MAGIC_backref))) {
|
|
||||||
+ /* Back referneces also need to be found, but aren't part of the
|
|
||||||
+ target's reference count. */
|
|
||||||
+ how_many += 1 + av_len((AV*)mg->mg_obj);
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
+ if (!how_many) {
|
|
||||||
+ /* There was only 1 reference to this object. */
|
|
||||||
+ return;
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
+ for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
|
|
||||||
+ register const SV * const svend = &sva[SvREFCNT(sva)];
|
|
||||||
+ register SV* sv;
|
|
||||||
+ for (sv = sva + 1; sv < svend; ++sv) {
|
|
||||||
+ if (SvTYPE(sv) != SVTYPEMASK
|
|
||||||
+ && (sv->sv_flags & SVf_ROK) == SVf_ROK
|
|
||||||
+ && SvREFCNT(sv)
|
|
||||||
+ && SvRV(sv) == target
|
|
||||||
+ && sv != rv) {
|
|
||||||
+ if (on)
|
|
||||||
+ SvAMAGIC_on(sv);
|
|
||||||
+ else
|
|
||||||
+ SvAMAGIC_off(sv);
|
|
||||||
+ if (--how_many == 0) {
|
|
||||||
+ /* We have found them all. */
|
|
||||||
+ return;
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
/*
|
|
||||||
=for apidoc sv_bless
|
|
||||||
|
|
||||||
@@ -8025,10 +8071,17 @@
|
|
||||||
(void)SvUPGRADE(tmpRef, SVt_PVMG);
|
|
||||||
SvSTASH_set(tmpRef, (HV*)SvREFCNT_inc(stash));
|
|
||||||
|
|
||||||
- if (Gv_AMG(stash))
|
|
||||||
- SvAMAGIC_on(sv);
|
|
||||||
- else
|
|
||||||
- SvAMAGIC_off(sv);
|
|
||||||
+ if (Gv_AMG(stash)) {
|
|
||||||
+ if (!SvAMAGIC(sv)) {
|
|
||||||
+ SvAMAGIC_on(sv);
|
|
||||||
+ S_reset_amagic(aTHX_ sv, TRUE);
|
|
||||||
+ }
|
|
||||||
+ } else {
|
|
||||||
+ if (SvAMAGIC(sv)) {
|
|
||||||
+ SvAMAGIC_off(sv);
|
|
||||||
+ S_reset_amagic(aTHX_ sv, FALSE);
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
|
|
||||||
if(SvSMAGICAL(tmpRef))
|
|
||||||
if(mg_find(tmpRef, PERL_MAGIC_ext) || mg_find(tmpRef, PERL_MAGIC_uvar))
|
|
||||||
--- perl-5.8.8/proto.h.U27512 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
+++ perl-5.8.8/proto.h 2006-06-01 19:13:32.000000000 -0400
|
|
||||||
@@ -1875,6 +1875,7 @@
|
|
||||||
#
|
|
||||||
STATIC bool S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I32 uoff, const U8 **sp, const U8 *start, const U8 *send);
|
|
||||||
STATIC bool S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 offsetp, const U8 *s, const U8 *start);
|
|
||||||
+STATIC void S_reset_amagic(pTHX_ SV *rv, const bool on);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
|
|
||||||
--- perl-5.8.8/embed.h.U27512 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
+++ perl-5.8.8/embed.h 2006-06-01 19:13:32.000000000 -0400
|
|
||||||
@@ -1348,6 +1348,7 @@
|
|
||||||
#ifdef PERL_CORE
|
|
||||||
#define utf8_mg_pos S_utf8_mg_pos
|
|
||||||
#define utf8_mg_pos_init S_utf8_mg_pos_init
|
|
||||||
+#define reset_amagic S_reset_amagic
|
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
|
|
||||||
@@ -3390,6 +3391,7 @@
|
|
||||||
#ifdef PERL_CORE
|
|
||||||
#define utf8_mg_pos(a,b,c,d,e,f,g,h,i) S_utf8_mg_pos(aTHX_ a,b,c,d,e,f,g,h,i)
|
|
||||||
#define utf8_mg_pos_init(a,b,c,d,e,f,g) S_utf8_mg_pos_init(aTHX_ a,b,c,d,e,f,g)
|
|
||||||
+#define reset_amagic(a,b) S_reset_amagic(aTHX_ a,b)
|
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
|
|
||||||
--- perl-5.8.8/embed.fnc.U27512 2006-06-01 18:43:19.000000000 -0400
|
|
||||||
+++ perl-5.8.8/embed.fnc 2006-06-01 19:13:32.000000000 -0400
|
|
||||||
@@ -1276,6 +1276,7 @@
|
|
||||||
s |bool |utf8_mg_pos_init |NN SV *sv|NN MAGIC **mgp \
|
|
||||||
|NN STRLEN **cachep|I32 i|I32 offsetp \
|
|
||||||
|NN const U8 *s|NN const U8 *start
|
|
||||||
+s |void |reset_amagic |NN SV *rv|const bool on
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
|
|
@ -1,128 +0,0 @@
|
|||||||
--- /dev/null 2006-06-01 12:59:27.771303750 -0400
|
|
||||||
+++ perl-5.8.8/t/op/regexp_qr.t 2006-06-01 19:24:53.000000000 -0400
|
|
||||||
@@ -0,0 +1,10 @@
|
|
||||||
+#!./perl
|
|
||||||
+
|
|
||||||
+$qr = 1;
|
|
||||||
+for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
|
|
||||||
+ if (-r $file) {
|
|
||||||
+ do $file;
|
|
||||||
+ exit;
|
|
||||||
+ }
|
|
||||||
+}
|
|
||||||
+die "Cannot find ./op/regexp.t or ./t/op/regexp.t\n";
|
|
||||||
--- perl-5.8.8/t/op/regexp.t.U27604 2001-10-27 14:09:24.000000000 -0400
|
|
||||||
+++ perl-5.8.8/t/op/regexp.t 2006-06-01 19:24:53.000000000 -0400
|
|
||||||
@@ -49,6 +49,7 @@
|
|
||||||
$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
|
|
||||||
$ffff = chr(0xff) x 2;
|
|
||||||
$nulnul = "\0" x 2;
|
|
||||||
+$OP = $qr ? 'qr' : 'm';
|
|
||||||
|
|
||||||
$| = 1;
|
|
||||||
print "1..$numtests\n# $iters iterations\n";
|
|
||||||
@@ -73,7 +74,7 @@
|
|
||||||
$result =~ s/B//i unless $skip;
|
|
||||||
for $study ('', 'study \$subject') {
|
|
||||||
$c = $iters;
|
|
||||||
- eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";";
|
|
||||||
+ eval "$study; \$match = (\$subject =~ $OP$pat) while \$c--; \$got = \"$repl\";";
|
|
||||||
chomp( $err = $@ );
|
|
||||||
if ($result eq 'c') {
|
|
||||||
if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }
|
|
||||||
--- perl-5.8.8/regexec.c.U27604 2006-01-08 15:59:30.000000000 -0500
|
|
||||||
+++ perl-5.8.8/regexec.c 2006-06-01 19:24:53.000000000 -0400
|
|
||||||
@@ -412,6 +412,7 @@
|
|
||||||
I32 ml_anch;
|
|
||||||
register char *other_last = Nullch; /* other substr checked before this */
|
|
||||||
char *check_at = Nullch; /* check substr found at this pos */
|
|
||||||
+ const I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);
|
|
||||||
#ifdef DEBUGGING
|
|
||||||
const char * const i_strpos = strpos;
|
|
||||||
SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
|
|
||||||
@@ -473,7 +474,7 @@
|
|
||||||
if (prog->reganch & ROPT_ANCH) { /* Match at beg-of-str or after \n */
|
|
||||||
ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
|
|
||||||
|| ( (prog->reganch & ROPT_ANCH_BOL)
|
|
||||||
- && !PL_multiline ) ); /* Check after \n? */
|
|
||||||
+ && !multiline ) ); /* Check after \n? */
|
|
||||||
|
|
||||||
if (!ml_anch) {
|
|
||||||
if ( !(prog->reganch & (ROPT_ANCH_GPOS /* Checked by the caller */
|
|
||||||
@@ -568,11 +569,11 @@
|
|
||||||
else if (prog->reganch & ROPT_CANY_SEEN)
|
|
||||||
s = fbm_instr((U8*)(s + start_shift),
|
|
||||||
(U8*)(strend - end_shift),
|
|
||||||
- check, PL_multiline ? FBMrf_MULTILINE : 0);
|
|
||||||
+ check, multiline ? FBMrf_MULTILINE : 0);
|
|
||||||
else
|
|
||||||
s = fbm_instr(HOP3(s, start_shift, strend),
|
|
||||||
HOP3(strend, -end_shift, strbeg),
|
|
||||||
- check, PL_multiline ? FBMrf_MULTILINE : 0);
|
|
||||||
+ check, multiline ? FBMrf_MULTILINE : 0);
|
|
||||||
|
|
||||||
/* Update the count-of-usability, remove useless subpatterns,
|
|
||||||
unshift s. */
|
|
||||||
@@ -643,7 +644,7 @@
|
|
||||||
HOP3(HOP3(last1, prog->anchored_offset, strend)
|
|
||||||
+ SvCUR(must), -(SvTAIL(must)!=0), strbeg),
|
|
||||||
must,
|
|
||||||
- PL_multiline ? FBMrf_MULTILINE : 0
|
|
||||||
+ multiline ? FBMrf_MULTILINE : 0
|
|
||||||
);
|
|
||||||
DEBUG_r(PerlIO_printf(Perl_debug_log,
|
|
||||||
"%s anchored substr \"%s%.*s%s\"%s",
|
|
||||||
@@ -704,7 +705,7 @@
|
|
||||||
s = fbm_instr((unsigned char*)s,
|
|
||||||
(unsigned char*)last + SvCUR(must)
|
|
||||||
- (SvTAIL(must)!=0),
|
|
||||||
- must, PL_multiline ? FBMrf_MULTILINE : 0);
|
|
||||||
+ must, multiline ? FBMrf_MULTILINE : 0);
|
|
||||||
/* FIXME - DEBUG_EXECUTE_r if that is merged to maint */
|
|
||||||
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr \"%s%.*s%s\"%s",
|
|
||||||
(s ? "Found" : "Contradicts"),
|
|
||||||
@@ -1639,6 +1640,7 @@
|
|
||||||
char *scream_olds;
|
|
||||||
SV* oreplsv = GvSV(PL_replgv);
|
|
||||||
const bool do_utf8 = DO_UTF8(sv);
|
|
||||||
+ const I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);
|
|
||||||
#ifdef DEBUGGING
|
|
||||||
SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
|
|
||||||
SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
|
|
||||||
@@ -1756,7 +1758,7 @@
|
|
||||||
if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
|
|
||||||
if (s == startpos && regtry(prog, startpos))
|
|
||||||
goto got_it;
|
|
||||||
- else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
|
|
||||||
+ else if (multiline || (prog->reganch & ROPT_IMPLICIT)
|
|
||||||
|| (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
|
|
||||||
{
|
|
||||||
char *end;
|
|
||||||
@@ -1889,7 +1891,7 @@
|
|
||||||
end_shift, &scream_pos, 0))
|
|
||||||
: (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
|
|
||||||
(unsigned char*)strend, must,
|
|
||||||
- PL_multiline ? FBMrf_MULTILINE : 0))) ) {
|
|
||||||
+ multiline ? FBMrf_MULTILINE : 0))) ) {
|
|
||||||
/* we may be pointing at the wrong string */
|
|
||||||
if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
|
|
||||||
s = strbeg + (s - SvPVX_const(sv));
|
|
||||||
@@ -1990,7 +1992,7 @@
|
|
||||||
if (SvTAIL(float_real)) {
|
|
||||||
if (memEQ(strend - len + 1, little, len - 1))
|
|
||||||
last = strend - len + 1;
|
|
||||||
- else if (!PL_multiline)
|
|
||||||
+ else if (!multiline)
|
|
||||||
last = memEQ(strend - len, little, len)
|
|
||||||
? strend - len : Nullch;
|
|
||||||
else
|
|
||||||
--- perl-5.8.8/MANIFEST.U27604 2006-01-31 18:27:53.000000000 -0500
|
|
||||||
+++ perl-5.8.8/MANIFEST 2006-06-01 19:24:52.000000000 -0400
|
|
||||||
@@ -2802,6 +2802,7 @@
|
|
||||||
t/op/ref.t See if refs and objects work
|
|
||||||
t/op/regexp_noamp.t See if regular expressions work with optimizations
|
|
||||||
t/op/regexp.t See if regular expressions work
|
|
||||||
+t/op/regexp_qr.t See if regular expressions work as qr//
|
|
||||||
t/op/regmesg.t See if one can get regular expression errors
|
|
||||||
t/op/repeat.t See if x operator works
|
|
||||||
t/op/re_tests Regular expressions for regexp.t
|
|
@ -1,41 +0,0 @@
|
|||||||
--- perl-5.8.8/mg.c.U27605 2006-01-27 15:23:21.000000000 -0500
|
|
||||||
+++ perl-5.8.8/mg.c 2006-06-01 19:37:17.000000000 -0400
|
|
||||||
@@ -2520,10 +2520,10 @@
|
|
||||||
#endif
|
|
||||||
/* PL_origalen is set in perl_parse(). */
|
|
||||||
s = SvPV_force(sv,len);
|
|
||||||
- if (len >= (STRLEN)PL_origalen) {
|
|
||||||
- /* Longer than original, will be truncated. */
|
|
||||||
- Copy(s, PL_origargv[0], PL_origalen, char);
|
|
||||||
- PL_origargv[0][PL_origalen - 1] = 0;
|
|
||||||
+ if (len >= (STRLEN)PL_origalen-1) {
|
|
||||||
+ /* Longer than original, will be truncated. We assume that
|
|
||||||
+ * PL_origalen bytes are available. */
|
|
||||||
+ Copy(s, PL_origargv[0], PL_origalen-1, char);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
/* Shorter than original, will be padded. */
|
|
||||||
@@ -2536,9 +2536,10 @@
|
|
||||||
* --jhi */
|
|
||||||
(int)' ',
|
|
||||||
PL_origalen - len - 1);
|
|
||||||
- for (i = 1; i < PL_origargc; i++)
|
|
||||||
- PL_origargv[i] = 0;
|
|
||||||
}
|
|
||||||
+ PL_origargv[0][PL_origalen-1] = 0;
|
|
||||||
+ for (i = 1; i < PL_origargc; i++)
|
|
||||||
+ PL_origargv[i] = 0;
|
|
||||||
UNLOCK_DOLLARZERO_MUTEX;
|
|
||||||
break;
|
|
||||||
#endif
|
|
||||||
--- perl-5.8.8/perl.c.U27605 2006-06-01 19:00:57.000000000 -0400
|
|
||||||
+++ perl-5.8.8/perl.c 2006-06-01 19:37:17.000000000 -0400
|
|
||||||
@@ -1561,7 +1561,7 @@
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
- PL_origalen = s - PL_origargv[0];
|
|
||||||
+ PL_origalen = s - PL_origargv[0] + 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
if (PL_do_undump) {
|
|
@ -1,61 +0,0 @@
|
|||||||
--- perl-5.8.8/t/op/local.t.U27914 2006-01-03 10:11:35.000000000 -0500
|
|
||||||
+++ perl-5.8.8/t/op/local.t 2006-06-01 19:49:54.000000000 -0400
|
|
||||||
@@ -4,7 +4,7 @@
|
|
||||||
chdir 't' if -d 't';
|
|
||||||
require './test.pl';
|
|
||||||
}
|
|
||||||
-plan tests => 81;
|
|
||||||
+plan tests => 85;
|
|
||||||
|
|
||||||
my $list_assignment_supported = 1;
|
|
||||||
|
|
||||||
@@ -313,3 +313,19 @@
|
|
||||||
{ local @x{c,d,e}; }
|
|
||||||
ok(! exists $x{c});
|
|
||||||
}
|
|
||||||
+
|
|
||||||
+# local() and readonly magic variables
|
|
||||||
+
|
|
||||||
+eval { local $1 = 1 };
|
|
||||||
+like($@, qr/Modification of a read-only value attempted/);
|
|
||||||
+
|
|
||||||
+eval { for ($1) { local $_ = 1 } };
|
|
||||||
+like($@, qr/Modification of a read-only value attempted/);
|
|
||||||
+
|
|
||||||
+# make sure $1 is still read-only
|
|
||||||
+eval { for ($1) { local $_ = 1 } };
|
|
||||||
+is($@, "");
|
|
||||||
+
|
|
||||||
+# The s/// adds 'g' magic to $_, but it should remain non-readonly
|
|
||||||
+eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
|
|
||||||
+is($@, "");
|
|
||||||
--- perl-5.8.8/scope.c.U27914 2005-09-30 09:56:51.000000000 -0400
|
|
||||||
+++ perl-5.8.8/scope.c 2006-06-01 19:49:54.000000000 -0400
|
|
||||||
@@ -205,9 +205,9 @@
|
|
||||||
register SV * const sv = *sptr = NEWSV(0,0);
|
|
||||||
|
|
||||||
if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
|
|
||||||
+ MAGIC *mg;
|
|
||||||
sv_upgrade(sv, SvTYPE(osv));
|
|
||||||
if (SvGMAGICAL(osv)) {
|
|
||||||
- MAGIC* mg;
|
|
||||||
const bool oldtainted = PL_tainted;
|
|
||||||
mg_get(osv); /* note, can croak! */
|
|
||||||
if (PL_tainting && PL_tainted &&
|
|
||||||
@@ -220,6 +220,16 @@
|
|
||||||
PL_tainted = oldtainted;
|
|
||||||
}
|
|
||||||
SvMAGIC_set(sv, SvMAGIC(osv));
|
|
||||||
+ /* if it's a special scalar or if it has no 'set' magic,
|
|
||||||
+ * propagate the SvREADONLY flag. --rgs 20030922 */
|
|
||||||
+ for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
|
|
||||||
+ if (mg->mg_type == '\0'
|
|
||||||
+ || !(mg->mg_virtual && mg->mg_virtual->svt_set))
|
|
||||||
+ {
|
|
||||||
+ SvFLAGS(sv) |= SvREADONLY(osv);
|
|
||||||
+ break;
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
SvFLAGS(sv) |= SvMAGICAL(osv);
|
|
||||||
/* XXX SvMAGIC() is *shared* between osv and sv. This can
|
|
||||||
* lead to coredumps when both SVs are destroyed without one
|
|
@ -1,325 +0,0 @@
|
|||||||
--- perl-5.8.8/ext/B/B/Deparse.pm-28
|
|
||||||
+++ perl-5.8.8/ext/B/B/Deparse.pm
|
|
||||||
@@ -19,7 +19,7 @@
|
|
||||||
CVf_METHOD CVf_LOCKED CVf_LVALUE CVf_ASSERTION
|
|
||||||
PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_SKIPWHITE
|
|
||||||
PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED);
|
|
||||||
-$VERSION = 0.71;
|
|
||||||
+$VERSION = 0.71_01;
|
|
||||||
use strict;
|
|
||||||
use vars qw/$AUTOLOAD/;
|
|
||||||
use warnings ();
|
|
||||||
@@ -1711,6 +1711,32 @@
|
|
||||||
return $self->{'curcv'}->PADLIST->ARRAYelt(1)->ARRAYelt($targ);
|
|
||||||
}
|
|
||||||
|
|
||||||
+sub anon_hash_or_list {
|
|
||||||
+ my $self = shift;
|
|
||||||
+ my $op = shift;
|
|
||||||
+
|
|
||||||
+ my($pre, $post) = @{{"anonlist" => ["[","]"],
|
|
||||||
+ "anonhash" => ["{","}"]}->{$op->name}};
|
|
||||||
+ my($expr, @exprs);
|
|
||||||
+ $op = $op->first->sibling; # skip pushmark
|
|
||||||
+ for (; !null($op); $op = $op->sibling) {
|
|
||||||
+ $expr = $self->deparse($op, 6);
|
|
||||||
+ push @exprs, $expr;
|
|
||||||
+ }
|
|
||||||
+ return $pre . join(", ", @exprs) . $post;
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
+sub pp_anonlist {
|
|
||||||
+ my ($self, $op) = @_;
|
|
||||||
+ if ($op->flags & OPf_SPECIAL) {
|
|
||||||
+ return $self->anon_hash_or_list($op);
|
|
||||||
+ }
|
|
||||||
+ warn "Unexpected op pp_" . $op->name() . " without OPf_SPECIAL";
|
|
||||||
+ return 'XXX';
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
+*pp_anonhash = \&pp_anonlist;
|
|
||||||
+
|
|
||||||
sub pp_refgen {
|
|
||||||
my $self = shift;
|
|
||||||
my($op, $cx) = @_;
|
|
||||||
@@ -1718,15 +1744,7 @@
|
|
||||||
if ($kid->name eq "null") {
|
|
||||||
$kid = $kid->first;
|
|
||||||
if ($kid->name eq "anonlist" || $kid->name eq "anonhash") {
|
|
||||||
- my($pre, $post) = @{{"anonlist" => ["[","]"],
|
|
||||||
- "anonhash" => ["{","}"]}->{$kid->name}};
|
|
||||||
- my($expr, @exprs);
|
|
||||||
- $kid = $kid->first->sibling; # skip pushmark
|
|
||||||
- for (; !null($kid); $kid = $kid->sibling) {
|
|
||||||
- $expr = $self->deparse($kid, 6);
|
|
||||||
- push @exprs, $expr;
|
|
||||||
- }
|
|
||||||
- return $pre . join(", ", @exprs) . $post;
|
|
||||||
+ return $self->anon_hash_or_list($op);
|
|
||||||
} elsif (!null($kid->sibling) and
|
|
||||||
$kid->sibling->name eq "anoncode") {
|
|
||||||
return "sub " .
|
|
||||||
|
|
||||||
--- perl-5.8.8/ext/B/t/concise-xs.t.orig 2007-06-22 13:35:00.000000000 -0400
|
|
||||||
+++ perl-5.8.8/ext/B/t/concise-xs.t 2007-06-22 13:35:22.000000000 -0400
|
|
||||||
@@ -95,7 +95,7 @@
|
|
||||||
# One 5.009-only test to go when no 6; is integrated (25344)
|
|
||||||
use Test::More tests => ( 1 * !!$Config::Config{useithreads}
|
|
||||||
+ 1 * ($] > 5.009)
|
|
||||||
- + 778);
|
|
||||||
+ + 781);
|
|
||||||
|
|
||||||
require_ok("B::Concise");
|
|
||||||
|
|
||||||
|
|
||||||
--- perl-5.8.8/ext/B/t/f_map.t-7
|
|
||||||
+++ perl-5.8.8/ext/B/t/f_map.t
|
|
||||||
@@ -512,14 +512,13 @@
|
|
||||||
# 9 <#> gvsv[*_] s
|
|
||||||
# a <1> lc[t4] sK/1
|
|
||||||
# b <$> const[IV 1] s
|
|
||||||
-# c <@> anonhash sKRM/1
|
|
||||||
-# d <1> srefgen sK/1
|
|
||||||
+# c <@> anonhash sK*/1
|
|
||||||
# goto 7
|
|
||||||
-# e <0> pushmark s
|
|
||||||
-# f <#> gv[*hashes] s
|
|
||||||
-# g <1> rv2av[t2] lKRM*/1
|
|
||||||
-# h <2> aassign[t8] KS/COMMON
|
|
||||||
-# i <1> leavesub[1 ref] K/REFC,1
|
|
||||||
+# d <0> pushmark s
|
|
||||||
+# e <#> gv[*hashes] s
|
|
||||||
+# f <1> rv2av[t2] lKRM*/1
|
|
||||||
+# g <2> aassign[t8] KS/COMMON
|
|
||||||
+# h <1> leavesub[1 ref] K/REFC,1
|
|
||||||
EOT_EOT
|
|
||||||
# 1 <;> nextstate(main 601 (eval 32):1) v
|
|
||||||
# 2 <0> pushmark s
|
|
||||||
@@ -532,12 +531,11 @@
|
|
||||||
# 9 <$> gvsv(*_) s
|
|
||||||
# a <1> lc[t2] sK/1
|
|
||||||
# b <$> const(IV 1) s
|
|
||||||
-# c <@> anonhash sKRM/1
|
|
||||||
-# d <1> srefgen sK/1
|
|
||||||
+# c <@> anonhash sK*/1
|
|
||||||
# goto 7
|
|
||||||
-# e <0> pushmark s
|
|
||||||
-# f <$> gv(*hashes) s
|
|
||||||
-# g <1> rv2av[t1] lKRM*/1
|
|
||||||
-# h <2> aassign[t5] KS/COMMON
|
|
||||||
-# i <1> leavesub[1 ref] K/REFC,1
|
|
||||||
+# d <0> pushmark s
|
|
||||||
+# e <$> gv(*hashes) s
|
|
||||||
+# f <1> rv2av[t1] lKRM*/1
|
|
||||||
+# g <2> aassign[t5] KS/COMMON
|
|
||||||
+# h <1> leavesub[1 ref] K/REFC,1
|
|
||||||
EONT_EONT
|
|
||||||
|
|
||||||
--- perl-5.8.8/ext/B/t/f_sort.t-9
|
|
||||||
+++ perl-5.8.8/ext/B/t/f_sort.t
|
|
||||||
@@ -516,25 +516,24 @@
|
|
||||||
# e </> match(/"=(\\d+)"/) l/RTIME
|
|
||||||
# f <#> gvsv[*_] s
|
|
||||||
# g <1> uc[t17] sK/1
|
|
||||||
-# h <@> anonlist sKRM/1
|
|
||||||
-# i <1> srefgen sK/1
|
|
||||||
-# j <@> leave lKP
|
|
||||||
+# h <@> anonlist sK*/1
|
|
||||||
+# i <@> leave lKP
|
|
||||||
# goto 9
|
|
||||||
-# k <@> sort lKMS*
|
|
||||||
-# l <@> mapstart lK*
|
|
||||||
-# m <|> mapwhile(other->n)[t26] lK
|
|
||||||
-# n <#> gv[*_] s
|
|
||||||
-# o <1> rv2sv sKM/DREFAV,1
|
|
||||||
-# p <1> rv2av[t4] sKR/1
|
|
||||||
-# q <$> const[IV 0] s
|
|
||||||
-# r <2> aelem sK/2
|
|
||||||
+# j <@> sort lKMS*
|
|
||||||
+# k <@> mapstart lK*
|
|
||||||
+# l <|> mapwhile(other->m)[t26] lK
|
|
||||||
+# m <#> gv[*_] s
|
|
||||||
+# n <1> rv2sv sKM/DREFAV,1
|
|
||||||
+# o <1> rv2av[t4] sKR/1
|
|
||||||
+# p <$> const[IV 0] s
|
|
||||||
+# q <2> aelem sK/2
|
|
||||||
# - <@> scope lK
|
|
||||||
-# goto m
|
|
||||||
-# s <0> pushmark s
|
|
||||||
-# t <#> gv[*new] s
|
|
||||||
-# u <1> rv2av[t2] lKRM*/1
|
|
||||||
-# v <2> aassign[t27] KS/COMMON
|
|
||||||
-# w <1> leavesub[1 ref] K/REFC,1
|
|
||||||
+# goto l
|
|
||||||
+# r <0> pushmark s
|
|
||||||
+# s <#> gv[*new] s
|
|
||||||
+# t <1> rv2av[t2] lKRM*/1
|
|
||||||
+# u <2> aassign[t27] KS/COMMON
|
|
||||||
+# v <1> leavesub[1 ref] K/REFC,1
|
|
||||||
EOT_EOT
|
|
||||||
# 1 <;> nextstate(main 609 (eval 34):3) v
|
|
||||||
# 2 <0> pushmark s
|
|
||||||
@@ -552,25 +551,24 @@
|
|
||||||
# e </> match(/"=(\\d+)"/) l/RTIME
|
|
||||||
# f <$> gvsv(*_) s
|
|
||||||
# g <1> uc[t9] sK/1
|
|
||||||
-# h <@> anonlist sKRM/1
|
|
||||||
-# i <1> srefgen sK/1
|
|
||||||
-# j <@> leave lKP
|
|
||||||
+# h <@> anonlist sK*/1
|
|
||||||
+# i <@> leave lKP
|
|
||||||
# goto 9
|
|
||||||
-# k <@> sort lKMS*
|
|
||||||
-# l <@> mapstart lK*
|
|
||||||
-# m <|> mapwhile(other->n)[t12] lK
|
|
||||||
-# n <$> gv(*_) s
|
|
||||||
-# o <1> rv2sv sKM/DREFAV,1
|
|
||||||
-# p <1> rv2av[t2] sKR/1
|
|
||||||
-# q <$> const(IV 0) s
|
|
||||||
-# r <2> aelem sK/2
|
|
||||||
+# j <@> sort lKMS*
|
|
||||||
+# k <@> mapstart lK*
|
|
||||||
+# l <|> mapwhile(other->m)[t12] lK
|
|
||||||
+# m <$> gv(*_) s
|
|
||||||
+# n <1> rv2sv sKM/DREFAV,1
|
|
||||||
+# o <1> rv2av[t2] sKR/1
|
|
||||||
+# p <$> const(IV 0) s
|
|
||||||
+# q <2> aelem sK/2
|
|
||||||
# - <@> scope lK
|
|
||||||
-# goto m
|
|
||||||
-# s <0> pushmark s
|
|
||||||
-# t <$> gv(*new) s
|
|
||||||
-# u <1> rv2av[t1] lKRM*/1
|
|
||||||
-# v <2> aassign[t13] KS/COMMON
|
|
||||||
-# w <1> leavesub[1 ref] K/REFC,1
|
|
||||||
+# goto l
|
|
||||||
+# r <0> pushmark s
|
|
||||||
+# s <$> gv(*new) s
|
|
||||||
+# t <1> rv2av[t1] lKRM*/1
|
|
||||||
+# u <2> aassign[t13] KS/COMMON
|
|
||||||
+# v <1> leavesub[1 ref] K/REFC,1
|
|
||||||
EONT_EONT
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--- perl-5.8.8/ext/Devel/Peek/t/Peek.t-8
|
|
||||||
+++ perl-5.8.8/ext/Devel/Peek/t/Peek.t
|
|
||||||
@@ -165,7 +165,7 @@
|
|
||||||
FLAGS = \\(ROK\\)
|
|
||||||
RV = $ADDR
|
|
||||||
SV = PVAV\\($ADDR\\) at $ADDR
|
|
||||||
- REFCNT = 2
|
|
||||||
+ REFCNT = 1
|
|
||||||
FLAGS = \\(\\)
|
|
||||||
IV = 0
|
|
||||||
NV = 0
|
|
||||||
@@ -188,7 +188,7 @@
|
|
||||||
FLAGS = \\(ROK\\)
|
|
||||||
RV = $ADDR
|
|
||||||
SV = PVHV\\($ADDR\\) at $ADDR
|
|
||||||
- REFCNT = 2
|
|
||||||
+ REFCNT = 1
|
|
||||||
FLAGS = \\(SHAREKEYS\\)
|
|
||||||
IV = 1
|
|
||||||
NV = $FLOAT
|
|
||||||
@@ -284,7 +284,7 @@
|
|
||||||
FLAGS = \\(ROK\\)
|
|
||||||
RV = $ADDR
|
|
||||||
SV = PVHV\\($ADDR\\) at $ADDR
|
|
||||||
- REFCNT = 2
|
|
||||||
+ REFCNT = 1
|
|
||||||
FLAGS = \\(OBJECT,SHAREKEYS\\)
|
|
||||||
IV = 0
|
|
||||||
NV = 0
|
|
||||||
@@ -353,7 +353,7 @@
|
|
||||||
FLAGS = \\(ROK\\)
|
|
||||||
RV = $ADDR
|
|
||||||
SV = PVHV\\($ADDR\\) at $ADDR
|
|
||||||
- REFCNT = 2
|
|
||||||
+ REFCNT = 1
|
|
||||||
FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
|
|
||||||
UV = 1
|
|
||||||
NV = $FLOAT
|
|
||||||
@@ -379,7 +379,7 @@
|
|
||||||
FLAGS = \\(ROK\\)
|
|
||||||
RV = $ADDR
|
|
||||||
SV = PVHV\\($ADDR\\) at $ADDR
|
|
||||||
- REFCNT = 2
|
|
||||||
+ REFCNT = 1
|
|
||||||
FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
|
|
||||||
UV = 1
|
|
||||||
NV = 0
|
|
||||||
|
|
||||||
--- perl-5.8.8/op.c-137
|
|
||||||
+++ perl-5.8.8/op.c
|
|
||||||
@@ -2230,6 +2230,8 @@
|
|
||||||
pp_pushmark();
|
|
||||||
CALLRUNOPS(aTHX);
|
|
||||||
PL_op = curop;
|
|
||||||
+ assert (!(curop->op_flags & OPf_SPECIAL));
|
|
||||||
+ assert(curop->op_type == OP_RANGE);
|
|
||||||
pp_anonlist();
|
|
||||||
PL_tmps_floor = oldtmps_floor;
|
|
||||||
|
|
||||||
@@ -4861,15 +4863,13 @@
|
|
||||||
OP *
|
|
||||||
Perl_newANONLIST(pTHX_ OP *o)
|
|
||||||
{
|
|
||||||
- return newUNOP(OP_REFGEN, 0,
|
|
||||||
- mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
|
|
||||||
+ return convert(OP_ANONLIST, OPf_SPECIAL, o);
|
|
||||||
}
|
|
||||||
|
|
||||||
OP *
|
|
||||||
Perl_newANONHASH(pTHX_ OP *o)
|
|
||||||
{
|
|
||||||
- return newUNOP(OP_REFGEN, 0,
|
|
||||||
- mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
|
|
||||||
+ return convert(OP_ANONHASH, OPf_SPECIAL, o);
|
|
||||||
}
|
|
||||||
|
|
||||||
OP *
|
|
||||||
|
|
||||||
--- perl-5.8.8/op.h-26
|
|
||||||
+++ perl-5.8.8/op.h
|
|
||||||
@@ -103,5 +103,7 @@
|
|
||||||
* (runtime property) */
|
|
||||||
/* On OP_AELEMFAST, indiciates pad var */
|
|
||||||
+ /* On OP_ANONHASH and OP_ANONLIST, create a
|
|
||||||
+ reference to the new anon hash or array */
|
|
||||||
|
|
||||||
/* old names; don't use in new code, but don't break them, either */
|
|
||||||
#define OPf_LIST OPf_WANT_LIST
|
|
||||||
|
|
||||||
--- perl-5.8.8/pp.c-101
|
|
||||||
+++ perl-5.8.8/pp.c
|
|
||||||
@@ -4036,16 +4036,17 @@
|
|
||||||
{
|
|
||||||
dSP; dMARK; dORIGMARK;
|
|
||||||
const I32 items = SP - MARK;
|
|
||||||
- SV * const av = sv_2mortal((SV*)av_make(items, MARK+1));
|
|
||||||
+ SV * const av = (SV *) av_make(items, MARK+1);
|
|
||||||
SP = ORIGMARK; /* av_make() might realloc stack_sp */
|
|
||||||
- XPUSHs(av);
|
|
||||||
+ XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
|
|
||||||
+ ? newRV_noinc(av) : av));
|
|
||||||
RETURN;
|
|
||||||
}
|
|
||||||
|
|
||||||
PP(pp_anonhash)
|
|
||||||
{
|
|
||||||
dSP; dMARK; dORIGMARK;
|
|
||||||
- HV* const hv = (HV*)sv_2mortal((SV*)newHV());
|
|
||||||
+ HV* const hv = newHV();
|
|
||||||
|
|
||||||
while (MARK < SP) {
|
|
||||||
SV * const key = *++MARK;
|
|
||||||
@@ -4057,7 +4058,8 @@
|
|
||||||
(void)hv_store_ent(hv,key,val,0);
|
|
||||||
}
|
|
||||||
SP = ORIGMARK;
|
|
||||||
- XPUSHs((SV*)hv);
|
|
||||||
+ XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
|
|
||||||
+ ? newRV_noinc((SV*) hv) : (SV*)hv));
|
|
||||||
RETURN;
|
|
||||||
}
|
|
@ -1,26 +0,0 @@
|
|||||||
--- perl-5.8.8/pp.c.U34297_C28006 2006-07-13 12:40:37.000000000 -0400
|
|
||||||
+++ perl-5.8.8/pp.c 2006-07-13 13:03:19.000000000 -0400
|
|
||||||
@@ -2949,7 +2949,22 @@
|
|
||||||
dSP; dTARGET;
|
|
||||||
SV *sv = TOPs;
|
|
||||||
|
|
||||||
- if (DO_UTF8(sv))
|
|
||||||
+ if (SvAMAGIC(sv)) {
|
|
||||||
+ /* For an overloaded scalar, we can't know in advance if it's going to
|
|
||||||
+ be UTF-8 or not. Also, we can't call sv_len_utf8 as it likes to
|
|
||||||
+ cache the length. Maybe that should be a documented feature of it.
|
|
||||||
+ */
|
|
||||||
+ STRLEN len;
|
|
||||||
+ const char *const p = SvPV_const(sv, len);
|
|
||||||
+
|
|
||||||
+ if (DO_UTF8(sv)) {
|
|
||||||
+ SETi(utf8_length((U8*)p, (U8*)p + len));
|
|
||||||
+ }
|
|
||||||
+ else
|
|
||||||
+ SETi(len);
|
|
||||||
+
|
|
||||||
+ }
|
|
||||||
+ else if (DO_UTF8(sv))
|
|
||||||
SETi(sv_len_utf8(sv));
|
|
||||||
else
|
|
||||||
SETi(sv_len(sv));
|
|
@ -1,123 +0,0 @@
|
|||||||
--- perl-5.8.8-RC1/lib/ExtUtils/MakeMaker.pm.USE_MM_LD_RUN_PATH 2006-01-20 15:51:09.000000000 -0500
|
|
||||||
+++ perl-5.8.8-RC1/lib/ExtUtils/MakeMaker.pm 2006-01-20 16:25:43.000000000 -0500
|
|
||||||
@@ -233,7 +233,7 @@
|
|
||||||
PERL_SRC PERM_RW PERM_RWX
|
|
||||||
PL_FILES PM PM_FILTER PMLIBDIRS POLLUTE PPM_INSTALL_EXEC
|
|
||||||
PPM_INSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ
|
|
||||||
- SIGN SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
|
|
||||||
+ SKIP TYPEMAPS USE_MM_LD_RUN_PATH VERSION VERSION_FROM XS XSOPT XSPROTOARG
|
|
||||||
XS_VERSION clean depend dist dynamic_lib linkext macro realclean
|
|
||||||
tool_autosplit
|
|
||||||
|
|
||||||
@@ -369,7 +369,27 @@
|
|
||||||
print join(" ", map { "perl($_)>=$self->{PREREQ_PM}->{$_} " }
|
|
||||||
sort keys %{$self->{PREREQ_PM}}), "\n";
|
|
||||||
exit 0;
|
|
||||||
- }
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
+ # USE_MM_LD_RUN_PATH - another RedHatism to disable automatic RPATH generation
|
|
||||||
+ if ( ( ! $self->{USE_MM_LD_RUN_PATH} )
|
|
||||||
+ &&( ("@ARGV" =~ /\bUSE_MM_LD_RUN_PATH(=([01]))?\b/)
|
|
||||||
+ ||( exists( $ENV{USE_MM_LD_RUN_PATH} )
|
|
||||||
+ &&( $ENV{USE_MM_LD_RUN_PATH} =~ /([01])?$/ )
|
|
||||||
+ )
|
|
||||||
+ )
|
|
||||||
+ )
|
|
||||||
+ {
|
|
||||||
+ my $v = $1;
|
|
||||||
+ if( $v )
|
|
||||||
+ {
|
|
||||||
+ $v = ($v=~/=([01])$/)[0];
|
|
||||||
+ }else
|
|
||||||
+ {
|
|
||||||
+ $v = 1;
|
|
||||||
+ };
|
|
||||||
+ $self->{USE_MM_LD_RUN_PATH}=$v;
|
|
||||||
+ };
|
|
||||||
|
|
||||||
print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose;
|
|
||||||
if (-f "MANIFEST" && ! -f "Makefile"){
|
|
||||||
@@ -1373,13 +1393,13 @@
|
|
||||||
|
|
||||||
This is the root directory into which the code will be installed. It
|
|
||||||
I<prepends itself to the normal prefix>. For example, if your code
|
|
||||||
-would normally go into F</usr/local/lib/perl> you could set DESTDIR=~/tmp/
|
|
||||||
-and installation would go into F<~/tmp/usr/local/lib/perl>.
|
|
||||||
+would normally go into /usr/local/lib/perl you could set DESTDIR=~/myperl/
|
|
||||||
+and installation would go into ~/myperl/usr/local/lib/perl.
|
|
||||||
|
|
||||||
This is primarily of use for people who repackage Perl modules.
|
|
||||||
|
|
||||||
NOTE: Due to the nature of make, it is important that you put the trailing
|
|
||||||
-slash on your DESTDIR. F<~/tmp/> not F<~/tmp>.
|
|
||||||
+slash on your DESTDIR. F<"~/myperl/"> not F<"~/myperl">.
|
|
||||||
|
|
||||||
=item DIR
|
|
||||||
|
|
||||||
@@ -2057,6 +2077,40 @@
|
|
||||||
precedence, even if it isn't listed in TYPEMAPS. The default system
|
|
||||||
typemap has lowest precedence.
|
|
||||||
|
|
||||||
+=item USE_MM_LD_RUN_PATH
|
|
||||||
+
|
|
||||||
+boolean
|
|
||||||
+The Red Hat perl MakeMaker distribution differs from the standard
|
|
||||||
+upstream release in that it disables use of the MakeMaker generated
|
|
||||||
+LD_RUN_PATH by default, UNLESS this attribute is specified , or the
|
|
||||||
+USE_MM_LD_RUN_PATH environment variable is set during the MakeMaker run.
|
|
||||||
+
|
|
||||||
+The upstream MakeMaker will set the ld(1) environment variable LD_RUN_PATH
|
|
||||||
+to the concatenation of every -L ld(1) option directory in which a -l ld(1)
|
|
||||||
+option library is found, which is used as the ld(1) -rpath option if none
|
|
||||||
+is specified. This means that, if your application builds shared libraries
|
|
||||||
+and your MakeMaker application links to them, that the absolute paths of the
|
|
||||||
+libraries in the build tree will be inserted into the RPATH header of all
|
|
||||||
+MakeMaker generated binaries, and that such binaries will be unable to link
|
|
||||||
+to these libraries if they do not still reside in the build tree directories
|
|
||||||
+(unlikely) or in the system library directories (/lib or /usr/lib), regardless
|
|
||||||
+of any LD_LIBRARY_PATH setting. So if you specified -L../mylib -lmylib , and
|
|
||||||
+ your 'libmylib.so' gets installed into /some_directory_other_than_usr_lib,
|
|
||||||
+ your MakeMaker application will be unable to link to it, even if LD_LIBRARY_PATH
|
|
||||||
+is set to include /some_directory_other_than_usr_lib, because RPATH overrides
|
|
||||||
+LD_LIBRARY_PATH.
|
|
||||||
+
|
|
||||||
+So for Red Hat MakeMaker builds LD_RUN_PATH is NOT generated by default for
|
|
||||||
+every link. You can still use explicit -rpath ld options or the LD_RUN_PATH
|
|
||||||
+environment variable during the build to generate an RPATH for the binaries.
|
|
||||||
+
|
|
||||||
+You can set the USE_MM_LD_RUN_PATH attribute to 1 on the MakeMaker command
|
|
||||||
+line or in the WriteMakefile arguments to enable generation of LD_RUN_PATH
|
|
||||||
+for every link command.
|
|
||||||
+
|
|
||||||
+USE_MM_LD_RUN_PATH will default to 1 (LD_RUN_PATH will be used) IF the
|
|
||||||
+$USE_MM_LD_RUN_PATH environment variable is set during a MakeMaker run.
|
|
||||||
+
|
|
||||||
=item VENDORPREFIX
|
|
||||||
|
|
||||||
Like PERLPREFIX, but only for the vendor install locations.
|
|
||||||
--- perl-5.8.8-RC1/lib/ExtUtils/MM_Unix.pm.USE_MM_LD_RUN_PATH 2005-10-21 10:11:03.000000000 -0400
|
|
||||||
+++ perl-5.8.8-RC1/lib/ExtUtils/MM_Unix.pm 2006-01-20 16:20:25.000000000 -0500
|
|
||||||
@@ -941,7 +941,7 @@
|
|
||||||
}
|
|
||||||
|
|
||||||
my $ld_run_path_shell = "";
|
|
||||||
- if ($self->{LD_RUN_PATH} ne "") {
|
|
||||||
+ if (($self->{LD_RUN_PATH} ne "") && ($self->{USE_MM_LD_RUN_PATH})) {
|
|
||||||
$ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
|
|
||||||
}
|
|
||||||
|
|
||||||
--- perl-5.8.8-RC1/lib/ExtUtils/Liblist.pm.USE_MM_LD_RUN_PATH 2003-04-07 14:58:17.000000000 -0400
|
|
||||||
+++ perl-5.8.8-RC1/lib/ExtUtils/Liblist.pm 2006-01-20 16:21:57.000000000 -0500
|
|
||||||
@@ -87,6 +87,11 @@
|
|
||||||
in LDLOADLIBS. It is passed as an environment variable to the process
|
|
||||||
that links the shared library.
|
|
||||||
|
|
||||||
+Red Hat extension: This generation of LD_RUN_PATH is disabled by default.
|
|
||||||
+To use the generated LD_RUN_PATH for all links, set the USE_MM_LD_RUN_PATH
|
|
||||||
+MakeMaker object attribute / argument, (or set the $USE_MM_LD_RUN_PATH
|
|
||||||
+environment variable).
|
|
||||||
+
|
|
||||||
=head2 BSLOADLIBS
|
|
||||||
|
|
||||||
List of those libraries that are needed but can be linked in
|
|
@ -1,34 +0,0 @@
|
|||||||
diff -up perl-5.8.8/cop.h.BAD perl-5.8.8/cop.h
|
|
||||||
--- perl-5.8.8/cop.h.BAD 2007-10-18 09:54:16.000000000 -0400
|
|
||||||
+++ perl-5.8.8/cop.h 2007-10-18 09:56:17.000000000 -0400
|
|
||||||
@@ -286,9 +286,14 @@ struct block_loop {
|
|
||||||
#define POPLOOP(cx) \
|
|
||||||
SvREFCNT_dec(cx->blk_loop.iterlval); \
|
|
||||||
if (CxITERVAR(cx)) { \
|
|
||||||
- SV **s_v_p = CxITERVAR(cx); \
|
|
||||||
- sv_2mortal(*s_v_p); \
|
|
||||||
- *s_v_p = cx->blk_loop.itersave; \
|
|
||||||
+ if (SvPADMY(cx->blk_loop.itersave)) { \
|
|
||||||
+ SV **s_v_p = CxITERVAR(cx); \
|
|
||||||
+ sv_2mortal(*s_v_p); \
|
|
||||||
+ *s_v_p = cx->blk_loop.itersave; \
|
|
||||||
+ } \
|
|
||||||
+ else { \
|
|
||||||
+ SvREFCNT_dec(cx->blk_loop.itersave); \
|
|
||||||
+ } \
|
|
||||||
} \
|
|
||||||
if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\
|
|
||||||
SvREFCNT_dec(cx->blk_loop.iterary);
|
|
||||||
diff -up perl-5.8.8/t/op/local.t.BAD perl-5.8.8/t/op/local.t
|
|
||||||
--- perl-5.8.8/t/op/local.t.BAD 2007-10-18 10:53:10.000000000 -0400
|
|
||||||
+++ perl-5.8.8/t/op/local.t 2007-10-18 10:53:44.000000000 -0400
|
|
||||||
@@ -324,7 +324,7 @@ like($@, qr/Modification of a read-only
|
|
||||||
|
|
||||||
# make sure $1 is still read-only
|
|
||||||
eval { for ($1) { local $_ = 1 } };
|
|
||||||
-is($@, "");
|
|
||||||
+like($@, qr/Modification of a read-only value attempted/);
|
|
||||||
|
|
||||||
# The s/// adds 'g' magic to $_, but it should remain non-readonly
|
|
||||||
eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
|
|
||||||
diff -up perl-5.8.8/op.c.BAD perl-5.8.8/op.c
|
|
@ -1,53 +0,0 @@
|
|||||||
--- perl-5.8.8-RC1/Configure.bz178343 2006-01-30 19:42:47.000000000 -0500
|
|
||||||
+++ perl-5.8.8-RC1/Configure 2006-01-30 20:04:53.000000000 -0500
|
|
||||||
@@ -20279,6 +20279,17 @@
|
|
||||||
chmod +x Cppsym.try
|
|
||||||
$eunicefix Cppsym.try
|
|
||||||
./Cppsym < Cppsym.know > Cppsym.true
|
|
||||||
+: Add in any cpp "predefined macros" :
|
|
||||||
+tHdrH=`mktemp ./XXXXXX`
|
|
||||||
+rm -f $tHdrH'.h' $tHdrH
|
|
||||||
+touch $tHdrH'.h'
|
|
||||||
+if cpp -dM $tHdrH'.h' > $tHdrH'_cppsym.h' && [ -s $tHdrH'_cppsym.h' ] ; then
|
|
||||||
+ sed 's/#define[\ \ ]*//;s/[\ \ ].*$//' < $tHdrH'_cppsym.h' > $tHdrH'_cppsym.real';
|
|
||||||
+ if [ -s $tHdrH'_cppsym.real' ]; then
|
|
||||||
+ cat $tHdrH'_cppsym.real' Cppsym.know | sort | uniq | ./Cppsym | sort | uniq > Cppsym.true
|
|
||||||
+ fi
|
|
||||||
+fi
|
|
||||||
+rm -f $tHdrH'.h' $tHdrH'_cppsym.h' $tHdrH'_cppsym.real'
|
|
||||||
: now check the C compiler for additional symbols
|
|
||||||
postprocess_cc_v=''
|
|
||||||
case "$osname" in
|
|
||||||
--- perl-5.8.8-RC1/utils/h2ph.PL.bz178343 2006-01-13 12:56:47.000000000 -0500
|
|
||||||
+++ perl-5.8.8-RC1/utils/h2ph.PL 2006-01-30 20:01:15.000000000 -0500
|
|
||||||
@@ -778,8 +778,16 @@
|
|
||||||
if ($opt_D) {
|
|
||||||
print PREAMBLE "# $_=$define{$_}\n";
|
|
||||||
}
|
|
||||||
-
|
|
||||||
- if ($define{$_} =~ /^(\d+)U?L{0,2}$/i) {
|
|
||||||
+ if ($define{$_} =~ /^\((.*)\)$/) {
|
|
||||||
+ # parenthesized value: d=(v)
|
|
||||||
+ $define{$_} = $1;
|
|
||||||
+ };
|
|
||||||
+ if ($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/ ) {
|
|
||||||
+ # float:
|
|
||||||
+ print PREAMBLE
|
|
||||||
+ "unless (defined &$_) { sub $_() { $1 } }\n\n";
|
|
||||||
+ } elsif ($define{$_} =~ /^([+-]?\d+)U?L{0,2}$/i) {
|
|
||||||
+ # integer:
|
|
||||||
print PREAMBLE
|
|
||||||
"unless (defined &$_) { sub $_() { $1 } }\n\n";
|
|
||||||
} elsif ($define{$_} =~ /^\w+$/) {
|
|
||||||
@@ -805,9 +813,8 @@
|
|
||||||
@Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
|
|
||||||
|
|
||||||
# Split compiler pre-definitions into `key=value' pairs:
|
|
||||||
- foreach (split /\s+/, $allsymbols) {
|
|
||||||
- /(.+?)=(.+)/ and $define{$1} = $2;
|
|
||||||
-
|
|
||||||
+ while( $allsymbols=~/([^\s]+)=((\\\s|[^\s])+)/g ) {
|
|
||||||
+ $define{$1} = $2;
|
|
||||||
if ($opt_D) {
|
|
||||||
print STDERR "$_: $1 -> $2\n";
|
|
||||||
}
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.8/perl.c.bz183553_ubz38657 2006-02-27 12:51:49.000000000 -0500
|
|
||||||
+++ perl-5.8.8/perl.c 2006-03-01 17:18:41.000000000 -0500
|
|
||||||
@@ -3110,7 +3110,7 @@
|
|
||||||
sv_catpv(sv, start);
|
|
||||||
else {
|
|
||||||
sv_catpvn(sv, start, s-start);
|
|
||||||
- Perl_sv_catpvf(aTHX_ sv, " split(/,/,q%c%s%c)", 0, ++s, 0);
|
|
||||||
+ Perl_sv_catpvf(aTHX_ sv, " split(/,/,q(%s))", ++s);
|
|
||||||
}
|
|
||||||
s += strlen(s);
|
|
||||||
my_setenv("PERL5DB", (char *)SvPV_nolen_const(sv));
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.8/lib/CGI.pm.bz188441 2006-01-08 11:40:30.000000000 -0500
|
|
||||||
+++ perl-5.8.8/lib/CGI.pm 2006-04-12 18:49:26.000000000 -0400
|
|
||||||
@@ -2650,7 +2650,7 @@
|
|
||||||
return $url if $base;
|
|
||||||
$url .= $uri;
|
|
||||||
} elsif ($relative) {
|
|
||||||
- ($url) = $script_name =~ m!([^/]+)$!;
|
|
||||||
+ ($url) = $uri =~ m!([^/]+)$!;
|
|
||||||
} elsif ($absolute) {
|
|
||||||
$url = $uri;
|
|
||||||
}
|
|
@ -1,40 +0,0 @@
|
|||||||
--- perl-5.8.8/t/lib/h2ph.pht.bz191416 2004-12-27 14:55:34.000000000 -0500
|
|
||||||
+++ perl-5.8.8/t/lib/h2ph.pht 2006-05-11 15:12:10.000000000 -0400
|
|
||||||
@@ -28,21 +28,21 @@
|
|
||||||
eval q((($a) < ($b) ? ($a) : ($b)));
|
|
||||||
}' unless defined(&MIN);
|
|
||||||
}
|
|
||||||
- if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) {
|
|
||||||
+ if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : undef))) {
|
|
||||||
}
|
|
||||||
- elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) {
|
|
||||||
+ elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : undef))) {
|
|
||||||
die("Nup, can't go on");
|
|
||||||
} else {
|
|
||||||
eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK);
|
|
||||||
}
|
|
||||||
undef(&WHATEVER) if defined(&WHATEVER);
|
|
||||||
- if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0) && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : 0))) {
|
|
||||||
+ if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : undef) && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : undef))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : undef))) {
|
|
||||||
eval 'sub WHATEVER () {6;}' unless defined(&WHATEVER);
|
|
||||||
}
|
|
||||||
- elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0)) ) {
|
|
||||||
+ elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : undef)) ) {
|
|
||||||
eval 'sub WHATEVER () {7;}' unless defined(&WHATEVER);
|
|
||||||
}
|
|
||||||
- elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0)) ) {
|
|
||||||
+ elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : undef)) ) {
|
|
||||||
eval 'sub WHATEVER () {8;}' unless defined(&WHATEVER);
|
|
||||||
} else {
|
|
||||||
eval 'sub WHATEVER () {1000;}' unless defined(&WHATEVER);
|
|
||||||
--- perl-5.8.8/utils/h2ph.PL.bz191416 2006-05-11 15:10:52.000000000 -0400
|
|
||||||
+++ perl-5.8.8/utils/h2ph.PL 2006-05-11 15:11:49.000000000 -0400
|
|
||||||
@@ -514,7 +514,7 @@
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
if ($inif && $new !~ /defined\s*\($/) {
|
|
||||||
- $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
|
|
||||||
+ $new .= '(defined(&' . $id . ') ? &' . $id . ' : undef)';
|
|
||||||
} elsif (/^\[/) {
|
|
||||||
$new .= " \$$id";
|
|
||||||
} else {
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.8/ext/B/B/C.pm.bz199736 2006-01-13 09:47:39.000000000 -0500
|
|
||||||
+++ perl-5.8.8/ext/B/B/C.pm 2006-07-21 20:25:39.000000000 -0400
|
|
||||||
@@ -647,7 +647,7 @@
|
|
||||||
return $sym if defined $sym;
|
|
||||||
my $val= $sv->NVX;
|
|
||||||
$val .= '.00' if $val =~ /^-?\d+$/;
|
|
||||||
- $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $val));
|
|
||||||
+ $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->NVX, $val));
|
|
||||||
$svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
|
|
||||||
$xpvnvsect->index, $sv->REFCNT , $sv->FLAGS));
|
|
||||||
return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
|
|
File diff suppressed because it is too large
Load Diff
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.8/lib/File/Spec/Unix.pm.orig 2005-08-27 12:14:38.000000000 -0500
|
|
||||||
+++ perl-5.8.8/lib/File/Spec/Unix.pm 2007-07-07 22:13:51.000000000 -0500
|
|
||||||
@@ -470,7 +470,7 @@
|
|
||||||
# File::Spec subclasses use this.
|
|
||||||
sub _cwd {
|
|
||||||
require Cwd;
|
|
||||||
- Cwd::cwd();
|
|
||||||
+ Cwd::getcwd();
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
@ -1,57 +0,0 @@
|
|||||||
--- perl-5.8.8.orig/regcomp.c 2006-01-08 20:59:27.000000000 +0000
|
|
||||||
+++ perl-5.8.8/regcomp.c 2007-10-19 22:49:41.000000000 +0100
|
|
||||||
@@ -136,6 +136,7 @@
|
|
||||||
I32 seen_zerolen;
|
|
||||||
I32 seen_evals;
|
|
||||||
I32 utf8;
|
|
||||||
+ I32 orig_utf8;
|
|
||||||
#if ADD_TO_REGEXEC
|
|
||||||
char *starttry; /* -Dr: where regtry was called. */
|
|
||||||
#define RExC_starttry (pRExC_state->starttry)
|
|
||||||
@@ -161,6 +162,7 @@
|
|
||||||
#define RExC_seen_zerolen (pRExC_state->seen_zerolen)
|
|
||||||
#define RExC_seen_evals (pRExC_state->seen_evals)
|
|
||||||
#define RExC_utf8 (pRExC_state->utf8)
|
|
||||||
+#define RExC_orig_utf8 (pRExC_state->orig_utf8)
|
|
||||||
|
|
||||||
#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
|
|
||||||
#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
|
|
||||||
@@ -1749,15 +1751,17 @@
|
|
||||||
if (exp == NULL)
|
|
||||||
FAIL("NULL regexp argument");
|
|
||||||
|
|
||||||
- RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
|
|
||||||
+ RExC_orig_utf8 = RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
|
|
||||||
|
|
||||||
- RExC_precomp = exp;
|
|
||||||
DEBUG_r({
|
|
||||||
if (!PL_colorset) reginitcolors();
|
|
||||||
PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
|
|
||||||
PL_colors[4],PL_colors[5],PL_colors[0],
|
|
||||||
- (int)(xend - exp), RExC_precomp, PL_colors[1]);
|
|
||||||
+ (int)(xend - exp), exp, PL_colors[1]);
|
|
||||||
});
|
|
||||||
+
|
|
||||||
+redo_first_pass:
|
|
||||||
+ RExC_precomp = exp;
|
|
||||||
RExC_flags = pm->op_pmflags;
|
|
||||||
RExC_sawback = 0;
|
|
||||||
|
|
||||||
@@ -1783,6 +1787,17 @@
|
|
||||||
RExC_precomp = Nullch;
|
|
||||||
return(NULL);
|
|
||||||
}
|
|
||||||
+ if (RExC_utf8 && !RExC_orig_utf8) {
|
|
||||||
+ STRLEN len = xend-exp;
|
|
||||||
+ DEBUG_r(PerlIO_printf(Perl_debug_log,
|
|
||||||
+ "UTF8 mismatch! Converting to utf8 for resizing and compile\n"));
|
|
||||||
+ exp = (char*)Perl_bytes_to_utf8(aTHX_ (U8*)exp, &len);
|
|
||||||
+ xend = exp + len;
|
|
||||||
+ RExC_orig_utf8 = RExC_utf8;
|
|
||||||
+ SAVEFREEPV(exp);
|
|
||||||
+ goto redo_first_pass;
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
DEBUG_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size));
|
|
||||||
|
|
||||||
/* Small enough for pointer-storage convention?
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.8-RC1/perl.c.dashI 2006-01-08 09:36:17.000000000 -0500
|
|
||||||
+++ perl-5.8.8-RC1/perl.c 2006-01-20 14:42:43.000000000 -0500
|
|
||||||
@@ -1755,7 +1755,7 @@
|
|
||||||
if (s && *s) {
|
|
||||||
STRLEN len = strlen(s);
|
|
||||||
const char * const p = savepvn(s, len);
|
|
||||||
- incpush(p, TRUE, TRUE, FALSE);
|
|
||||||
+ incpush(p, FALSE, FALSE, FALSE);
|
|
||||||
sv_catpvn(sv, "-I", 2);
|
|
||||||
sv_catpvn(sv, p, len);
|
|
||||||
sv_catpvn(sv, " ", 1);
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.8/lib/Net/NNTP.pm.debian_fix_net_nntp.patch 2004-05-06 09:36:05.000000000 -0400
|
|
||||||
+++ perl-5.8.8/lib/Net/NNTP.pm 2006-02-10 14:01:30.000000000 -0500
|
|
||||||
@@ -120,7 +120,7 @@
|
|
||||||
my $nntp = shift;
|
|
||||||
my @fh;
|
|
||||||
|
|
||||||
- @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
|
|
||||||
+ @fh = (pop) if @_ == 2 || (@_ && (ref($_[0]) || ref(\$_[0]) eq 'GLOB'));
|
|
||||||
|
|
||||||
$nntp->_ARTICLE(@_)
|
|
||||||
? $nntp->read_until_dot(@fh)
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.8/lib/Net/Config.pm.orig 2007-05-07 12:35:45.000000000 -0400
|
|
||||||
+++ perl-5.8.8/lib/Net/Config.pm 2007-05-07 12:40:56.000000000 -0400
|
|
||||||
@@ -29,7 +29,7 @@
|
|
||||||
ftp_firewall => undef,
|
|
||||||
ftp_ext_passive => 0,
|
|
||||||
ftp_int_passive => 0,
|
|
||||||
- test_hosts => 1,
|
|
||||||
+ test_hosts => 0,
|
|
||||||
test_exist => 1,
|
|
||||||
);
|
|
||||||
|
|
@ -1,63 +0,0 @@
|
|||||||
--- perl-5.8.7/perl.c.orig 2005-04-22 17:14:27.000000000 +0300
|
|
||||||
+++ perl-5.8.7/perl.c 2005-06-17 22:31:31.000000000 +0300
|
|
||||||
@@ -109,6 +109,7 @@
|
|
||||||
#endif
|
|
||||||
|
|
||||||
static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
|
|
||||||
+STATIC void incpush_oldversion(pTHX_ char *dir);
|
|
||||||
|
|
||||||
#ifdef IAMSUID
|
|
||||||
#ifndef DOSUID
|
|
||||||
@@ -4435,6 +4436,7 @@
|
|
||||||
* DLL-based path intuition to work correctly */
|
|
||||||
# if !defined(WIN32)
|
|
||||||
incpush(SITEARCH_EXP, FALSE, FALSE, TRUE);
|
|
||||||
+ incpush_oldversion(aTHX_ SITEARCH_EXP);
|
|
||||||
# endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
@@ -4456,6 +4458,7 @@
|
|
||||||
* DLL-based path intuition to work correctly */
|
|
||||||
# if !defined(WIN32)
|
|
||||||
incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE);
|
|
||||||
+ incpush_oldversion(aTHX_ PERL_VENDORARCH_EXP);
|
|
||||||
# endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
@@ -4497,6 +4500,36 @@
|
|
||||||
# define PERLLIB_MANGLE(s,n) (s)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
+#define VERSION_DIRECTORY_STRING "/" STRINGIFY(PERL_REVISION) "." STRINGIFY(PERL_VERSION) "." STRINGIFY(PERL_SUBVERSION)
|
|
||||||
+STATIC void
|
|
||||||
+incpush_oldversion(pTHX_ char *dir)
|
|
||||||
+{
|
|
||||||
+#ifdef PERL_INC_VERSION_LIST
|
|
||||||
+ const char *incverlist[] = { PERL_INC_VERSION_LIST };
|
|
||||||
+ const char **incver;
|
|
||||||
+ const char *verdir;
|
|
||||||
+
|
|
||||||
+ verdir = strstr(dir, VERSION_DIRECTORY_STRING);
|
|
||||||
+ if (!verdir)
|
|
||||||
+ return;
|
|
||||||
+
|
|
||||||
+ for (incver = incverlist; *incver; incver++) {
|
|
||||||
+ char *new_dir = malloc(strlen(dir) + strlen(*incver) + 2);
|
|
||||||
+ char *p = new_dir;
|
|
||||||
+
|
|
||||||
+ strcpy(new_dir, dir);
|
|
||||||
+ p += verdir - dir + 1; /* advance to char following '/' in VERSION_DIRECTORY_STRING */
|
|
||||||
+ memcpy(p, *incver, strlen(*incver)); /* copy incver there instead */
|
|
||||||
+ p += strlen(*incver); /* advance past version we just copied */
|
|
||||||
+ strcpy(p, verdir + strlen(VERSION_DIRECTORY_STRING)); /* and copy the rest of the original dir */
|
|
||||||
+
|
|
||||||
+ incpush(new_dir, FALSE, FALSE, FALSE);
|
|
||||||
+ free(new_dir);
|
|
||||||
+ }
|
|
||||||
+#endif
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
+
|
|
||||||
/* Push a directory onto @INC if it exists.
|
|
||||||
Generate a new SV if we do this, to save needing to copy the SV we push
|
|
||||||
onto @INC */
|
|
@ -1,12 +0,0 @@
|
|||||||
--- perl-5.8.8/ext/IPC/SysV/SysV.xs.no_asm_page_h 2001-06-30 14:46:07.000000000 -0400
|
|
||||||
+++ perl-5.8.8/ext/IPC/SysV/SysV.xs 2006-06-02 17:37:22.000000000 -0400
|
|
||||||
@@ -3,9 +3,6 @@
|
|
||||||
#include "XSUB.h"
|
|
||||||
|
|
||||||
#include <sys/types.h>
|
|
||||||
-#ifdef __linux__
|
|
||||||
-# include <asm/page.h>
|
|
||||||
-#endif
|
|
||||||
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
|
|
||||||
#ifndef HAS_SEM
|
|
||||||
# include <sys/ipc.h>
|
|
@ -1,42 +0,0 @@
|
|||||||
--- perl-5.8.8-RC1/utils/perlbug.PL.perlbug 2006-01-03 14:07:41.000000000 -0500
|
|
||||||
+++ perl-5.8.8-RC1/utils/perlbug.PL 2006-01-20 14:33:26.000000000 -0500
|
|
||||||
@@ -71,7 +71,7 @@
|
|
||||||
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
|
|
||||||
if \$running_under_some_shell;
|
|
||||||
|
|
||||||
-my \$config_tag1 = '$extract_version - $Config{cf_time}';
|
|
||||||
+my \$config_tag1 = '$extract_version';
|
|
||||||
|
|
||||||
my \$patchlevel_date = $patchlevel_date;
|
|
||||||
my \$patch_tags = '$patch_tags';
|
|
||||||
@@ -287,18 +287,9 @@
|
|
||||||
# OK - send "OK" report for build on this system
|
|
||||||
$ok = 0;
|
|
||||||
if ($::opt_o) {
|
|
||||||
- if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
|
|
||||||
- my $age = time - $patchlevel_date;
|
|
||||||
- if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
|
|
||||||
- my $date = localtime $patchlevel_date;
|
|
||||||
- print <<"EOF";
|
|
||||||
-"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
|
|
||||||
-are more than 60 days old. This Perl version was constructed on
|
|
||||||
-$date. If you really want to report this, use
|
|
||||||
-"perlbug -okay" or "perlbug -nokay".
|
|
||||||
-EOF
|
|
||||||
- exit();
|
|
||||||
- }
|
|
||||||
+ #
|
|
||||||
+ # Red Hat modification: remove -ok / -nok refusal to report due to age
|
|
||||||
+ #
|
|
||||||
# force these options
|
|
||||||
unless ($::opt_n) {
|
|
||||||
$::opt_S = 1; # don't prompt for send
|
|
||||||
@@ -605,7 +596,7 @@
|
|
||||||
print OUT <<EFF;
|
|
||||||
---
|
|
||||||
EFF
|
|
||||||
- print OUT "This perlbug was built using Perl $config_tag1\n",
|
|
||||||
+ print OUT "This perlbug was built using Perl $config_tag1 in the Red Hat build system.\n",
|
|
||||||
"It is being executed now by Perl $config_tag2.\n\n"
|
|
||||||
if $config_tag2 ne $config_tag1;
|
|
||||||
|
|
@ -1,50 +0,0 @@
|
|||||||
--- perl-5.8.8-RC1/utils/perlbug.PL.perlbug 2006-01-03 14:07:41.000000000 -0500
|
|
||||||
+++ perl-5.8.8-RC1/utils/perlbug.PL 2006-01-31 14:33:47.000000000 -0500
|
|
||||||
@@ -27,7 +27,6 @@
|
|
||||||
open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
|
|
||||||
or die "Can't open patchlevel.h: $!";
|
|
||||||
|
|
||||||
-my $patchlevel_date = (stat PATCH_LEVEL)[9];
|
|
||||||
my $patchnum = "";
|
|
||||||
|
|
||||||
while (<PATCH_LEVEL>) {
|
|
||||||
@@ -71,9 +70,8 @@
|
|
||||||
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
|
|
||||||
if \$running_under_some_shell;
|
|
||||||
|
|
||||||
-my \$config_tag1 = '$extract_version - $Config{cf_time}';
|
|
||||||
+my \$config_tag1 = '$extract_version';
|
|
||||||
|
|
||||||
-my \$patchlevel_date = $patchlevel_date;
|
|
||||||
my \$patch_tags = '$patch_tags';
|
|
||||||
my \@patches = (
|
|
||||||
$patch_desc
|
|
||||||
@@ -288,17 +286,6 @@
|
|
||||||
$ok = 0;
|
|
||||||
if ($::opt_o) {
|
|
||||||
if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
|
|
||||||
- my $age = time - $patchlevel_date;
|
|
||||||
- if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
|
|
||||||
- my $date = localtime $patchlevel_date;
|
|
||||||
- print <<"EOF";
|
|
||||||
-"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
|
|
||||||
-are more than 60 days old. This Perl version was constructed on
|
|
||||||
-$date. If you really want to report this, use
|
|
||||||
-"perlbug -okay" or "perlbug -nokay".
|
|
||||||
-EOF
|
|
||||||
- exit();
|
|
||||||
- }
|
|
||||||
# force these options
|
|
||||||
unless ($::opt_n) {
|
|
||||||
$::opt_S = 1; # don't prompt for send
|
|
||||||
@@ -605,8 +592,8 @@
|
|
||||||
print OUT <<EFF;
|
|
||||||
---
|
|
||||||
EFF
|
|
||||||
- print OUT "This perlbug was built using Perl $config_tag1\n",
|
|
||||||
- "It is being executed now by Perl $config_tag2.\n\n"
|
|
||||||
+ print OUT "This perlbug was built using Perl $config_tag1 in the Red Hat build system.\n",
|
|
||||||
+ "It is being executed now by Perl $config_tag2.\n\n"
|
|
||||||
if $config_tag2 ne $config_tag1;
|
|
||||||
|
|
||||||
print OUT <<EOF;
|
|
@ -1,22 +0,0 @@
|
|||||||
--- perl-5.8.8/ext/threads/threads.xs.up27133_up27169 2005-10-16 13:53:32.000000000 -0400
|
|
||||||
+++ perl-5.8.8/ext/threads/threads.xs 2006-02-13 14:21:47.000000000 -0500
|
|
||||||
@@ -623,7 +623,7 @@
|
|
||||||
PerlInterpreter *other_perl = thread->interp;
|
|
||||||
CLONE_PARAMS clone_params;
|
|
||||||
clone_params.stashes = newAV();
|
|
||||||
- clone_params.flags |= CLONEf_JOIN_IN;
|
|
||||||
+ clone_params.flags = CLONEf_JOIN_IN;
|
|
||||||
PL_ptr_table = ptr_table_new();
|
|
||||||
current_thread = Perl_ithread_get(aTHX);
|
|
||||||
Perl_ithread_set(aTHX_ thread);
|
|
||||||
--- perl-5.8.8/regcomp.c.up27133_up27169 2006-01-08 15:59:27.000000000 -0500
|
|
||||||
+++ perl-5.8.8/regcomp.c 2006-02-13 14:23:26.000000000 -0500
|
|
||||||
@@ -1810,7 +1810,7 @@
|
|
||||||
r->subbeg = NULL;
|
|
||||||
r->reganch = pm->op_pmflags & PMf_COMPILETIME;
|
|
||||||
r->nparens = RExC_npar - 1; /* set early to validate backrefs */
|
|
||||||
-
|
|
||||||
+ r->lastparen = 0; /* mg.c reads this. */
|
|
||||||
r->substrs = 0; /* Useful during FAIL. */
|
|
||||||
r->startp = 0; /* Useful during FAIL. */
|
|
||||||
r->endp = 0; /* Useful during FAIL. */
|
|
@ -1,64 +0,0 @@
|
|||||||
Change 27284 by nicholas@nicholas-saigo on 2006/02/23 14:49:22
|
|
||||||
|
|
||||||
Integrate:
|
|
||||||
[ 27002]
|
|
||||||
Code assumes that *FOO{SCALAR} will always return a scalar reference,
|
|
||||||
so make it so, creating $FOO if necessary.
|
|
||||||
(Effectively this is a policy decision that PERL_DONT_CREATE_GVSV is
|
|
||||||
visible to XS code, but isn't visible to Perl code)
|
|
||||||
|
|
||||||
Affected files ...
|
|
||||||
|
|
||||||
... //depot/maint-5.8/perl/pp.c#86 integrate
|
|
||||||
... //depot/maint-5.8/perl/t/op/gv.t#4 integrate
|
|
||||||
|
|
||||||
Differences ...
|
|
||||||
|
|
||||||
==== //depot/maint-5.8/perl/pp.c#86 (text) ====
|
|
||||||
Index: perl/pp.c
|
|
||||||
--- perl/pp.c#85~26738~ 2006-01-08 13:30:11.000000000 -0800
|
|
||||||
+++ perl/pp.c 2006-02-23 06:49:22.000000000 -0800
|
|
||||||
@@ -604,7 +604,7 @@
|
|
||||||
break;
|
|
||||||
case 'S':
|
|
||||||
if (strEQ(second_letter, "CALAR"))
|
|
||||||
- tmpRef = GvSV(gv);
|
|
||||||
+ tmpRef = GvSVn(gv);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
==== //depot/maint-5.8/perl/t/op/gv.t#4 (xtext) ====
|
|
||||||
Index: perl/t/op/gv.t
|
|
||||||
--- perl/t/op/gv.t#3~25505~ 2005-09-19 15:20:52.000000000 -0700
|
|
||||||
+++ perl/t/op/gv.t 2006-02-23 06:49:22.000000000 -0800
|
|
||||||
@@ -12,7 +12,7 @@
|
|
||||||
use warnings;
|
|
||||||
|
|
||||||
require './test.pl';
|
|
||||||
-plan( tests => 61 );
|
|
||||||
+plan( tests => 63 );
|
|
||||||
|
|
||||||
# type coersion on assignment
|
|
||||||
$foo = 'foo';
|
|
||||||
@@ -218,6 +218,19 @@
|
|
||||||
is ($x, "Rules\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
+
|
|
||||||
+{
|
|
||||||
+ no warnings qw(once uninitialized);
|
|
||||||
+ my $g = \*clatter;
|
|
||||||
+ my $r = eval {no strict; ${*{$g}{SCALAR}}};
|
|
||||||
+ is ($@, '', "PERL_DONT_CREATE_GVSV shouldn't affect thingy syntax");
|
|
||||||
+
|
|
||||||
+ $g = \*vowm;
|
|
||||||
+ $r = eval {use strict; ${*{$g}{SCALAR}}};
|
|
||||||
+ is ($@, '',
|
|
||||||
+ "PERL_DONT_CREATE_GVSV shouldn't affect thingy syntax under strict");
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
__END__
|
|
||||||
Perl
|
|
||||||
Rules
|
|
||||||
End of Patch.
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.8.8/Configure.BAD 2006-07-17 12:43:58.000000000 -0400
|
|
||||||
+++ perl-5.8.8/Configure 2006-07-17 12:44:04.000000000 -0400
|
|
||||||
@@ -7659,7 +7659,7 @@
|
|
||||||
'') dflt="$dflt +vnocompatwarnings" ;;
|
|
||||||
esac
|
|
||||||
;;
|
|
||||||
- linux|irix*|gnu*) dflt='-shared' ;;
|
|
||||||
+ linux|irix*|gnu*) dflt="-shared $optimize" ;;
|
|
||||||
next) dflt='none' ;;
|
|
||||||
solaris) dflt='-G' ;;
|
|
||||||
sunos) dflt='-assert nodefinitions' ;;
|
|
10
perl.spec
10
perl.spec
@ -11,7 +11,7 @@
|
|||||||
|
|
||||||
Name: perl
|
Name: perl
|
||||||
Version: %{perl_version}
|
Version: %{perl_version}
|
||||||
Release: 27%{?dist}
|
Release: 28%{?dist}
|
||||||
Epoch: %{perl_epoch}
|
Epoch: %{perl_epoch}
|
||||||
Summary: The Perl programming language
|
Summary: The Perl programming language
|
||||||
Group: Development/Languages
|
Group: Development/Languages
|
||||||
@ -75,6 +75,9 @@ Patch15: perl-5.10.0-bz448392.patch
|
|||||||
# Wrong access test
|
# Wrong access test
|
||||||
Patch16: perl-5.10.0-accessXOK.patch
|
Patch16: perl-5.10.0-accessXOK.patch
|
||||||
|
|
||||||
|
# CVE-2008-2827 perl: insecure use of chmod in rmtree
|
||||||
|
Patch17: perl-5.10.0-CVE-2008-2827.patch
|
||||||
|
|
||||||
BuildRoot: %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n)
|
BuildRoot: %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n)
|
||||||
BuildRequires: tcsh, dos2unix, man, groff
|
BuildRequires: tcsh, dos2unix, man, groff
|
||||||
BuildRequires: gdbm-devel, db4-devel, zlib-devel
|
BuildRequires: gdbm-devel, db4-devel, zlib-devel
|
||||||
@ -798,6 +801,7 @@ upstream tarball from perl.org.
|
|||||||
%patch14 -p1
|
%patch14 -p1
|
||||||
%patch15 -p1
|
%patch15 -p1
|
||||||
%patch16 -p1
|
%patch16 -p1
|
||||||
|
%patch17 -p1
|
||||||
|
|
||||||
#
|
#
|
||||||
# Candidates for doc recoding (need case by case review):
|
# Candidates for doc recoding (need case by case review):
|
||||||
@ -1010,6 +1014,7 @@ perl -x patchlevel.h 'Fedora Patch13: Upgrade Module::CoreList to 2.14'
|
|||||||
perl -x patchlevel.h 'Fedora Patch14: Upgrade CGI to 3.37'
|
perl -x patchlevel.h 'Fedora Patch14: Upgrade CGI to 3.37'
|
||||||
perl -x patchlevel.h 'Fedora Patch15: Adopt upstream commit for assertion'
|
perl -x patchlevel.h 'Fedora Patch15: Adopt upstream commit for assertion'
|
||||||
perl -x patchlevel.h 'Fedora Patch16: Access permission - rt49003'
|
perl -x patchlevel.h 'Fedora Patch16: Access permission - rt49003'
|
||||||
|
perl -x patchlevel.h 'Fedora Patch17: CVE-2008-2827 perl: insecure use of chmod in rmtree'
|
||||||
|
|
||||||
%clean
|
%clean
|
||||||
rm -rf $RPM_BUILD_ROOT
|
rm -rf $RPM_BUILD_ROOT
|
||||||
@ -1615,6 +1620,9 @@ make test
|
|||||||
|
|
||||||
# Old changelog entries are preserved in CVS.
|
# Old changelog entries are preserved in CVS.
|
||||||
%changelog
|
%changelog
|
||||||
|
* Tue Jun 24 2008 Marcela Maslanova <mmaslano@redhat.com> 4:5.10.0-28
|
||||||
|
- CVE-2008-2827 perl: insecure use of chmod in rmtree
|
||||||
|
|
||||||
* Wed Jun 11 2008 Marcela Maslanova <mmaslano@redhat.com> 4:5.10.0-27
|
* Wed Jun 11 2008 Marcela Maslanova <mmaslano@redhat.com> 4:5.10.0-27
|
||||||
- 447371 wrong access permission rt49003
|
- 447371 wrong access permission rt49003
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user