Do not use a regex in DB::sub

diff --git a/MANIFEST b/MANIFEST
index f26ec98..90f1156 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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.";
+}
+