Skip to content

Commit

Permalink
Quiet the warning about field shadowing when it's about same-named fi…
Browse files Browse the repository at this point in the history
…elds of another (unit) class that happens to be in the same scope
  • Loading branch information
leonerd committed Aug 27, 2022
1 parent bc0f93b commit 6f74f5c
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 2 deletions.
8 changes: 6 additions & 2 deletions pad.c
Original file line number Diff line number Diff line change
Expand Up @@ -617,7 +617,7 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
ENTER;
SAVEFREEPADNAME(name); /* in case of fatal warnings */
/* check for duplicate declaration */
pad_check_dup(name, flags & padadd_OUR, ourstash);
pad_check_dup(name, flags & (padadd_OUR|padadd_FIELD), ourstash);
PadnameREFCNT_inc(name);
LEAVE;
}
Expand Down Expand Up @@ -869,12 +869,13 @@ S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash)
PADNAME **svp;
PADOFFSET top, off;
const U32 is_our = flags & padadd_OUR;
bool is_field = flags & padadd_FIELD;

PERL_ARGS_ASSERT_PAD_CHECK_DUP;

ASSERT_CURPAD_ACTIVE("pad_check_dup");

assert((flags & ~padadd_OUR) == 0);
assert((flags & ~(padadd_OUR|padadd_FIELD)) == 0);

if (PadnamelistMAX(PL_comppad_name) < 0 || !ckWARN(WARN_SHADOW))
return; /* nothing to check */
Expand All @@ -893,6 +894,9 @@ S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash)
{
if (is_our && (PadnameIsOUR(pn)))
break; /* "our" masking "our" */
if (is_field && PadnameIsFIELD(pn) &&
PadnameFIELDINFO(pn)->fieldstash != PL_curstash)
break; /* field of a different class */
/* diag_listed_as: "%s" variable %s masks earlier declaration in same %s */
Perl_warner(aTHX_ packWARN(WARN_SHADOW),
"\"%s\" %s %" PNf " masks earlier declaration in same %s",
Expand Down
15 changes: 15 additions & 0 deletions t/class/field.t
Original file line number Diff line number Diff line change
Expand Up @@ -114,4 +114,19 @@ no warnings 'experimental::class';
is($obj->count, 3, '$obj->count after invoking method-closure x 3');
}

# fields of multiple unit classes are distinct
{
class Test6::A;
field $x; ADJUST { $x = "A" }
method m { return "unit-$x" }

class Test6::B;
field $x; ADJUST { $x = "B" }
method m { return "unit-$x" }

package main;
ok(eq_array([Test6::A->new->m, Test6::B->new->m], ["unit-A", "unit-B"]),
'Fields of multiple unit classes remain distinct');
}

done_testing;

0 comments on commit 6f74f5c

Please sign in to comment.