diff --git a/class.c b/class.c index 9d5f17ae8ae4..9b27be6f2d9a 100644 --- a/class.c +++ b/class.c @@ -254,9 +254,14 @@ XS(injected_constructor) /* TODO: People would probably expect to find this in pp.c ;) */ PP(pp_methstart) { - /* note that if AvREAL(@_), be careful not to leak self: - * so keep it in @_ for now, and only shift it later */ - SV *self = *(av_fetch(GvAV(PL_defgv), 0, 1)); + bool self_in_pad = PL_op->op_private & OPpSELF_IN_PAD; + SV *self; + if (self_in_pad) + self = PAD_SVl(PADIX_SELF); + else + /* note that if AvREAL(@_), be careful not to leak self: + * so keep it in @_ for now, and only shift it later */ + self = *(av_fetch(GvAV(PL_defgv), 0, 1)); SV *rv = NULL; /* pp_methstart happens before the first OP_NEXTSTATE of the method body, @@ -285,8 +290,10 @@ PP(pp_methstart) croak("Cannot invoke a method of %" HvNAMEf_QUOTEDPREFIX " on an instance of %" HvNAMEf_QUOTEDPREFIX, HvNAMEfARG(CvSTASH(curcv)), HvNAMEfARG(SvSTASH(rv))); - save_clearsv(&PAD_SVl(PADIX_SELF)); - sv_setsv(PAD_SVl(PADIX_SELF), self); + if (!self_in_pad) { + save_clearsv(&PAD_SVl(PADIX_SELF)); + sv_setsv(PAD_SVl(PADIX_SELF), self); + } UNOP_AUX_item *aux = cUNOP_AUX->op_aux; if(aux) { @@ -318,10 +325,12 @@ PP(pp_methstart) } } - /* safe to shift and free self now */ - self = av_shift(GvAV(PL_defgv)); - if (AvREAL(GvAV(PL_defgv))) - SvREFCNT_dec_NN(self); + if (!self_in_pad) { + /* safe to shift and free self now */ + self = av_shift(GvAV(PL_defgv)); + if (AvREAL(GvAV(PL_defgv))) + SvREFCNT_dec_NN(self); + } if(PL_op->op_private & OPpINITFIELDS) { SV *params = *av_fetch(GvAV(PL_defgv), 0, 0); @@ -944,6 +953,25 @@ Perl_class_prepare_method_parse(pTHX_ CV *cv) CvIsMETHOD_on(cv); } +#define find_op_methstart(o) S_find_op_methstart(aTHX_ o) +static OP * +S_find_op_methstart(pTHX_ OP *o) +{ + if(o->op_type == OP_METHSTART) + return o; + + if(!(o->op_flags & OPf_KIDS)) + return NULL; + + for(OP *kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) { + OP *methstart = find_op_methstart(kid); + if(methstart) + return methstart; + } + + return NULL; +} + OP * Perl_class_wrap_method_body(pTHX_ OP *o) { @@ -1001,7 +1029,18 @@ Perl_class_wrap_method_body(pTHX_ OP *o) if(o->op_type != OP_LINESEQ) o = newLISTOP(OP_LINESEQ, 0, o, NULL); - op_sibling_splice(o, NULL, 0, newUNOP_AUX(OP_METHSTART, 0, NULL, aux)); + if(CvSIGNATURE(PL_compcv)) { + /* A signatured method has already injected the OP_METHSTART; we just + * have to find it and attach the aux structure to it + */ + OP *methstartop = find_op_methstart(o); + assert(methstartop); + assert(!cUNOP_AUXx(methstartop)->op_aux); + + cUNOP_AUXx(methstartop)->op_aux = aux; + } + else + op_sibling_splice(o, NULL, 0, newUNOP_AUX(OP_METHSTART, 0, NULL, aux)); return o; } @@ -1099,13 +1138,14 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value) I32 save_ix = block_start(TRUE); - subsignature_start(); - PADOFFSET padix; padix = pad_add_name_pvs("$self", 0, NULL, NULL); assert(padix == PADIX_SELF); + subsignature_start(); + CvSIGNATURE_on(PL_compcv); + OP *sigop = subsignature_finish(); padix = pad_import_field(pn); @@ -1166,13 +1206,14 @@ apply_field_attribute_writer(pTHX_ PADNAME *pn, SV *value) I32 save_ix = block_start(TRUE); - subsignature_start(); - PADOFFSET padix; padix = pad_add_name_pvs("$self", 0, NULL, NULL); assert(padix == PADIX_SELF); + subsignature_start(); + CvSIGNATURE_on(PL_compcv); + /* param pad variable doesn't technically need a name, so don't bother as * reusing the field name will provoke a warning */ PADOFFSET param_padix = padix = pad_add_name_pvn("$", 1, 0, NULL, NULL); diff --git a/embed.fnc b/embed.fnc index aceb5014e14b..baba609c26cf 100644 --- a/embed.fnc +++ b/embed.fnc @@ -3110,6 +3110,8 @@ CRp |NV |str_to_version |NN SV *sv : Used in pp_ctl.c p |void |sub_crush_depth|NN CV *cv : Used in perly.y +p |void |subsignature_append_fence_op \ + |NN OP *o p |void |subsignature_append_positional \ |PADOFFSET padix \ |OPCODE defmode \ diff --git a/embed.h b/embed.h index ae046a6173e8..fa647eadca0a 100644 --- a/embed.h +++ b/embed.h @@ -1162,6 +1162,7 @@ # define sighandler1 Perl_sighandler1 # define sighandler3 Perl_sighandler3 # define sub_crush_depth(a) Perl_sub_crush_depth(aTHX_ a) +# define subsignature_append_fence_op(a) Perl_subsignature_append_fence_op(aTHX_ a) # define subsignature_append_positional(a,b,c) Perl_subsignature_append_positional(aTHX_ a,b,c) # define subsignature_append_slurpy(a,b) Perl_subsignature_append_slurpy(aTHX_ a,b) # define subsignature_finish() Perl_subsignature_finish(aTHX) diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index cffcac22b7a5..30243477b7f3 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -1238,6 +1238,8 @@ sub deparse_argops { # skip trailing nextstate last if $$o == $$last; + next if $cv->CvFLAGS & CVf_IsMETHOD and $o->name eq "methstart"; + # OP_NEXTSTATE return unless $o->name =~ /^(next|db)state$/; return if $o->label; @@ -1296,6 +1298,13 @@ sub deparse_argops { } + if ($cv->CvFLAGS & CVf_IsMETHOD) { + # Remove the implied `$self` argument + warn "Expected first signature argument to be named \$self" + unless @sig and $sig[0] eq '$self'; + shift @sig; + } + while (++$last_ix < $params) { push @sig, $last_ix < $mandatory ? '$' : '$='; } @@ -1361,10 +1370,6 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL"); my $is_list = ($lineseq->name eq "lineseq"); my $firstop = $is_list ? $lineseq->first : $lineseq; - if ($is_method and $firstop->name eq "methstart") { - $firstop = $firstop->sibling; - } - # Try to deparse first subtree as a signature if possible. # Top of signature subtree has an ex-argcheck as a placeholder if ( $has_sig diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 8ef1f875c4d2..c0db96633bfa 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -473,7 +473,7 @@ $bits{method_named}{0} = $bf[0]; $bits{method_redir}{0} = $bf[0]; $bits{method_redir_super}{0} = $bf[0]; $bits{method_super}{0} = $bf[0]; -@{$bits{methstart}}{7,0} = ('OPpINITFIELDS', $bf[0]); +@{$bits{methstart}}{7,6,0} = ('OPpINITFIELDS', 'OPpSELF_IN_PAD', $bf[0]); @{$bits{mkdir}}{3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5]); @{$bits{modulo}}{1,0} = ($bf[1], $bf[1]); @{$bits{msgctl}}{3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5]); @@ -731,6 +731,7 @@ our %defines = ( OPpREPEAT_DOLIST => 64, OPpREVERSE_INPLACE => 8, OPpRV2HV_ISKEYS => 1, + OPpSELF_IN_PAD => 64, OPpSLICE => 64, OPpSLICEWARNING => 4, OPpSORT_DESCEND => 16, @@ -852,6 +853,7 @@ our %labels = ( OPpREPEAT_DOLIST => 'DOLIST', OPpREVERSE_INPLACE => 'INPLACE', OPpRV2HV_ISKEYS => 'KEYS', + OPpSELF_IN_PAD => 'SELF_IN_PAD', OPpSLICE => 'SLICE', OPpSLICEWARNING => 'SLICEWARN', OPpSORT_DESCEND => 'DESC', @@ -969,6 +971,7 @@ $ops_using{OPpMULTIDEREF_EXISTS} = $ops_using{OPpMULTIDEREF_DELETE}; $ops_using{OPpOPEN_IN_RAW} = $ops_using{OPpOPEN_IN_CRLF}; $ops_using{OPpOPEN_OUT_CRLF} = $ops_using{OPpOPEN_IN_CRLF}; $ops_using{OPpOPEN_OUT_RAW} = $ops_using{OPpOPEN_IN_CRLF}; +$ops_using{OPpSELF_IN_PAD} = $ops_using{OPpINITFIELDS}; $ops_using{OPpSLICE} = $ops_using{OPpKVSLICE}; $ops_using{OPpSORT_INPLACE} = $ops_using{OPpSORT_DESCEND}; $ops_using{OPpSORT_INTEGER} = $ops_using{OPpSORT_DESCEND}; diff --git a/op.c b/op.c index 1630393ab0d2..0e86a2aba2fe 100644 --- a/op.c +++ b/op.c @@ -16479,7 +16479,7 @@ struct yy_parser_signature { UV elems; /* number of signature elements seen so far */ UV optelems; /* number of optional signature elems seen */ char slurpy; /* the sigil of the slurpy var (or null) */ - OP *elemops; /* NULL, or an OP_LINESEQ of individual element ops */ + OP *elemops; /* NULL, or an OP_LINESEQ of individual element and fence ops */ }; static void @@ -16516,6 +16516,36 @@ Perl_subsignature_start(pTHX) SAVEVPTR(PL_parser->signature); PL_parser->signature = signature; + + /* TODO: This should ideally be performed by some sort of "magic" or + * "hook" mechanism on PL_compcv that class.c installed, thus decoupling + * this otherwise tightly-coupled mechanism here + */ + if(CvIsMETHOD(PL_compcv)) { + assert(PadnamelistMAX(PL_comppad_name) >= 1); + /* PADIX_SELF == 1 */ + assert(PadnamePV(PadnamelistARRAY(PL_comppad_name)[1])[0] == '$'); + subsignature_append_positional(1, 0, NULL); + subsignature_append_fence_op(newUNOP_AUX(OP_METHSTART, OPpSELF_IN_PAD << 8, NULL, NULL)); + } +} + +/* Appends another arbitrary optree into the accumulated set of signature- + * handling ops. This op will be invoked at some time after all of the + * parameters already present have received their values, but before any of + * the defaulting expressions for later parameters are executed. + */ + +void +Perl_subsignature_append_fence_op(pTHX_ OP *o) +{ + PERL_ARGS_ASSERT_SUBSIGNATURE_APPEND_FENCE_OP; + assert(PL_parser); + yy_parser_signature *signature = PL_parser->signature; + assert(signature); + + signature->elemops = op_append_elem(OP_LINESEQ, signature->elemops, + o); } /* Appends another positional scalar parameter to the accumulated set of diff --git a/opcode.h b/opcode.h index bcd9023068e6..670fbf9dd407 100644 --- a/opcode.h +++ b/opcode.h @@ -2415,6 +2415,7 @@ END_EXTERN_C #define OPpPAD_STATE 0x40 #define OPpREFCOUNTED 0x40 #define OPpREPEAT_DOLIST 0x40 +#define OPpSELF_IN_PAD 0x40 #define OPpSLICE 0x40 #define OPpTRANS_USE_SVOP 0x40 #define OPpPADRANGE_COUNTMASK 0x7f @@ -2547,6 +2548,7 @@ EXTCONST char PL_op_private_labels[] = { 'R','E','P','L','1','S','T','\0', 'R','E','V','\0', 'R','E','V','E','R','S','E','D','\0', + 'S','E','L','F','_','I','N','_','P','A','D','\0', 'S','H','O','R','T','\0', 'S','L','I','C','E','\0', 'S','L','I','C','E','W','A','R','N','\0', @@ -2585,16 +2587,16 @@ EXTCONST char PL_op_private_labels[] = { EXTCONST I16 PL_op_private_bitfields[] = { 0, 8, -1, 0, 8, -1, - 0, 715, 1, 554, 2, 71, 3, 298, -1, - 0, 749, -1, + 0, 727, 1, 554, 2, 71, 3, 298, -1, + 0, 761, -1, 0, 8, -1, 0, 8, -1, - 0, 756, -1, - 0, 745, -1, - 1, -1, 0, 694, 1, 39, 2, 324, -1, + 0, 768, -1, + 0, 757, -1, + 1, -1, 0, 706, 1, 39, 2, 324, -1, 4, -1, 1, 185, 2, 192, 3, 199, -1, - 4, -1, 0, 694, 1, 39, 2, 324, 3, 131, -1, - 6, 709, 1, 463, 2, 246, 3, 596, -1, + 4, -1, 0, 706, 1, 39, 2, 324, 3, 131, -1, + 6, 721, 1, 463, 2, 246, 3, 596, -1, }; @@ -3027,7 +3029,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* is_tainted */ 265, /* helemexistsor */ 267, /* methstart */ - 269, /* initfield */ + 270, /* initfield */ -1, /* classname */ }; @@ -3048,60 +3050,60 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { EXTCONST U16 PL_op_private_bitdefs[] = { 0x0003, /* scalar, prototype, refgen, srefgen, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, not, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, pop, shift, grepstart, anywhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, argcheck, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst, cmpchain_and, cmpchain_dup, entertrycatch, catch, is_bool, is_weak, weaken, unweaken, is_tainted */ - 0x3cfc, 0x5379, /* pushmark */ + 0x3cfc, 0x54f9, /* pushmark */ 0x00bd, /* wantarray, runcv */ - 0x077e, 0x0554, 0x1b70, 0x542c, 0x4fc8, 0x4225, /* const */ + 0x077e, 0x0554, 0x1b70, 0x55ac, 0x5148, 0x4225, /* const */ 0x3cfc, 0x47f9, /* gvsv */ 0x19d5, /* gv */ 0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, smartmatch, lslice, xor, isa */ - 0x3cfc, 0x5378, 0x04f7, /* padsv */ - 0x3cfc, 0x5378, 0x0003, /* padsv_store, lvavref */ - 0x3cfc, 0x5378, 0x06d4, 0x3dec, 0x5149, /* padav */ - 0x3cfc, 0x5378, 0x06d4, 0x0770, 0x3dec, 0x5148, 0x37c1, /* padhv */ - 0x3cfc, 0x1e38, 0x04f6, 0x3dec, 0x4148, 0x5424, 0x0003, /* rv2gv */ - 0x3cfc, 0x47f8, 0x04f6, 0x5424, 0x0003, /* rv2sv */ + 0x3cfc, 0x54f8, 0x04f7, /* padsv */ + 0x3cfc, 0x54f8, 0x0003, /* padsv_store, lvavref */ + 0x3cfc, 0x54f8, 0x06d4, 0x3dec, 0x52c9, /* padav */ + 0x3cfc, 0x54f8, 0x06d4, 0x0770, 0x3dec, 0x52c8, 0x37c1, /* padhv */ + 0x3cfc, 0x1e38, 0x04f6, 0x3dec, 0x4148, 0x55a4, 0x0003, /* rv2gv */ + 0x3cfc, 0x47f8, 0x04f6, 0x55a4, 0x0003, /* rv2sv */ 0x3dec, 0x0003, /* av2arylen, akeys, values, keys */ - 0x40bc, 0x1198, 0x0ef4, 0x014c, 0x5728, 0x5424, 0x0003, /* rv2cv */ + 0x40bc, 0x1198, 0x0ef4, 0x014c, 0x58a8, 0x55a4, 0x0003, /* rv2cv */ 0x06d4, 0x0770, 0x0003, /* ref, blessed */ 0x02af, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, chdir, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */ 0x49dc, 0x48f8, 0x2e74, 0x2db0, 0x0003, /* backtick */ 0x06d5, /* subst */ - 0x129c, 0x5b98, 0x0ad4, 0x528c, 0x28e8, 0x00c7, /* trans, transr */ + 0x129c, 0x5d18, 0x0ad4, 0x540c, 0x28e8, 0x00c7, /* trans, transr */ 0x10dc, 0x05f8, 0x0067, /* sassign */ 0x0d98, 0x0c94, 0x0b90, 0x3dec, 0x06c8, 0x0067, /* aassign */ - 0x57d0, 0x0003, /* chomp, schomp, negate, i_negate, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir */ - 0x3cfc, 0x5378, 0x36d4, 0x57d0, 0x0003, /* undef */ + 0x5950, 0x0003, /* chomp, schomp, negate, i_negate, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir */ + 0x3cfc, 0x54f8, 0x36d4, 0x5950, 0x0003, /* undef */ 0x06d4, 0x3dec, 0x0003, /* pos */ - 0x57d0, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract */ + 0x5950, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract */ 0x1658, 0x0067, /* repeat */ - 0x3fd8, 0x57d0, 0x0067, /* concat */ - 0x3cfc, 0x0338, 0x1e34, 0x57d0, 0x550c, 0x0003, /* multiconcat */ - 0x57d0, 0x02af, /* stringify, atan2, rand, srand, crypt, push, unshift, flock, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */ - 0x57d0, 0x5aa9, /* left_shift, right_shift, nbit_and, nbit_xor, nbit_or, ncomplement */ - 0x5aa9, /* bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, complement */ - 0x06d4, 0x57d0, 0x0003, /* length */ + 0x3fd8, 0x5950, 0x0067, /* concat */ + 0x3cfc, 0x0338, 0x1e34, 0x5950, 0x568c, 0x0003, /* multiconcat */ + 0x5950, 0x02af, /* stringify, atan2, rand, srand, crypt, push, unshift, flock, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */ + 0x5950, 0x5c29, /* left_shift, right_shift, nbit_and, nbit_xor, nbit_or, ncomplement */ + 0x5c29, /* bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, complement */ + 0x06d4, 0x5950, 0x0003, /* length */ 0x4d30, 0x3dec, 0x024b, /* substr */ - 0x57d0, 0x024b, /* substr_left */ + 0x5950, 0x024b, /* substr_left */ 0x3dec, 0x0067, /* vec */ - 0x3f58, 0x06d4, 0x57d0, 0x02af, /* index, rindex */ - 0x3cfc, 0x47f8, 0x06d4, 0x3dec, 0x5148, 0x5424, 0x0003, /* rv2av */ + 0x3f58, 0x06d4, 0x5950, 0x02af, /* index, rindex */ + 0x3cfc, 0x47f8, 0x06d4, 0x3dec, 0x52c8, 0x55a4, 0x0003, /* rv2av */ 0x037f, /* aelemfast, aelemfast_lex, aelemfastlex_store */ 0x3cfc, 0x3bf8, 0x04f6, 0x3dec, 0x0067, /* aelem, helem */ - 0x3cfc, 0x3dec, 0x5149, /* aslice, hslice */ + 0x3cfc, 0x3dec, 0x52c9, /* aslice, hslice */ 0x3ded, /* kvaslice, kvhslice */ - 0x3cfc, 0x5098, 0x3874, 0x0003, /* delete */ - 0x5658, 0x0003, /* exists */ - 0x3cfc, 0x47f8, 0x06d4, 0x0770, 0x3dec, 0x5148, 0x5424, 0x37c1, /* rv2hv */ - 0x3cfc, 0x3bf8, 0x1314, 0x1d50, 0x3dec, 0x5424, 0x0003, /* multideref */ + 0x3cfc, 0x5218, 0x3874, 0x0003, /* delete */ + 0x57d8, 0x0003, /* exists */ + 0x3cfc, 0x47f8, 0x06d4, 0x0770, 0x3dec, 0x52c8, 0x55a4, 0x37c1, /* rv2hv */ + 0x3cfc, 0x3bf8, 0x1314, 0x1d50, 0x3dec, 0x55a4, 0x0003, /* multideref */ 0x3cfc, 0x47f8, 0x0410, 0x396c, 0x2be9, /* split */ 0x3cfc, 0x2619, /* list */ - 0x3cfc, 0x5378, 0x0214, 0x57d0, 0x02af, /* emptyavhv */ + 0x3cfc, 0x54f8, 0x0214, 0x5950, 0x02af, /* emptyavhv */ 0x15b0, 0x34ac, 0x4e28, 0x35a4, 0x44c1, /* sort */ 0x34ac, 0x0003, /* reverse */ 0x06d4, 0x0003, /* grepwhile */ 0x3a98, 0x0003, /* flip, flop */ 0x3cfc, 0x0003, /* cond_expr */ - 0x3cfc, 0x1198, 0x04f6, 0x014c, 0x5728, 0x5424, 0x2cc1, /* entersub */ + 0x3cfc, 0x1198, 0x04f6, 0x014c, 0x58a8, 0x55a4, 0x2cc1, /* entersub */ 0x4b98, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */ 0x03ca, 0x0003, /* argelem */ 0x2adc, 0x29b8, 0x0003, /* argdefelem */ @@ -3111,24 +3113,24 @@ EXTCONST U16 PL_op_private_bitdefs[] = { 0x3cfc, 0x47f8, 0x120c, 0x4ea5, /* enteriter */ 0x2f08, 0x4ea5, /* iter */ 0x3b9c, 0x0067, /* leaveloop */ - 0x5cbc, 0x0003, /* last, next, redo, dump */ - 0x5cbc, 0x5728, 0x0003, /* goto */ + 0x5e3c, 0x0003, /* last, next, redo, dump */ + 0x5e3c, 0x58a8, 0x0003, /* goto */ 0x42e4, 0x0003, /* method, method_named, method_super, method_redir, method_redir_super */ 0x49dc, 0x48f8, 0x2e74, 0x2db0, 0x02af, /* open */ 0x2190, 0x23ec, 0x22a8, 0x2064, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */ 0x2190, 0x23ec, 0x22a8, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */ - 0x57d1, /* wait, getppid, time */ - 0x1c78, 0x4c34, 0x0fb0, 0x082c, 0x5a28, 0x2704, 0x0003, /* entereval */ + 0x5951, /* wait, getppid, time */ + 0x1c78, 0x4c34, 0x0fb0, 0x082c, 0x5ba8, 0x2704, 0x0003, /* entereval */ 0x3ebc, 0x0018, 0x14c4, 0x13e1, /* coreargs */ 0x3dec, 0x01e7, /* avhvswitch */ 0x3cfc, 0x031b, /* padrange */ - 0x3cfc, 0x5378, 0x0616, 0x362c, 0x1ac8, 0x0067, /* refassign */ - 0x3cfc, 0x5378, 0x0616, 0x362c, 0x1ac8, 0x0003, /* lvref */ + 0x3cfc, 0x54f8, 0x0616, 0x362c, 0x1ac8, 0x0067, /* refassign */ + 0x3cfc, 0x54f8, 0x0616, 0x362c, 0x1ac8, 0x0003, /* lvref */ 0x3cfd, /* lvrefslice */ 0x1f7c, 0x0003, /* pushdefer */ - 0x57d0, 0x5728, 0x0003, /* refaddr, reftype, ceil, floor */ + 0x5950, 0x58a8, 0x0003, /* refaddr, reftype, ceil, floor */ 0x131c, 0x0003, /* helemexistsor */ - 0x301c, 0x0003, /* methstart */ + 0x301c, 0x4fd8, 0x0003, /* methstart */ 0x3308, 0x3164, 0x0003, /* initfield */ }; @@ -3561,7 +3563,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* FLOOR */ (OPpARG1_MASK|OPpENTERSUB_HASTARG|OPpTARGET_MY), /* IS_TAINTED */ (OPpARG1_MASK), /* HELEMEXISTSOR */ (OPpARG1_MASK|OPpHELEMEXISTSOR_DELETE), - /* METHSTART */ (OPpARG1_MASK|OPpINITFIELDS), + /* METHSTART */ (OPpARG1_MASK|OPpSELF_IN_PAD|OPpINITFIELDS), /* INITFIELD */ (OPpARG1_MASK|OPpINITFIELD_AV|OPpINITFIELD_HV), /* CLASSNAME */ (0), diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 855bfe34da52..387779f68578 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -37,6 +37,17 @@ here, but most should go in the L section. [ List each enhancement as a =head2 entry ] +=head2 Reported argument counts in C signatures now account for C<$self> + +In previous versions of Perl, the exception message thrown by a C +subroutine with a signature when it does not receive an appropriate number of +arguments to match its declared parameters failed to account for the implied +C<$self> parameter, causing the numbers in the message to be 1 fewer than +intended. + +This has now been fixed, so messages report the correct number of arguments +including the object invocant. + =head1 Security XXX Any security-related notices go here. In particular, any security diff --git a/proto.h b/proto.h index 138d33b2b112..83e9052b9500 100644 --- a/proto.h +++ b/proto.h @@ -4445,6 +4445,12 @@ Perl_sub_crush_depth(pTHX_ CV *cv) #define PERL_ARGS_ASSERT_SUB_CRUSH_DEPTH \ assert(cv); assert(SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM) +PERL_CALLCONV void +Perl_subsignature_append_fence_op(pTHX_ OP *o) + __attribute__visibility__("hidden"); +#define PERL_ARGS_ASSERT_SUBSIGNATURE_APPEND_FENCE_OP \ + assert(o) + PERL_CALLCONV void Perl_subsignature_append_positional(pTHX_ PADOFFSET padix, OPCODE defmode, OP *defexpr) __attribute__visibility__("hidden"); diff --git a/regen/op_private b/regen/op_private index a08986a38426..b8cff44dbaa5 100644 --- a/regen/op_private +++ b/regen/op_private @@ -930,7 +930,8 @@ addbits('helemexistsor', ); addbits('methstart', - 7 => qw(OPpINITFIELDS INITFIELDS), + 7 => qw(OPpINITFIELDS INITFIELDS), + 6 => qw(OPpSELF_IN_PAD SELF_IN_PAD), # $self has already been set up in pad ); addbits('initfield', diff --git a/t/class/accessor.t b/t/class/accessor.t index 979d3e1c7a01..97b37941d941 100644 --- a/t/class/accessor.t +++ b/t/class/accessor.t @@ -33,7 +33,7 @@ no warnings 'experimental::class'; # Read accessor does not permit arguments ok(!eval { $o->s("value") }, 'Reader accessor fails with argument'); - like($@, qr/^Too many arguments for subroutine \'Testcase1::s\' \(got 1; expected 0\) at /, + like($@, qr/^Too many arguments for subroutine \'Testcase1::s\' \(got 2; expected 1\) at /, 'Failure from argument to accessor'); } @@ -51,11 +51,11 @@ no warnings 'experimental::class'; # Write accessor wants exactly one argument ok(!eval { $o->set_s() }, 'Reader accessor fails with no argument'); - like($@, qr/^Too few arguments for subroutine \'Testcase2::set_s\' \(got 0; expected 1\) at /, + like($@, qr/^Too few arguments for subroutine \'Testcase2::set_s\' \(got 1; expected 2\) at /, 'Failure from argument to accessor'); ok(!eval { $o->set_s(1, 2) }, 'Reader accessor fails with 2 arguments'); - like($@, qr/^Too many arguments for subroutine \'Testcase2::set_s\' \(got 2; expected 1\) at /, + like($@, qr/^Too many arguments for subroutine \'Testcase2::set_s\' \(got 3; expected 2\) at /, 'Failure from argument to accessor'); } diff --git a/t/class/method.t b/t/class/method.t index 58e4f6487cde..6ae57b4af7a7 100644 --- a/t/class/method.t +++ b/t/class/method.t @@ -21,7 +21,7 @@ no warnings 'experimental::class'; is($obj->retself, $obj, '$self inside method'); } -# methods have signatures; signatures do not capture $self +# methods have signatures { # Turn off the 'signatures' feature to prove that 'method' is always # signatured even without it @@ -34,6 +34,11 @@ no warnings 'experimental::class'; my $obj = Testcase2->new; is($obj->retfirst, 123, 'method signature params work'); is($obj->retfirst(456), 456, 'method signature params skip $self'); + + # argument counts take account of implicit $self + my $e = eval { $obj->retfirst(1, 2) } ? undef : $@; + like($e, qr/^Too many arguments for subroutine 'Testcase2::retfirst' \(got 3; expected at most 2\) /, + 'method signature fails with too many arguments'); } # methods can still capture regular package lexicals