diff --git a/MANIFEST b/MANIFEST index e2a79c070f69..6e98563373bf 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4770,6 +4770,7 @@ ext/B/t/optree_constants.t B::Concise rendering of optimized constant subs ext/B/t/optree_for.t for loops ext/B/t/optree_misc.t misc optree tests ext/B/t/optree_samples.t various basic codes: if for while +ext/B/t/optree_signatures.t test B output on subroutine signatures ext/B/t/optree_sort.t inplace sort optimization regression ext/B/t/optree_specials.t BEGIN, END, etc code ext/B/t/optree_varinit.t my,our,local var init optimization diff --git a/ext/B/B.pm b/ext/B/B.pm index 5464549d4f83..7d6a8472a7c3 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -20,7 +20,7 @@ sub import { # walkoptree comes from B.xs BEGIN { - $B::VERSION = '1.90'; + $B::VERSION = '1.91'; @B::EXPORT_OK = (); # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. diff --git a/ext/B/B.xs b/ext/B/B.xs index 2d649ccb2440..7475a45bb290 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -62,7 +62,7 @@ static const char* const opclassnames[] = { }; static const size_t opsizes[] = { - 0, + 0, sizeof(OP), sizeof(UNOP), sizeof(BINOP), @@ -647,7 +647,7 @@ formfeed() PPCODE: PUSHs(make_sv_object(aTHX_ GvSV(gv_fetchpvs("\f", GV_ADD, SVt_PV)))); -long +long amagic_generation() CODE: RETVAL = PL_amagic_generation; @@ -728,7 +728,7 @@ opnumber(name) const char * name CODE: { - int i; + int i; IV result = -1; ST(0) = sv_newmortal(); if (strBEGINs(name,"pp_")) @@ -1189,6 +1189,49 @@ string(o, cv) break; } + case OP_MULTIPARAM: + { + struct op_multiparam_aux *aux = (struct op_multiparam_aux *)cUNOP_AUXo->op_aux; + size_t min_args = aux->min_args; + size_t n_positional = aux->n_positional; + size_t n_named = aux->n_named; + PADNAME **pns = PadnamelistARRAY(PadlistNAMES(CvPADLIST(cv))); + + ret = newSVpvs_flags("", SVs_TEMP); + if(!n_positional && !n_named) + sv_catpvf(ret, "0"); /* omit trailing space */ + else if(min_args < n_positional) + sv_catpvf(ret, "%zd..%zd ", min_args, n_positional); + else + sv_catpvf(ret, "%zd ", n_positional); + + for(size_t i = 0; i < n_positional; i++) { + if(i) + sv_catpvs(ret, ","); + PADOFFSET padix = aux->param_padix[i]; + if(padix) + sv_catpvf(ret, "%" PNf, PNfARG(pns[padix])); + else + sv_catpvs(ret, "$"); + } + + for(size_t i = 0; i < n_named; i++) { + struct op_multiparam_named_aux *named = aux->named + i; + if(n_positional || i) + sv_catpvs(ret, ","); + + sv_catpvf(ret, ":%.*s", (int)named->namelen, named->namepv); + } + + if(aux->slurpy) { + if(n_positional || n_named) + sv_catpvf(ret, ","); + sv_catpvf(ret, "%" PNf, PNfARG(pns[aux->slurpy_padix])); + } + + break; + } + default: ret = sv_2mortal(newSVpvn("", 0)); } @@ -1447,7 +1490,7 @@ SvTRUE(sv) bool SvTRUE_nomg(sv) B::SV sv - + MODULE = B PACKAGE = B::IV PREFIX = Sv IV @@ -1503,7 +1546,7 @@ MODULE = B PACKAGE = B::IV #define PVAV_max_ix sv_SSize_tp | STRUCT_OFFSET(struct xpvav, xav_max) -#define PVCV_stash_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_stash) +#define PVCV_stash_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_stash) #define PVCV_gv_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_gv_u.xcv_gv) #define PVCV_file_ix sv_char_pp | STRUCT_OFFSET(struct xpvcv, xcv_file) #define PVCV_outside_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_outside) diff --git a/ext/B/t/optree_signatures.t b/ext/B/t/optree_signatures.t new file mode 100644 index 000000000000..3ef490ab87fd --- /dev/null +++ b/ext/B/t/optree_signatures.t @@ -0,0 +1,95 @@ +#!perl + +BEGIN { + unshift @INC, 't'; + require Config; + if (($Config::Config{'extensions'} !~ /\bB\b/) ){ + print "1..0 # Skip -- Perl configured without B module\n"; + exit 0; + } +} +use feature 'signatures'; +use OptreeCheck; +plan tests => 14; + +checkOptree( name => '0 args', + code => sub () {}, + expect => <<'EOT_EOT'); +4 <1> leavesub[1 ref] K/REFC,1 ->(end) +- <1> ex-argcheck KP/1 ->4 +- <@> lineseq K ->- +1 <;> nextstate(main 1587 optree_signature.t:14) :%,fea=15 ->2 +2 <+> multiparam(0) ->3 +3 <;> nextstate(main 1587 optree_signature.t:15) :%,fea=15 ->4 +EOT_EOT + +checkOptree( name => '2 args', + code => sub ($x, $y) {}, + expect => <<'EOT_EOT'); +4 <1> leavesub[1 ref] K/REFC,1 ->(end) +- <1> ex-argcheck KP/1 ->4 +- <@> lineseq K ->- +1 <;> nextstate(main 1587 optree_signature.t:14) :%,fea=15 ->2 +2 <+> multiparam(2 $x,$y) ->3 +3 <;> nextstate(main 1587 optree_signature.t:15) :%,fea=15 ->4 +EOT_EOT + +checkOptree( name => '2 anon args', + code => sub ($, $) {}, + expect => <<'EOT_EOT'); +4 <1> leavesub[1 ref] K/REFC,1 ->(end) +- <1> ex-argcheck KP/1 ->4 +- <@> lineseq K ->- +1 <;> nextstate(main 1587 optree_signature.t:14) :%,fea=15 ->2 +2 <+> multiparam(2 $,$) ->3 +3 <;> nextstate(main 1587 optree_signature.t:15) :%,fea=15 ->4 +EOT_EOT + +checkOptree( name => '2 + 1 optional args', + code => sub ($x, $y, $z = undef) {}, + expect => <<'EOT_EOT'); +8 <1> leavesub[1 ref] K/REFC,1 ->(end) +- <1> ex-argcheck KP/1 ->8 +- <@> lineseq K ->- +1 <;> nextstate(main 1596 optree_signature.t:38) :%,fea=15 ->2 +2 <+> multiparam(2..3 $x,$y,$z) ->3 +3 <;> nextstate(main 1596 optree_signature.t:37) :%,fea=15 ->4 +- <1> null K/1 ->7 +4 <|> paramtest(other->5)[$z:1595,1596] vK ->7 +6 <1> paramstore[$z:1595,1596] K/1 ->7 +5 <0> undef s ->6 +7 <;> nextstate(main 1596 optree_signature.t:38) :%,fea=15 ->8 +EOT_EOT + +checkOptree( name => '2 + slurpy array args', + code => sub ($x, $y, @rest) {}, + expect => <<'EOT_EOT'); +4 <1> leavesub[1 ref] K/REFC,1 ->(end) +- <1> ex-argcheck KP/1 ->4 +- <@> lineseq K ->- +1 <;> nextstate(main 1587 optree_signature.t:14) :%,fea=15 ->2 +2 <+> multiparam(2 $x,$y,@rest) ->3 +3 <;> nextstate(main 1587 optree_signature.t:15) :%,fea=15 ->4 +EOT_EOT + +checkOptree( name => 'named args', + code => sub (:$alpha, :$beta) {}, + expect => <<'EOT_EOT'); +4 <1> leavesub[1 ref] K/REFC,1 ->(end) +- <1> ex-argcheck KP/1 ->4 +- <@> lineseq K ->- +1 <;> nextstate(main 1587 optree_signature.t:14) :%,fea=15 ->2 +2 <+> multiparam(0 :alpha,:beta) ->3 +3 <;> nextstate(main 1587 optree_signature.t:15) :%,fea=15 ->4 +EOT_EOT + +checkOptree( name => '2 + named + slurpy args', + code => sub ($x, $y, :$alpha, :$beta, @rest) {}, + expect => <<'EOT_EOT'); +4 <1> leavesub[1 ref] K/REFC,1 ->(end) +- <1> ex-argcheck KP/1 ->4 +- <@> lineseq K ->- +1 <;> nextstate(main 1587 optree_signature.t:14) :%,fea=15 ->2 +2 <+> multiparam(2 $x,$y,:alpha,:beta,@rest) ->3 +3 <;> nextstate(main 1587 optree_signature.t:15) :%,fea=15 ->4 +EOT_EOT