Permalink
Browse files

Perl bug #116358

  • Loading branch information...
1 parent 2a7196b commit a45169d68a3bf49c61c2324e7674e7d1cb86b0e8 Rocky Bernstein committed Jan 15, 2013
Showing with 48 additions and 6 deletions.
  1. +19 −0 example/lsub.pl
  2. +2 −1 lib/Devel/Trepan/DB/Backtrace.pm
  3. +2 −5 lib/Devel/Trepan/DB/Sub.pm
  4. +6 −0 t/20test-lsub.t
  5. +8 −0 t/data/lsub.cmd
  6. +11 −0 t/data/lsub.right
View
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+# From Chris Marshall perl #116358
+#
+# Illustrate lvalue sub debug problem
+# The n command steps into the lvalue sub
+#
+
+my $data = '';
+
+sub lslice :lvalue {
+ my ($arg1, $val1) = @_;
+ # print ".. in lslice now\n";
+ # print ".. $arg1 + $val1 = ", $arg1+$val1, "\n";
+ $data;
+}
+
+my $x = "Start test, \$data=$data\n";
+lslice(3,5) = 4;
+print "Stop test, \$data=$data\n";
@@ -91,9 +91,10 @@ sub backtrace($;$$$) {
# Up the stack frame index to go back one more level each time.
while ($i <= $count and
($pkg, $file, $line, $fn, $hasargs, $wantarray, $evaltext, $is_require) = caller($i)) {
- next if $pkg eq 'DB' && ($fn eq 'sub' || $fn eq 'lsub');
## print "++file: $file, line $line $fn\n" if $DB::DEBUGME;
$i++;
+ next if $pkg eq 'DB' && ($fn eq 'sub' || $fn eq 'lsub' ||
+ -1 != rindex($file, 'Devel/Trepan/DB/Sub.pm'));
# Go through the arguments and save them for later.
@a = ();
for my $arg (@DB::args) {
@@ -160,9 +160,6 @@ sub lsub : lvalue {
# make us stop with the 'deep recursion' message.
$DB::single |= DEEP_RECURSION_EVENT if $#stack == $deep;
- # Pop the single-step value back off the stack.
- $DB::single |= $stack[ $stack_depth-- ] if $stack[$stack_depth];
-
if (wantarray) {
# Called in array context. call sub and capture output.
# DB::DB will recursively get control again if appropriate; we'll come
@@ -171,7 +168,7 @@ sub lsub : lvalue {
# Pop the single-step value back off the stack.
$DB::single |= $stack[ $stack_depth-- ];
- if ($single & RETURN_EVENT) {
+ if ($DB::single & RETURN_EVENT) {
$DB::return_type = 'array';
@DB::return_value = @ret;
DB::DB($DB::sub) ;
@@ -190,7 +187,7 @@ sub lsub : lvalue {
# Pop the single-step value back off the stack.
$DB::single |= $stack[ $stack_depth-- ] if $stack[$stack_depth];
- if ($single & RETURN_EVENT) {
+ if ($DB::single & RETURN_EVENT) {
$DB::return_type = defined $ret ? 'scalar' : 'undef';
$DB::return_value = $ret;
DB::DB($DB::sub) ;
View
@@ -0,0 +1,6 @@
+#!/usr/bin/env perl
+use warnings; use strict;
+use rlib '.'; use Helper;
+
+run_debugger(prog_file('lsub.pl'));
+done_testing();
View
@@ -0,0 +1,8 @@
+# test of "info line"
+# use with example/lsub.pl
+set basename on
+n
+n
+n
+bt
+quit!
View
@@ -0,0 +1,11 @@
+-- main::(lsub.pl:8)
+my $data = '';
+basename is on.
+-- main::(lsub.pl:17)
+my $x = "Start test, \$data=$data\n";
+-- main::(lsub.pl:18)
+lslice(3,5) = 4;
+-- main::(lsub.pl:19)
+print "Stop test, \$data=$data\n";
+--> #0 file `lsub.pl' at line 19
+trepan.pl: That's all, folks...

0 comments on commit a45169d

Please sign in to comment.