diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/perl5db.pl | 4 | ||||
| -rw-r--r-- | lib/perl5db.t | 10 | ||||
| -rw-r--r-- | lib/perl5db/t/rt-66110 | 36 |
3 files changed, 48 insertions, 2 deletions
diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 03ef2a2c6b..33bbc478ba 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 6e57c9f77c..59acd7a059 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 0000000000..7ba6c36d02 --- /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."; +} + |