Protect debugger from nonlocal exits

	Message-Id: <199808292138.RAA18359@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@1824

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 099a49b..1e5724f 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2,7 +2,7 @@ package DB;
 
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 
-$VERSION = 1.0401;
+$VERSION = 1.0402;
 $header = "perl5db.pl version $VERSION";
 
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
@@ -361,7 +361,7 @@ sub DB {
     # _After_ the perl program is compiled, $single is set to 1:
     if ($single and not $second_time++) {
       if ($runnonstop) {       # Disable until signal
-       for ($i=0; $i <= $#stack; ) {
+       for ($i=0; $i <= $stack_depth; ) {
            $stack[$i++] &= ~1;
        }
        $single = 0;
@@ -439,7 +439,7 @@ EOP
                $position = "$prefix$line$infix$dbline[$line]$after";
            }
            if ($frame) {
-               print $LINEINFO ' ' x $#stack, "$line:\t$dbline[$line]$after";
+               print $LINEINFO ' ' x $stack_depth, "$line:\t$dbline[$line]$after";
            } else {
                print $LINEINFO $position;
            }
@@ -450,7 +450,7 @@ EOP
                $incr_pos = "$prefix$i$infix$dbline[$i]$after";
                $position .= $incr_pos;
                if ($frame) {
-                   print $LINEINFO ' ' x $#stack, "$i:\t$dbline[$i]$after";
+                   print $LINEINFO ' ' x $stack_depth, "$i:\t$dbline[$i]$after";
                } else {
                    print $LINEINFO $incr_pos;
                }
@@ -463,7 +463,7 @@ EOP
        foreach $evalarg (@$pre) {
          &eval;
        }
-       print $OUT $#stack . " levels deep in subroutine calls!\n"
+       print $OUT $stack_depth . " levels deep in subroutine calls!\n"
          if $single & 4;
        $start = $line;
        $incr = -1;             # for backward motion.
@@ -879,14 +879,14 @@ EOP
                            }
                            $dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
                        }
-                       for ($i=0; $i <= $#stack; ) {
+                       for ($i=0; $i <= $stack_depth; ) {
                            $stack[$i++] &= ~1;
                        }
                        last CMD; };
                    $cmd =~ /^r$/ && do {
                        end_report(), next CMD if $finished and $level <= 1;
-                       $stack[$#stack] |= 1;
-                       $doret = $option{PrintRet} ? $#stack - 1 : -2;
+                       $stack[$stack_depth] |= 1;
+                       $doret = $option{PrintRet} ? $stack_depth - 1 : -2;
                        last CMD; };
                    $cmd =~ /^R$/ && do {
                        print $OUT "Warning: some settings and command-line options may be lost!\n";
@@ -1169,24 +1169,26 @@ sub sub {
     if (length($sub) > 10 && substr($sub, -10, 10) eq '::AUTOLOAD') {
        $al = " for $$sub";
     }
-    push(@stack, $single);
+    local $stack_depth = $stack_depth + 1; # Protect from non-local exits
+    $#stack = $stack_depth;
+    $stack[-1] = $single;
     $single &= 1;
-    $single |= 4 if $#stack == $deep;
+    $single |= 4 if $stack_depth == $deep;
     ($frame & 4 
-     ? ( (print $LINEINFO ' ' x ($#stack - 1), "in  "), 
+     ? ( (print $LINEINFO ' ' x ($stack_depth - 1), "in  "), 
         # Why -1? But it works! :-(
         print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
-     : print $LINEINFO ' ' x ($#stack - 1), "entering $sub$al\n") if $frame;
+     : print $LINEINFO ' ' x ($stack_depth - 1), "entering $sub$al\n") if $frame;
     if (wantarray) {
        @ret = &$sub;
-       $single |= pop(@stack);
+       $single |= $stack[$stack_depth--];
        ($frame & 4 
-        ? ( (print $LINEINFO ' ' x $#stack, "out "), 
+        ? ( (print $LINEINFO ' ' x $stack_depth, "out "), 
             print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
-        : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
-       if ($doret eq $#stack or $frame & 16) {
-            my $fh = ($doret eq $#stack ? $OUT : $LINEINFO);
-           print $fh ' ' x $#stack if $frame & 16;
+        : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2;
+       if ($doret eq $stack_depth or $frame & 16) {
+            my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
+           print $fh ' ' x $stack_depth if $frame & 16;
            print $fh "list context return from $sub:\n"; 
            dumpit($fh, \@ret );
            $doret = -2;
@@ -1198,14 +1200,14 @@ sub sub {
         } else {
             &$sub; undef $ret;
         };
-       $single |= pop(@stack);
+       $single |= $stack[$stack_depth--];
        ($frame & 4 
-        ? ( (print $LINEINFO ' ' x $#stack, "out "), 
+        ? ( (print $LINEINFO ' ' x $stack_depth, "out "), 
              print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
-        : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
-       if ($doret eq $#stack or $frame & 16 and defined wantarray) {
-            my $fh = ($doret eq $#stack ? $OUT : $LINEINFO);
-           print $fh (' ' x $#stack) if $frame & 16;
+        : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2;
+       if ($doret eq $stack_depth or $frame & 16 and defined wantarray) {
+            my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
+           print $fh (' ' x $stack_depth) if $frame & 16;
            print $fh (defined wantarray 
                         ? "scalar context return from $sub: " 
                         : "void context return from $sub\n");
@@ -1226,7 +1228,6 @@ sub save {
 sub eval {
     my @res;
     {
-       local (@stack) = @stack; # guard against recursive debugging
        my $otrace = $trace;
        my $osingle = $single;
        my $od = $^D;
@@ -1284,7 +1285,7 @@ sub postponed {
   $filename =~ s/^_<//;
   $signal = 1, print $OUT "'$filename' loaded...\n"
     if $break_on_load{$filename};
-  print $LINEINFO ' ' x $#stack, "Package $filename.\n" if $frame;
+  print $LINEINFO ' ' x $stack_depth, "Package $filename.\n" if $frame;
   return unless $postponed_file{$filename};
   $had_breakpoints{$filename}++;
   #%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
@@ -1432,7 +1433,6 @@ sub system {
 sub setterm {
     local $frame = 0;
     local $doret = -2;
-    local @stack = @stack;             # Prevent growth by failing `use'.
     eval { require Term::ReadLine } or die $@;
     if ($notty) {
        if ($tty) {
@@ -2073,6 +2073,7 @@ BEGIN {                   # This does not compile, alas.
   # @stack and $doret are needed in sub sub, which is called for DB::postponed.
   # Triggers bug (?) in perl is we postpone this until runtime:
   @postponed = @stack = (0);
+  $stack_depth = 0;            # Localized $#stack
   $doret = -2;
   $frame = 0;
 }