Math::Big* test tweaks to work better with core:

[perl5.git] / lib / perl5db.pl

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index ab9c48d..aab1a68 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.13;
+$VERSION = 1.14;
 $header = "perl5db.pl version $VERSION";
 
 #
@@ -721,7 +721,7 @@ EOP
                            next CMD;
                        } 
                    }
-                   $cmd =~ /^q$/ && ($fall_off_end = 1) && exit $?;
+                   $cmd =~ /^q$/ && ($fall_off_end = 1) && clean_ENV() && exit $?;
                    $cmd =~ /^h$/ && do {
                        print_help($help);
                        next CMD; };
@@ -1433,6 +1433,14 @@ EOP
                            } 
                        }
                        next CMD; };
+                   $cmd =~ /^\@\s*(.*\S)/ && do {
+                     if (open my $fh, $1) {
+                       push @cmdfhs, $fh;
+                     }
+                     else {
+                       &warn("Can't execute `$1': $!\n");
+                     }
+                     next CMD; };
                    $cmd =~ /^\|\|?\s*[^|]/ && do {
                        if ($pager =~ /^\|/) {
                            open(SAVEOUT,">&STDOUT") || &warn("Can't save STDOUT");
@@ -2105,6 +2113,11 @@ sub readline {
   }
   local $frame = 0;
   local $doret = -2;
+  while (@cmdfhs) {
+    my $line = CORE::readline($cmdfhs[-1]);
+    defined $line ? (print $OUT ">> $line" and return $line)
+                  : close pop @cmdfhs;
+  }
   if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) {
     $OUT->write(join('', @_));
     my $stuff;
@@ -2487,6 +2500,7 @@ B<$psh$psh> I<cmd>        Run cmd in a subprocess (reads from DB::IN, writes to DB::O
   . ( $rc eq $sh ? "" : "
 B<$psh> [I<cmd>]       Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
                See 'B<O> I<shellBang>' too.
+B<@>I<file>            Execute I<file> containing debugger commands (may nest).
 B<H> I<-number>        Display last number commands (default all).
 B<p> I<expr>           Same as \"I<print {DB::OUT} expr>\" in current package.
 B<|>I<dbcmd>           Run debugger command, piping DB::OUT to current pager.
@@ -2994,6 +3008,14 @@ sub end_report {
   print $OUT "Use `q' to quit or `R' to restart.  `h q' for details.\n"
 }
 
+sub clean_ENV {
+    if (defined($ini_pids)) {
+        $ENV{PERLDB_PIDS} = $ini_pids;
+    } else {
+        delete($ENV{PERLDB_PIDS});
+    }
+}
+
 END {
   $finished = 1 if $inhibit_exit;      # So that some keys may be disabled.
   $fall_off_end = 1 unless $inhibit_exit;