From: Bram <p5p@perl.wizbit.be>
Date: Sat, 25 Jul 2009 14:26:45 +0000 (+0200)
Subject: Do not use a regex in DB::sub
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b7bfa855cd96849c1ce8b7e9624b69c94149aacc;p=p5sagit%2Fp5-mst-13.2.git

Do not use a regex in DB::sub
---

diff --git a/MANIFEST b/MANIFEST
index f26ec98..90f1156 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2807,6 +2807,7 @@ lib/perl5db/t/eval-line-bug	Tests for the Perl debugger
 lib/perl5db/t/lvalue-bug	Tests for the Perl debugger
 lib/perl5db/t/proxy-constants	Tests for the Perl debugger
 lib/perl5db/t/rt-61222		Tests for the Perl debugger
+lib/perl5db/t/rt-66110		Tests for the Perl debugger
 lib/perl5db/t/symbol-table-bug	Tests for the Perl debugger
 lib/PerlIO.pm			PerlIO support module
 lib/PerlIO/via/QuotedPrint.pm	PerlIO::via::QuotedPrint
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 03ef2a2..33bbc47 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -3639,6 +3639,8 @@ arguments with which the subroutine was invoked
 =cut
 
 sub sub {
+	# Do not use a regex in this subroutine -> results in corrupted memory
+	# See: [perl #66110]
 
 	# lock ourselves under threads
 	lock($DBGR);
@@ -3647,7 +3649,7 @@ sub sub {
     # sub's return value in (if needed), and an array to put the sub's
     # return value in (if needed).
     my ( $al, $ret, @ret ) = "";
-	if ($sub =~ /^threads::new$/ && $ENV{PERL5DB_THREADED}) {
+	if ($sub eq 'threads::new' && $ENV{PERL5DB_THREADED}) {
 		print "creating new thread\n"; 
 	}
 
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 6e57c9f..59acd7a 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -27,7 +27,7 @@ my $dev_tty = '/dev/tty';
     }
 }
 
-plan(7);
+plan(8);
 
 sub rc {
     open RC, ">", ".perldb" or die $!;
@@ -160,6 +160,14 @@ SKIP: {
 }
 
 
+# [perl #66110] Call a subroutine inside a regex
+{
+    local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
+    my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-66110');
+    like($output, "All tests successful.", "[perl #66110]");
+}
+
+
 # clean up.
 
 END {
diff --git a/lib/perl5db/t/rt-66110 b/lib/perl5db/t/rt-66110
new file mode 100644
index 0000000..7ba6c36
--- /dev/null
+++ b/lib/perl5db/t/rt-66110
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+#
+# This code is used by lib/perl5db.t !!!
+#
+
+$all_ok = 1;
+*c = sub { };
+
+if ("abcdefghi" =~ m/(abc)(def)(?{ c() })(ghi)/) {
+  print "ok 1\n";
+
+  $all_ok = 0, print "not " if $1 ne 'abc';
+  print "ok 2\n";
+
+  $all_ok = 0, print "not " if $2 ne 'def';
+  print "ok 3\n";
+
+  $all_ok = 0, print "not " if $3 ne 'ghi';
+  print "ok 4\n";
+
+  $all_ok = 0, print "not " if $& ne 'abcdefghi';
+  print "ok 5\n";
+}
+else {
+  $all_ok = 0;
+  print "not ok 1\n";
+  print "not ok 2\n";
+  print "not ok 3\n";
+  print "not ok 4\n";
+  print "not ok 5\n";
+}
+
+if ($all_ok) {
+  print "All tests successful.";
+}
+