This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don’t crash on @a =~ // warning
authorFather Chrysostomos <sprout@cpan.org>
Wed, 18 Jan 2012 04:33:28 +0000 (20:33 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 18 Jan 2012 04:33:28 +0000 (20:33 -0800)
This is similar to bug #106726, caused by 579333ee9e3 and fixed
by c6fb3f6.

This bug was caused by c6771ab63d, which had exactly the same mistake.
Attempting to use find_runcv at compile time to find a variable name
is not going to work in general.  It only works by accident some
of the time.

op.c
t/re/pat.t

diff --git a/op.c b/op.c
index a1f5d25..2b7bc37 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2535,7 +2535,9 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
           && (gv = cGVOPx_gv(cUNOPx(left)->op_first))
               ? varname(gv, isary ? '@' : '%', 0, NULL, 0, 1)
               : NULL
-        : varname(NULL, isary ? '@' : '%', left->op_targ, NULL, 0, 1);
+        : varname(
+           (GV *)PL_compcv, isary ? '@' : '%', left->op_targ, NULL, 0, 1
+          );
       if (name)
        Perl_warner(aTHX_ packWARN(WARN_MISC),
              "Applying %s to %"SVf" will act on scalar(%"SVf")",
index 54d44ac..7b03e41 100644 (file)
@@ -21,7 +21,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 464;  # Update this when adding/deleting tests.
+plan tests => 465;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1215,6 +1215,13 @@ EOP
         like("\xffb", qr/$pat/i, "/i: utf8 pattern, non-utf8 string, latin1-char preceding matching char in string");
     }
 
+    { # Crash with @a =~ // warning
+       local $SIG{__WARN__} = sub {
+             pass 'no crash for @a =~ // warning'
+        };
+       eval ' sub { my @a =~ // } ';
+    }
+
 } # End of sub run_tests
 
 1;