rpms/perl/F-7 perl-5.8.8-U28775.patch, NONE, 1.1 perl.spec, 1.118, 1.119
Robin Norwood (rnorwood)
fedora-extras-commits at redhat.com
Fri Jun 22 21:20:16 UTC 2007
Author: rnorwood
Update of /cvs/pkgs/rpms/perl/F-7
In directory cvs-int.fedora.redhat.com:/tmp/cvs-serv12242
Modified Files:
perl.spec
Added Files:
perl-5.8.8-U28775.patch
Log Message:
Resolves: rhbz#196836 - Apply upstream patch #28775, which fixes an issue where reblessing overloaded objects incurs significant performance penalty.
perl-5.8.8-U28775.patch:
--- NEW FILE perl-5.8.8-U28775.patch ---
--- 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;
}
Index: perl.spec
===================================================================
RCS file: /cvs/pkgs/rpms/perl/F-7/perl.spec,v
retrieving revision 1.118
retrieving revision 1.119
diff -u -r1.118 -r1.119
--- perl.spec 17 May 2007 02:49:03 -0000 1.118
+++ perl.spec 22 Jun 2007 21:19:41 -0000 1.119
@@ -20,7 +20,7 @@
Name: perl
Version: %{perl_version}
-Release: 18%{?dist}
+Release: 19%{?dist}
Epoch: %{perl_epoch}
Summary: The Perl programming language
Group: Development/Languages
@@ -112,6 +112,7 @@
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
@@ -327,7 +328,8 @@
%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\)'
@@ -721,6 +723,11 @@
%{_mandir}/man3/Test::Tutorial*
%changelog
+* Fri Jun 22 2007 Robin Norwood <rnorwood at redhat.com> - 4:5.8.8-19
+- Resolves: rhbz#196836
+- Apply upstream patch #28775, which fixes an issue where reblessing
+ overloaded objects incurs significant performance penalty
+
* Wed May 16 2007 Robin Norwood <rnorwood at redhat.com> - 4:5.8.8-18
- Have perl-devel Require the other development/build related modules for simplicity.
More information about the fedora-extras-commits
mailing list