=== modified file 'hax/perl-additions.c.inc'
--- old/hax/perl-additions.c.inc 2020-04-23 16:49:20 +0000
+++ new/hax/perl-additions.c.inc 2020-04-27 01:14:50 +0000
@@ -4,6 +4,12 @@
# define av_count(av) (av_top_index(av) + 1)
#endif
+#if HAVE_PERL_VERSION(5, 22, 0)
+# define PadnameIsNULL(pn) (!(pn))
+#else
+# define PadnameIsNULL(pn) (!(pn) || (pn) == &PL_sv_undef)
+#endif
+
#define save_strndup(s, l) S_save_strndup(aTHX_ s, l)
static char *S_save_strndup(pTHX_ char *s, STRLEN l)
{
=== modified file 'lib/Object/Pad.xs'
--- old/lib/Object/Pad.xs 2020-04-25 12:47:34 +0000
+++ new/lib/Object/Pad.xs 2020-04-27 01:15:19 +0000
@@ -159,6 +159,26 @@
return GvAV(*gvp);
}
+#define find_cop_for_lvintro(padix, o, copp) S_find_cop_for_lvintro(aTHX_ padix, o, copp)
+static COP *S_find_cop_for_lvintro(pTHX_ PADOFFSET padix, OP *o, COP **copp)
+{
+ for( ; o; o = OpSIBLING(o)) {
+ if(OP_CLASS(o) == OA_COP) {
+ *copp = (COP *)o;
+ }
+ else if(o->op_type == OP_PADSV && o->op_targ == padix && o->op_private & OPpLVAL_INTRO) {
+ return *copp;
+ }
+ else if(o->op_flags & OPf_KIDS) {
+ COP *ret = find_cop_for_lvintro(padix, cUNOPx(o)->op_first, copp);
+ if(ret)
+ return ret;
+ }
+ }
+
+ return NULL;
+}
+
/*********************************
* Class and Slot Implementation *
*********************************/
@@ -1219,6 +1239,30 @@
if(repr == REPR_AUTOSELECT && !compclassmeta->foreign_new)
repr = REPR_NATIVE;
+ {
+ ENTER;
+ SAVEVPTR(PL_curcop);
+
+ /* See
https://rt.cpan.org/Ticket/Display.html?id=132428
+ *
https://github.com/Perl/perl5/issues/17754
+ */
+ PADOFFSET padix;
+ for(padix = PADIX_SELF + 1; padix <= PadnamelistMAX(PadlistNAMES(CvPADLIST(PL_compcv))); padix++) {
+ PADNAME *pn = padnames[padix];
+ if(PadnameIsNULL(pn) || !PadnameLEN(pn))
+ continue;
+ if(!strEQ(PadnamePV(pn), "$self"))
+ continue;
+
+ COP *padcop = NULL;
+ if(find_cop_for_lvintro(padix, ctx->body, &padcop))
+ PL_curcop = padcop;
+ warn("\"my\" variable $self masks earlier declaration in same scope");
+ }
+
+ LEAVE;
+ }
+
slotops = op_append_list(OP_LINESEQ, slotops,
newSTATEOP(0, NULL, NULL));
slotops = op_append_list(OP_LINESEQ, slotops,
@@ -1277,10 +1321,7 @@
PADOFFSET padix;
for(padix = 1; padix <= PadnamelistMAX(pnl); padix++) {
PADNAME *pn = PadnamelistARRAY(pnl)[padix];
- if(!pn ||
-#if !HAVE_PERL_VERSION(5, 22, 0)
- pn == &PL_sv_undef ||
-#endif
+ if(PadnameIsNULL(pn) ||
!PadnameOUTER(pn) ||
!PARENT_PAD_INDEX(pn))
continue;
=== modified file 't/01method.t'
--- old/t/01method.t 2020-04-16 20:40:18 +0000
+++ new/t/01method.t 2020-04-27 01:08:11 +0000
@@ -56,4 +56,26 @@
is( $obj->value, 123, '$obj->value from BUILD-generated anon method' );
}
+# method warns about redeclared $self (RT132428)
+{
+ class RT132428 {
+ BEGIN {
+ my $warnings = "";
+ local $SIG{__WARN__} = sub { $warnings .= join "", @_; };
+
+ ::ok( defined eval <<'EOPERL',
+ method test {
+ my $self = shift;
+ }
+ 1;
+EOPERL
+ 'method compiles OK' );
+
+ ::like( $warnings,
+ qr/^"my" variable \$self masks earlier declaration in same scope at \(eval \d+\) line 2\./,
+ 'warning from redeclared $self comes from correct line' );
+ }
+ }
+}
+
done_testing;
