bugzilla: 196836 - Apply upstream patch #28775, which fixes an issue where
weblessing overloaded objects incurs significant performance penalty.
This commit is contained in:
Robin Norwood
parent
f7c800f98f
commit
faeaaf076c
325
perl-5.8.8-U28775.patch
Normal file
325
perl-5.8.8-U28775.patch
Normal file
@ -0,0 +1,325 @@
|
||||
--- 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;
|
||||
}
|
||||
11
perl.spec
11
perl.spec
@ -20,7 +20,7 @@
|
||||
|
||||
Name: perl
|
||||
Version: %{perl_version}
|
||||
Release: 19%{?dist}
|
||||
Release: 20%{?dist}
|
||||
Epoch: %{perl_epoch}
|
||||
Summary: The Perl programming language
|
||||
Group: Development/Languages
|
||||
@ -112,6 +112,7 @@ Patch38: perl-5.8.8-bz199736.patch
|
||||
Patch39: perl-5.8.8-disable_test_hosts.patch
|
||||
# XXX: Fixme - Finish patch.
|
||||
#Patch39: perl-5.8.8-bz204679.patch
|
||||
Patch40: perl-5.8.8-U28775.patch
|
||||
BuildRoot: %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n)
|
||||
BuildRequires: tcsh, dos2unix, man, groff
|
||||
BuildRequires: gdbm-devel, db4-devel
|
||||
@ -325,7 +326,8 @@ Basic utilities for writing tests.
|
||||
%patch36 -p1
|
||||
%patch37 -p1
|
||||
%patch38 -p1
|
||||
%patch39 -p1
|
||||
#%patch39 -p1
|
||||
%patch40 -p1
|
||||
#
|
||||
# Candidates for doc recoding (need case by case review):
|
||||
# find . -name "*.pod" -o -name "README*" -o -name "*.pm" | xargs file -i | grep charset= | grep -v '\(us-ascii\|utf-8\)'
|
||||
@ -719,6 +721,11 @@ make test
|
||||
%{_mandir}/man3/Test::Tutorial*
|
||||
|
||||
%changelog
|
||||
* Fri Jun 22 2007 Robin Norwood <rnorwood@redhat.com> - 4:5.8.8-20
|
||||
- Resolves: rhbz#196836
|
||||
- Apply upstream patch #28775, which fixes an issue where weblessing
|
||||
overloaded objects incurs significant performance penalty
|
||||
|
||||
* Fri Jun 1 2007 Robin Norwood <rnorwood@redhat.com> - 4:5.8.8-19
|
||||
- Remove artificial Requires from perl-devel
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user