Mention variable names in @a =~ // warnings

diff --git a/op.c b/op.c
index 490af8a..6a6fa87 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2558,11 +2558,26 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
                       || rtype == OP_TRANSR
                       )
                       ? (int)rtype : OP_MATCH];
-      const char * const sample = ((ltype == OP_RV2AV || ltype == OP_PADAV)
+      const bool isary = ltype == OP_RV2AV || ltype == OP_PADAV;
+      GV *gv;
+      SV * const name =
+       (ltype == OP_RV2AV || ltype == OP_RV2HV)
+        ?    cUNOPx(left)->op_first->op_type == OP_GV
+          && (gv = cGVOPx_gv(cUNOPx(left)->op_first))
+              ? varname(gv, isary ? '@' : '%', 0, NULL, 0, 1)
+              : NULL
+        : varname(NULL, isary ? '@' : '%', left->op_targ, NULL, 0, 1);
+      if (name)
+       Perl_warner(aTHX_ packWARN(WARN_MISC),
+             "Applying %s to %"SVf" will act on scalar(%"SVf")",
+             desc, name, name);
+      else {
+       const char * const sample = (isary
             ? "@array" : "%hash");
-      Perl_warner(aTHX_ packWARN(WARN_MISC),
+       Perl_warner(aTHX_ packWARN(WARN_MISC),
              "Applying %s to %s will act on scalar(%s)",
              desc, sample, sample);
+      }
     }
 
     if (rtype == OP_CONST &&

diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index f737bf9..1a1bb26 100644 (file)
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -562,19 +562,19 @@ Useless use of a constant (undef) in void context at - line 9.
 use warnings 'misc' ;
 my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;my $d = 'test';
 @a =~ /abc/ ;
-@a =~ s/a/b/ ;
-@a =~ tr/a/b/ ;
+@a2 =~ s/a/b/ ;
+@a3 =~ tr/a/b/ ;
 @$b =~ /abc/ ;
 @$b =~ s/a/b/ ;
 @$b =~ tr/a/b/ ;
 %a =~ /abc/ ;
-%a =~ s/a/b/ ;
-%a =~ tr/a/b/ ;
+%a2 =~ s/a/b/ ;
+%a3 =~ tr/a/b/ ;
 %$c =~ /abc/ ;
 %$c =~ s/a/b/ ;
 %$c =~ tr/a/b/ ;
 $d =~ tr/a/b/d ;
-$d =~ tr/a/bc/;
+$d2 =~ tr/a/bc/;
 {
 no warnings 'misc' ;
 my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; my $d = 'test';
@@ -594,21 +594,21 @@ $d =~ tr/a/b/d ;
 $d =~ tr/a/bc/ ;
 }
 EXPECT
-Applying pattern match (m//) to @array will act on scalar(@array) at - line 5.
-Applying substitution (s///) to @array will act on scalar(@array) at - line 6.
-Applying transliteration (tr///) to @array will act on scalar(@array) at - line 7.
+Applying pattern match (m//) to @a will act on scalar(@a) at - line 5.
+Applying substitution (s///) to @a2 will act on scalar(@a2) at - line 6.
+Applying transliteration (tr///) to @a3 will act on scalar(@a3) at - line 7.
 Applying pattern match (m//) to @array will act on scalar(@array) at - line 8.
 Applying substitution (s///) to @array will act on scalar(@array) at - line 9.
 Applying transliteration (tr///) to @array will act on scalar(@array) at - line 10.
-Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 11.
-Applying substitution (s///) to %hash will act on scalar(%hash) at - line 12.
-Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 13.
+Applying pattern match (m//) to %a will act on scalar(%a) at - line 11.
+Applying substitution (s///) to %a2 will act on scalar(%a2) at - line 12.
+Applying transliteration (tr///) to %a3 will act on scalar(%a3) at - line 13.
 Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14.
 Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15.
 Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
 Useless use of /d modifier in transliteration operator at - line 17.
 Replacement list is longer than search list at - line 18.
-Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;"
+Can't modify array dereference in substitution (s///) at - line 6, near "s/a/b/ ;"
 BEGIN not safe after errors--compilation aborted at - line 20.
 ########
 # op.c