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 15a4af6..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.12;
+$VERSION = 1.14;
 $header = "perl5db.pl version $VERSION";
 
 #
@@ -252,7 +252,8 @@ $header = "perl5db.pl version $VERSION";
 # Changes: 1.12: May 24, 2001  Daniel Lewart <d-lewart@uiuc.edu>
 #   + Fixed warnings generated by "O" (Show debugger options)
 #   + Fixed warnings generated by "p 42" (Print expression)
-
+# Changes: 1.13: Jun 19, 2001 Scott.L.Miller@compaq.com
+#   + Added windowSize option 
 ####################################################################
 
 # Needed for the statement after exec():
@@ -290,7 +291,7 @@ $inhibit_exit = $option{PrintRet} = 1;
                  recallCommand ShellBang pager tkRunning ornaments
                  signalLevel warnLevel dieLevel inhibit_exit
                  ImmediateStop bareStringify CreateTTY
-                 RemotePort);
+                 RemotePort windowSize);
 
 %optionVars    = (
                 hashDepth      => \$dumpvar::hashDepth,
@@ -310,6 +311,7 @@ $inhibit_exit = $option{PrintRet} = 1;
                 maxTraceLen    => \$maxtrace,
                 ImmediateStop  => \$ImmediateStop,
                 RemotePort     => \$remoteport,
+                windowSize     => \$window,
 );
 
 %optionAction  = (
@@ -340,8 +342,8 @@ $inhibit_exit = $option{PrintRet} = 1;
 
 # These guys may be defined in $ENV{PERL5DB} :
 $rl            = 1     unless defined $rl;
-$warnLevel     = 0     unless defined $warnLevel;
-$dieLevel      = 0     unless defined $dieLevel;
+$warnLevel     = 1     unless defined $warnLevel;
+$dieLevel      = 1     unless defined $dieLevel;
 $signalLevel   = 1     unless defined $signalLevel;
 $pre           = []    unless defined $pre;
 $post          = []    unless defined $post;
@@ -502,6 +504,10 @@ if ($notty) {
     $console = undef;
   }
 
+  if ($^O eq 'NetWare') {
+       $console = undef;
+  }
+
   # Around a bug:
   if (defined $ENV{OS2_SHELL} and ($slave_editor or $ENV{WINDOWID})) { # In OS/2
     $console = undef;
@@ -715,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; };
@@ -883,6 +889,7 @@ EOP
                            $i = $end;
                        } else {
                            for (; $i <= $end; $i++) {
+                               my ($stop,$action);
                                ($stop,$action) = split(/\0/, $dbline{$i}) if
                                    $dbline{$i};
                                $arrow = ($i==$line 
@@ -1219,7 +1226,7 @@ EOP
                          *dbline = $main::{'_<' . $file};
                          next unless %dbline or $postponed_file{$file};
                          (push @hard, $file), next 
-                           if $file =~ /^\(eval \d+\)$/;
+                           if $file =~ /^\(\w*eval/;
                          my @add;
                          @add = %{$postponed_file{$file}}
                            if $postponed_file{$file};
@@ -1426,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");
@@ -2098,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;
@@ -2142,7 +2162,7 @@ sub parse_options {
     # too dangerous to let intuitive usage overwrite important things
     # defaultion should never be the default
     my %opt_needs_val = map { ( $_ => 1 ) } qw{
-        arrayDepth hashDepth LineInfo maxTraceLen ornaments
+        arrayDepth hashDepth LineInfo maxTraceLen ornaments windowSize
         pager quote ReadLine recallCommand RemotePort ShellBang TTY
     };
     while (length) {
@@ -2480,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.
@@ -2675,7 +2696,8 @@ sub dbdie {
   if ($dieLevel < 2) {
     die @_ if $^S;             # in eval propagate
   }
-  eval { require Carp } if defined $^S;        # If error/warning during compilation,
+  # No need to check $^S, eval is much more robust nowadays
+  eval { require Carp }; #if defined $^S;# If error/warning during compilation,
                                        # require may be broken.
 
   die(@_, "\nCannot print stack trace, load with -MCarp option to see stack")
@@ -2685,7 +2707,13 @@ sub dbdie {
   # inside DB::DB, but not in Carp).
   my ($mysingle,$mytrace) = ($single,$trace);
   $single = 0; $trace = 0;
-  my $mess = Carp::longmess(@_);
+  my $mess = "@_";
+  { 
+    package Carp;              # Do not include us in the list
+    eval {
+      $mess = Carp::longmess(@_);
+    };
+  }
   ($single,$trace) = ($mysingle,$mytrace);
   die $mess;
 }
@@ -2801,7 +2829,7 @@ sub methods_via {
 }
 
 sub setman { 
-    $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS)\z/s
+    $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS|NetWare)\z/s
                ? "man"             # O Happy Day!
                : "perldoc";        # Alas, poor unfortunates
 }
@@ -2980,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;