From c3f71805f75e9ca5f3008d66de5cfd4afb514300 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Wed, 6 Aug 2025 11:56:53 +0100 Subject: [PATCH 1/3] Define OPpSELF_IN_PAD private flag to OP_METHSTART This flag indicates that `$self` argument handling has already been performed by the subroutine signature, so it should find the value already in the pad. --- class.c | 27 ++++++++----- lib/B/Op_private.pm | 5 ++- opcode.h | 94 +++++++++++++++++++++++---------------------- regen/op_private | 3 +- 4 files changed, 72 insertions(+), 57 deletions(-) diff --git a/class.c b/class.c index 9d5f17ae8ae4..7d9cd3d7a87e 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); 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/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/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', From 6bd9017738f8ea7063ef1e0f845db05bc813b8f5 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 12 May 2025 15:48:04 +0100 Subject: [PATCH 2/3] Add a subsignature_append_fence_op() A "fence op" is a miscellaneous op fragment that performs some work for side-effects during processing of a subroutine signature. In terms of timing, it will run at some time after any previously-defined arguments have been assigned from argument values passed in by the caller, but before any defaulting expressions for parameters that come after it are run. We specifically make no guarantees about whether parameters defined after this op have had their values assigned, nor whether defaulting expressions of earlier parameters have already been invoked. This is intentional because upcoming changes will change the order of these. The intention here is that method subroutines will use a fence op for the `OP_METHSTART` behaviour, ensuring that subsequent defaulting expressions can see the values of field bindings established by processing the `$self` parameter. --- embed.fnc | 2 ++ embed.h | 1 + op.c | 20 +++++++++++++++++++- proto.h | 6 ++++++ 4 files changed, 28 insertions(+), 1 deletion(-) 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/op.c b/op.c index 1630393ab0d2..6c10948d566e 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 @@ -16518,6 +16518,24 @@ Perl_subsignature_start(pTHX) PL_parser->signature = signature; } +/* 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 * subroutine params. `padix` may be zero, but if not it must be the pad * index of a scalar pad lexical to store the incoming argument value into. 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"); From c442984ee9b8c1059c021636aa01ce949c51e2ff Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Sat, 9 Aug 2025 16:24:27 +0100 Subject: [PATCH 3/3] Process `$self` in method subs as a subsignature parameter This has at least three advantages: * Removes more special-case code from `class.c` and makes generated optrees more similar to others * Ensures that no other ops appear in the optree before signature handling (as the OP_METHSTART used to). This will be useful for upcoming faster-signatures changes * Corrects the previous "off-by-one" error in parameter counts as reported by the argument count check exception messages --- class.c | 42 +++++++++++++++++++++++++++++++++++++----- lib/B/Deparse.pm | 13 +++++++++---- op.c | 12 ++++++++++++ pod/perldelta.pod | 11 +++++++++++ t/class/accessor.t | 6 +++--- t/class/method.t | 7 ++++++- 6 files changed, 78 insertions(+), 13 deletions(-) diff --git a/class.c b/class.c index 7d9cd3d7a87e..9b27be6f2d9a 100644 --- a/class.c +++ b/class.c @@ -953,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) { @@ -1010,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; } @@ -1108,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); @@ -1175,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/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/op.c b/op.c index 6c10948d566e..0e86a2aba2fe 100644 --- a/op.c +++ b/op.c @@ -16516,6 +16516,18 @@ 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- 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/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