rpms/perl
3
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
6d46fd4e90
perl/perl-5.8.8-U28775.patch

326 lines
8.2 KiB
Diff
Raw Normal View History

bugzilla: 196836 - Apply upstream patch #28775, which fixes an issue where weblessing overloaded objects incurs significant performance penalty.
2007-06-22 20:16:01 +00:00
--- 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;
}
Reference in New Issue Copy Permalink