Re: [PATCH] 5.004_04 or 5.004_64: Benchmark.pm: add run-for-some-time

[perl5.git] / lib / perl5db.pl

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index f0774bc..3ca0adc 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -178,7 +178,8 @@ $inhibit_exit = $option{PrintRet} = 1;
                  globPrint PrintRet UsageOnly frame AutoTrace
                  TTY noTTY ReadLine NonStop LineInfo maxTraceLen
                  recallCommand ShellBang pager tkRunning ornaments
-                 signalLevel warnLevel dieLevel inhibit_exit);
+                 signalLevel warnLevel dieLevel inhibit_exit
+                 ImmediateStop);
 
 %optionVars    = (
                 hashDepth      => \$dumpvar::hashDepth,
@@ -194,6 +195,7 @@ $inhibit_exit = $option{PrintRet} = 1;
                 AutoTrace      => \$trace,
                 inhibit_exit   => \$inhibit_exit,
                 maxTraceLen    => \$maxtrace,
+                ImmediateStop  => \$ImmediateStop,
 );
 
 %optionAction  = (
@@ -363,6 +365,9 @@ sub DB {
        }
        $single = 0;
        # return;                       # Would not print trace!
+      } elsif ($ImmediateStop) {
+       $ImmediateStop = 0;
+       $signal = 1;
       }
     }
     $runnonstop = 0 if $single or $signal; # Disable it if interactive.
@@ -390,9 +395,9 @@ sub DB {
        if ($val ne $old_watch[$n]) {
          $signal = 1;
          print $OUT <<EOP;
-Watchpoint $n: $to_watch[$n] changed:
-old value: $old_watch[$n]
-new value: $val
+Watchpoint $n:\t$to_watch[$n] changed:
+    old value:\t$old_watch[$n]
+    new value:\t$val
 EOP
          $old_watch[$n] = $val;
        }
@@ -409,6 +414,15 @@ EOP
        if ($emacs) {
            $position = "\032\032$filename:$line:0\n";
            print $LINEINFO $position;
+       } elsif ($package eq 'DB::fake') {
+         print_help(<<EOP);
+Debugged program terminated.  Use B<q> to quit or B<R> to restart,
+  use B<O> I<inhibit_exit> to avoid stopping after program termination,
+  B<h q>, B<h R> or B<h O> to get additional info.  
+EOP
+         $package = 'main';
+         $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
+           "package $package;";        # this won't let them modify, alas
        } else {
            $sub =~ s/\'/::/;
            $prefix = $sub =~ /::/ ? "" : "${'package'}::";
@@ -1246,6 +1260,10 @@ sub postponed_sub {
 }
 
 sub postponed {
+  if ($ImmediateStop) {
+    $ImmediateStop = 0;
+    $signal = 1;
+  }
   return &postponed_sub
     unless ref \$_[0] eq 'GLOB'; # A subroutine is compiled.
   # Cannot be done before the file is compiled
@@ -1386,7 +1404,7 @@ sub system {
     # We save, change, then restore STDIN and STDOUT to avoid fork() since
     # many non-Unix systems can do system() but have problems with fork().
     open(SAVEIN,"<&STDIN") || &warn("Can't save STDIN");
-    open(SAVEOUT,">&OUT") || &warn("Can't save STDOUT");
+    open(SAVEOUT,">&STDOUT") || &warn("Can't save STDOUT");
     open(STDIN,"<&IN") || &warn("Can't redirect STDIN");
     open(STDOUT,">&OUT") || &warn("Can't redirect STDOUT");
     system(@_);
@@ -1461,8 +1479,14 @@ sub resetterm {                  # We forked, so we need a different TTY
       TTY($fork_TTY);
       undef $fork_TTY;
     } else {
-      print $OUT "Forked, but do not know how to change a TTY.\n",
-          "Define \$DB::fork_TTY or get_fork_TTY().\n";
+      print_help(<<EOP);
+I<#########> Forked, but do not know how to change a B<TTY>. I<#########>
+  Define B<\$DB::fork_TTY> 
+       - or a function B<DB::get_fork_TTY()> which will set B<\$DB::fork_TTY>.
+  The value of B<\$DB::fork_TTY> should be the name of I<TTY> to use.
+  On I<UNIX>-like systems one can get the name of a I<TTY> for the given window
+  by typing B<tty>, and disconnect the I<shell> from I<TTY> by B<sleep 1000000>.
+EOP
     }
 }
 
@@ -1780,6 +1804,7 @@ B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]...
     I<tkRunning>:                      run Tk while prompting (with ReadLine);
     I<signalLevel> I<warnLevel> I<dieLevel>:   level of verbosity;
     I<inhibit_exit>            Allows stepping off the end of the script.
+    I<ImmediateStop>           Debugger should stop as early as possible.
   The following options affect what happens with B<V>, B<X>, and B<x> commands:
     I<arrayDepth>, I<hashDepth>:       print only first N elements ('' for all);
     I<compactDump>, I<veryCompact>:    change style of array and hash dump;
@@ -1824,7 +1849,7 @@ B<R>              Pure-man-restart of debugger, some of debugger state
                and the following command-line options: I<-w>, I<-I>, I<-e>.
 B<h> [I<db_command>]   Get help [on a specific debugger command], enter B<|h> to page.
 B<h h>         Summary of debugger commands.
-B<q> or B<^D>          Quit. Set \$DB::finished to 0 to debug global destruction.
+B<q> or B<^D>          Quit. Set B<\$DB::finished = 0> to debug global destruction.
 
 ";
     $summary = <<"END_SUM";