In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c70a6f041b1579be443b8d34373e7fc4a4cbb6aa?hp=647688d88b9d452552ce64abafeef295a3c44d99>
- Log ----------------------------------------------------------------- commit c70a6f041b1579be443b8d34373e7fc4a4cbb6aa Author: Father Chrysostomos <[email protected]> Date: Fri Jun 8 14:50:35 2012 -0700 Increase $B::Deparse::VERSION to 1.15 M dist/B-Deparse/Deparse.pm commit 6a31dbf44ee919c340a3372c95b28d581979d165 Author: Father Chrysostomos <[email protected]> Date: Fri Jun 8 14:49:57 2012 -0700 B::Deparse: loopexes have list prec M dist/B-Deparse/Deparse.pm M dist/B-Deparse/t/core.t M dist/B-Deparse/t/deparse.t commit baed7faab5779faa6e177f5276044379d4addd12 Author: Father Chrysostomos <[email protected]> Date: Fri Jun 8 12:58:42 2012 -0700 Constant folding for x M op.c M opcode.h M regen/opcodes M t/lib/warnings/op commit a2278b6a4df245dc9db4e52815cdd713a3799982 Author: Father Chrysostomos <[email protected]> Date: Fri Jun 8 12:27:16 2012 -0700 cv.h: Add comments M cv.h commit e157a82b7da0adb94ee8eb516fa3b8da06977900 Author: Father Chrysostomos <[email protected]> Date: Fri Jun 8 10:00:38 2012 -0700 Make __SUB__ work in special blocks M op.c M pp.c M t/op/current_sub.t commit 7eeb6e4ece329a87e4a71555a3e99a1da2a21bb4 Author: Father Chrysostomos <[email protected]> Date: Fri Jun 8 08:45:11 2012 -0700 sv.h: Comment typo M sv.h ----------------------------------------------------------------------- Summary of changes: cv.h | 2 ++ dist/B-Deparse/Deparse.pm | 6 +++--- dist/B-Deparse/t/core.t | 2 +- dist/B-Deparse/t/deparse.t | 7 +++++++ op.c | 4 +++- opcode.h | 2 +- pp.c | 2 +- regen/opcodes | 2 +- sv.h | 2 +- t/lib/warnings/op | 5 ++++- t/op/current_sub.t | 12 ++++++++++-- 11 files changed, 34 insertions(+), 12 deletions(-) diff --git a/cv.h b/cv.h index 448e20a..96308a2 100644 --- a/cv.h +++ b/cv.h @@ -123,6 +123,7 @@ See L<perlguts/Autoloading with XSUBs>. #define CvANON_on(cv) (CvFLAGS(cv) |= CVf_ANON) #define CvANON_off(cv) (CvFLAGS(cv) &= ~CVf_ANON) +/* CvEVAL or CvSPECIAL */ #define CvUNIQUE(cv) (CvFLAGS(cv) & CVf_UNIQUE) #define CvUNIQUE_on(cv) (CvFLAGS(cv) |= CVf_UNIQUE) #define CvUNIQUE_off(cv) (CvFLAGS(cv) &= ~CVf_UNIQUE) @@ -139,6 +140,7 @@ See L<perlguts/Autoloading with XSUBs>. #define CvLVALUE_on(cv) (CvFLAGS(cv) |= CVf_LVALUE) #define CvLVALUE_off(cv) (CvFLAGS(cv) &= ~CVf_LVALUE) +/* eval or PL_main_cv */ #define CvEVAL(cv) (CvUNIQUE(cv) && !SvFAKE(cv)) #define CvEVAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_off(cv)) #define CvEVAL_off(cv) CvUNIQUE_off(cv) diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index 46af5e4..bbb730a 100644 --- a/dist/B-Deparse/Deparse.pm +++ b/dist/B-Deparse/Deparse.pm @@ -20,7 +20,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring CVf_METHOD CVf_LVALUE PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED); -$VERSION = '1.14'; +$VERSION = '1.15'; use strict; use vars qw/$AUTOLOAD/; use warnings (); @@ -2155,10 +2155,10 @@ sub loopex { } elsif (class($op) eq "OP") { # no-op } elsif (class($op) eq "UNOP") { - (my $kid = $self->deparse($op->first, 16)) =~ s/^\cS//; + (my $kid = $self->deparse($op->first, 5)) =~ s/^\cS//; $name .= " $kid"; } - return $self->maybe_parens($name, $cx, 16); + return $self->maybe_parens($name, $cx, 5); } sub pp_last { loopex(@_, "last") } diff --git a/dist/B-Deparse/t/core.t b/dist/B-Deparse/t/core.t index 62ff862..de8d280 100644 --- a/dist/B-Deparse/t/core.t +++ b/dist/B-Deparse/t/core.t @@ -74,7 +74,7 @@ sub CORE_test { $deparse->coderef2text( eval "no strict 'vars'; sub { () = $expr }" or die "$@in $expr" ), - qr/\sCORE::$keyword.*;/, + qr/\bCORE::$keyword.*[);]/, $name||$keyword } diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index 5085a5e..e81c17c 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -1145,6 +1145,13 @@ $_ = ($a xor not +($1 || 2) ** 2); () = warn() + 1; () = setpgrp() + 1; #### +# loopexes have list prec +() = (CORE::dump a) | 'b'; +() = (goto a) | 'b'; +() = (last a) | 'b'; +() = (next a) | 'b'; +() = (redo a) | 'b'; +#### # [perl #63558] open local(*FH) open local *FH; pipe local *FH, local *FH; diff --git a/op.c b/op.c index 34b1097..b4ffc81 100644 --- a/op.c +++ b/op.c @@ -3010,6 +3010,8 @@ S_fold_constants(pTHX_ register OP *o) if (IN_LOCALE_COMPILETIME) goto nope; break; + case OP_REPEAT: + if (o->op_private & OPpREPEAT_DOLIST) goto nope; } if (PL_parser && PL_parser->error_count) @@ -10404,7 +10406,7 @@ Perl_rpeep(pTHX_ register OP *o) case OP_RUNCV: if (!(o->op_private & OPpOFFBYONE) && !CvCLONE(PL_compcv)) { SV *sv; - if (CvUNIQUE(PL_compcv)) sv = &PL_sv_undef; + if (CvEVAL(PL_compcv)) sv = &PL_sv_undef; else { sv = newRV((SV *)PL_compcv); sv_rvweaken(sv); diff --git a/opcode.h b/opcode.h index f33f124..217cb56 100644 --- a/opcode.h +++ b/opcode.h @@ -1764,7 +1764,7 @@ EXTCONST U32 PL_opargs[] = { 0x0001121e, /* i_divide */ 0x0001123e, /* modulo */ 0x0001121e, /* i_modulo */ - 0x00012209, /* repeat */ + 0x0001220b, /* repeat */ 0x0001123e, /* add */ 0x0001121e, /* i_add */ 0x0001123e, /* subtract */ diff --git a/pp.c b/pp.c index 0066513..d482286 100644 --- a/pp.c +++ b/pp.c @@ -5931,7 +5931,7 @@ PP(pp_runcv) oldsi->si_cxix = oldcxix; } else cv = find_runcv(NULL); - XPUSHs(CvUNIQUE(cv) ? &PL_sv_undef : sv_2mortal(newRV((SV *)cv))); + XPUSHs(CvEVAL(cv) ? &PL_sv_undef : sv_2mortal(newRV((SV *)cv))); RETURN; } diff --git a/regen/opcodes b/regen/opcodes index d92c397..8666d8c 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -126,7 +126,7 @@ divide division (/) ck_null IfsT2 S S i_divide integer division (/) ck_null ifsT2 S S modulo modulus (%) ck_null IifsT2 S S i_modulo integer modulus (%) ck_null ifsT2 S S -repeat repeat (x) ck_repeat mt2 L S +repeat repeat (x) ck_repeat fmt2 L S add addition (+) ck_null IfsT2 S S i_add integer addition (+) ck_null ifsT2 S S diff --git a/sv.h b/sv.h index 6d26f85..c347aea 100644 --- a/sv.h +++ b/sv.h @@ -307,7 +307,7 @@ perform the upgrade if necessary. See C<svtype>. #define SVpgv_GP SVp_SCREAM /* GV has a valid GP */ #define SVprv_PCS_IMPORTED SVp_SCREAM /* RV is a proxy for a constant subroutine in another package. Set the - CvIMPORTED_CV_ON() if it needs to be + GvIMPORTED_CV_on() if it needs to be expanded to a real GV */ /* 0x00010000 *** FREE SLOT */ #define SVs_PADTMP 0x00020000 /* in use as tmp; only if ! SVs_PADMY */ diff --git a/t/lib/warnings/op b/t/lib/warnings/op index 6dfcf5d..ef83756 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -148,7 +148,9 @@ Using an array as a reference is deprecated at - line 10. ######## # op.c use warnings 'void' ; close STDIN ; -1 x 3 ; # OP_REPEAT +#line 2 +1 x 3 ; # OP_REPEAT (folded) +(1) x 3 ; # OP_REPEAT # OP_GVSV wantarray ; # OP_WANTARRAY # OP_GV @@ -205,6 +207,7 @@ $a <=> $b; # OP_NCMP use 5.015; __SUB__ # OP_RUNCV EXPECT +Useless use of a constant ("111") in void context at - line 2. Useless use of repeat (x) in void context at - line 3. Useless use of wantarray in void context at - line 5. Useless use of reference-type operator in void context at - line 12. diff --git a/t/op/current_sub.t b/t/op/current_sub.t index 7a00032..e72a0c5 100644 --- a/t/op/current_sub.t +++ b/t/op/current_sub.t @@ -4,10 +4,9 @@ BEGIN { chdir 't'; @INC = qw(../lib); require './test.pl'; + plan (tests => 13); } -plan tests => 11; - is __SUB__, "__SUB__", '__SUB__ is a bareword outside of use feature'; { @@ -37,3 +36,12 @@ for my $x(1..3) { is $subsubs[0]()(0), 1, '__SUB__ inside closure (1)'; is $subsubs[1]()(0), 2, '__SUB__ inside closure (2)'; is $subsubs[2]()(0), 3, '__SUB__ inside closure (3)'; + +BEGIN { + return "begin 1" if @_; + is CORE::__SUB__->(0), "begin 1", 'in BEGIN block' +} +BEGIN { + return "begin 2" if @_; + is &CORE::__SUB__->(0), "begin 2", 'in BEGIN block via & (unoptimised)' +} -- Perl5 Master Repository
