diff options
| -rw-r--r-- | ext/B/B/Deparse.pm | 38 | ||||
| -rw-r--r-- | ext/B/t/concise-xs.t | 2 | ||||
| -rw-r--r-- | ext/B/t/f_map.t | 26 | ||||
| -rw-r--r-- | ext/B/t/f_sort.t | 66 | ||||
| -rw-r--r-- | ext/Devel/Peek/t/Peek.t | 10 | ||||
| -rw-r--r-- | op.c | 8 | ||||
| -rw-r--r-- | op.h | 2 | ||||
| -rw-r--r-- | pp.c | 10 |
8 files changed, 90 insertions, 72 deletions
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 8764113518..7b1e538ebe 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -20,7 +20,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring 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.76; +$VERSION = 0.77; use strict; use vars qw/$AUTOLOAD/; use warnings (); @@ -1751,6 +1751,32 @@ sub padval { 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) = @_; @@ -1758,15 +1784,7 @@ sub pp_refgen { 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 " . diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t index 7caf292417..f0c7a7055b 100644 --- a/ext/B/t/concise-xs.t +++ b/ext/B/t/concise-xs.t @@ -117,7 +117,7 @@ use Getopt::Std; use Carp; use Test::More tests => ( # per-pkg tests (function ct + require_ok) 40 + 16 # Data::Dumper, Digest::MD5 - + 512 + 235 # B::Deparse, B + + 515 + 235 # B::Deparse, B + 595 + 190 # POSIX, IO::Socket + 3 * ($] > 5.009) + 16 * ($] >= 5.009003) diff --git a/ext/B/t/f_map.t b/ext/B/t/f_map.t index 9c2dd1d9b9..420e649069 100644 --- a/ext/B/t/f_map.t +++ b/ext/B/t/f_map.t @@ -512,14 +512,13 @@ checkOptree(note => q{}, # 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 @@ EOT_EOT # 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 diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t index 20bf86507d..b81d4c3a1e 100644 --- a/ext/B/t/f_sort.t +++ b/ext/B/t/f_sort.t @@ -516,25 +516,24 @@ checkOptree(name => q{Compound sort/map Expression }, # 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 @@ EOT_EOT # 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 diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t index 099e165498..cf20f8b69c 100644 --- a/ext/Devel/Peek/t/Peek.t +++ b/ext/Devel/Peek/t/Peek.t @@ -180,7 +180,7 @@ do_test(11, FLAGS = \\(ROK\\) RV = $ADDR SV = PVAV\\($ADDR\\) at $ADDR - REFCNT = 2 + REFCNT = 1 FLAGS = \\(\\) ARRAY = $ADDR FILL = 1 @@ -201,7 +201,7 @@ do_test(12, FLAGS = \\(ROK\\) RV = $ADDR SV = PVHV\\($ADDR\\) at $ADDR - REFCNT = 2 + REFCNT = 1 FLAGS = \\(SHAREKEYS\\) ARRAY = $ADDR \\(0:7, 1:1\\) hash quality = 100.0% @@ -291,7 +291,7 @@ do_test(16, FLAGS = \\(ROK\\) RV = $ADDR SV = PVHV\\($ADDR\\) at $ADDR - REFCNT = 2 + REFCNT = 1 FLAGS = \\(OBJECT,SHAREKEYS\\) STASH = $ADDR\\t"Tac" ARRAY = 0x0 @@ -351,7 +351,7 @@ do_test(19, FLAGS = \\(ROK\\) RV = $ADDR SV = PVHV\\($ADDR\\) at $ADDR - REFCNT = 2 + REFCNT = 1 FLAGS = \\(SHAREKEYS,HASKFLAGS\\) ARRAY = $ADDR \\(0:7, 1:1\\) hash quality = 100.0% @@ -375,7 +375,7 @@ do_test(19, FLAGS = \\(ROK\\) RV = $ADDR SV = PVHV\\($ADDR\\) at $ADDR - REFCNT = 2 + REFCNT = 1 FLAGS = \\(SHAREKEYS,HASKFLAGS\\) ARRAY = $ADDR \\(0:7, 1:1\\) hash quality = 100.0% @@ -2258,6 +2258,8 @@ Perl_gen_constant_list(pTHX_ register OP *o) 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; @@ -5681,15 +5683,13 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) 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 * @@ -121,6 +121,8 @@ Deprecated. Use C<GIMME_V> instead. /* On OP_ENTERWHEN, there's no condition */ /* On OP_BREAK, an implicit break */ /* On OP_SMARTMATCH, an implicit smartmatch */ + /* 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 @@ -4123,16 +4123,17 @@ PP(pp_anonlist) { dVAR; 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) { dVAR; dSP; dMARK; dORIGMARK; - HV* const hv = (HV*)sv_2mortal((SV*)newHV()); + HV* const hv = newHV(); while (MARK < SP) { SV * const key = *++MARK; @@ -4144,7 +4145,8 @@ PP(pp_anonhash) (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; } |