From faeaaf076c53c541ab50ab77a1f1d435baf15b10 Mon Sep 17 00:00:00 2001 From: Robin Norwood Date: Jun 22 2007 20:16:01 +0000 Subject: bugzilla: 196836 - Apply upstream patch #28775, which fixes an issue where weblessing overloaded objects incurs significant performance penalty. --- diff --git a/perl-5.8.8-U28775.patch b/perl-5.8.8-U28775.patch new file mode 100644 index 0000000..effacc4 --- /dev/null +++ b/perl-5.8.8-U28775.patch @@ -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; + } diff --git a/perl.spec b/perl.spec index 2877dfd..f6e96bf 100644 --- a/perl.spec +++ b/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 - 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 - 4:5.8.8-19 - Remove artificial Requires from perl-devel