Add termination message. Add $Devel::Trepan::PROGRAM

rocky · Dec 8, 2012 · dc63e3f · dc63e3f
1 parent 87f4260
commit dc63e3f
Show file tree

Hide file tree

Showing 31 changed files with 51 additions and 11 deletions.
diff --git a/lib/Devel/Trepan.pm b/lib/Devel/Trepan.pm
@@ -9,7 +9,7 @@ use Devel::Trepan::Core;
 
 package Devel::Trepan;
 
-use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $TREPAN_CMDPROC);
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $TREPAN_CMDPROC $PROGRAM);
 use Exporter;
 
 @EXPORT = qw(debugger);
@@ -20,6 +20,7 @@ use constant PROGRAM => 'trepan.pl';
 use version; 
 $VERSION='0.45_01'; # To fool CPAN indexer. Is <= real version
 $VERSION = $Devel::Trepan::Version::VERSION;
+$PROGRAM = PROGRAM;
 
 sub show_version() {
     PROGRAM . ", version $Devel::Trepan::VERSION";

diff --git a/lib/Devel/Trepan/CmdProcessor.pm b/lib/Devel/Trepan/CmdProcessor.pm
@@ -119,9 +119,13 @@ sub compute_prompt($)
             '(' x $DB::level, $thread_str, ')' x $DB::level);
 }
 
-sub DESTROY($)
+sub terminated($)
 {
     my $self = shift;
+    $self->msg(sprintf("%sThat's all, folks...",
+		       (defined($Devel::Trepan::PROGRAM) ? 
+			"${Devel::Trepan::PROGRAM}: " : '')));
+
     # breakpoint_finalize
 }
 

diff --git a/lib/Devel/Trepan/CmdProcessor/Command/Quit.pm b/lib/Devel/Trepan/CmdProcessor/Command/Quit.pm
@@ -79,7 +79,8 @@ sub run($$)
     no warnings 'once';
     $DB::single = 0;
     $DB::fall_off_on_end = 1;
-    $self->{proc}->{interfaces} = [];
+    $proc->terminated();
+    $proc->{interfaces} = [];
     # No graceful way to stop threads...
     exit $exitrc;
 }

diff --git a/lib/Devel/Trepan/Interface/Script.pm b/lib/Devel/Trepan/Interface/Script.pm
@@ -104,6 +104,13 @@ sub msg($$)
 }
 
 sub is_interactive() { 0; }
+
+sub is_closed($) 
+{
+    my($self)  = shift;
+    $self->{input}->eof;
+}
+
 sub has_completion() { 0; }
 sub has_term_readline($) { 0; }
 

diff --git a/t/data/__FILE__.right b/t/data/__FILE__.right
@@ -4,3 +4,4 @@ die sprintf "Need two integer arguments, got %d", scalar(@ARGV) unless
 Eval result display style is dumper.
 $DB::D[0] = "gcd.pl"
 $DB::D[1] = 18
+trepan.pl: That's all, folks...
diff --git a/t/data/alias.right b/t/data/alias.right
@@ -30,3 +30,4 @@ Alias for upper removed.
   See also "down" and "frame".
 set auto eval is off.
 *** Undefined command: "upper". Try "help".
+trepan.pl: That's all, folks...
diff --git a/t/data/autolist.right b/t/data/autolist.right
@@ -39,3 +39,4 @@ set auto list is off.
     ($a, $b) = ($b, $a) if ($a > $b);
 -- main::(gcd.pl:13)
     return undef if $a <= 0;
+trepan.pl: That's all, folks...
diff --git a/t/data/break.right b/t/data/break.right
@@ -16,4 +16,5 @@ Possible breakpoint line numbers:
 Use 'info file XXX brkpts' to see breakpoints I know about
 *** Subroutine gcd1 not found.
 x1 main::(gcd.pl:9)
-    my ($a, $b) = @_;
+    my ($a, $b) = @_;
+trepan.pl: That's all, folks...
diff --git a/t/data/break2.right b/t/data/break2.right
@@ -16,4 +16,5 @@ No actions.
 No watch expressions defined.
 x1 TCPPack::(TCPPack.pm:34)
 unless (caller) {
-    my $buf = "Hi there!";
+    my $buf = "Hi there!";
+trepan.pl: That's all, folks...
diff --git a/t/data/cont.right b/t/data/cont.right
@@ -9,3 +9,4 @@ printf "The GCD of %d and %d is %d\n", $a, $b, gcd($a, $b);
     my ($a, $b) = @_;
 x1 main::(gcd.pl:9)
     my ($a, $b) = @_;
+trepan.pl: That's all, folks...
diff --git a/t/data/debug.right b/t/data/debug.right
@@ -54,4 +54,5 @@ $DB::D[7] = 1
 Leaving nested debug level 1
 -- main::(gcd.pl:18)
 die sprintf "Need two integer arguments, got %d", scalar(@ARGV) unless 
-    @ARGV == 2;
+    @ARGV == 2;
+trepan.pl: That's all, folks...
diff --git a/t/data/display.right b/t/data/display.right
@@ -13,3 +13,4 @@ Display 2 set
 2: 3 | 5
 -- main::(gcd.pl:9)
     my ($a, $b) = @_;
+trepan.pl: That's all, folks...
diff --git a/t/data/dollar0.right b/t/data/dollar0.right
@@ -4,3 +4,4 @@ die sprintf "Need two integer arguments, got %d", scalar(@ARGV) unless
 Eval result display style is dumper.
 $DB::D[0] = 0
 $DB::D[1] = "gcd.pl"
+trepan.pl: That's all, folks...
diff --git a/t/data/eval.right b/t/data/eval.right
@@ -50,4 +50,5 @@ $DB::D[11] =
 @{[
   '3',
   '5'
-  ]}
+  ]}
+trepan.pl: That's all, folks...
diff --git a/t/data/eval2.right b/t/data/eval2.right
@@ -49,4 +49,5 @@ $y = five();
 -- main::((eval 1955)[eval.pl:10]:3 remapped bogus.pl:3)
 --> #0 @ = main::five() in 
 	file `(eval 1000)[eval.pl:13]' at line 3
-    #1 file `eval.pl' at line 14
+    #1 file `eval.pl' at line 14
+trepan.pl: That's all, folks...
diff --git a/t/data/fin.right b/t/data/fin.right
@@ -6,3 +6,4 @@ x1 TCPPack::(TCPPack.pm:18)
     ($buf, $msg) = unpack_msg(pack_msg($buf));
 Return value for TCPPack::pack_msg is: 0009Hi there!
 *** Can't run finish while inside a return. Step and try again.
+trepan.pl: That's all, folks...
diff --git a/t/data/fin3.right b/t/data/fin3.right
@@ -13,3 +13,4 @@ printf "The GCD of %d and %d is %d\n", $a, $b, gcd($a, $b);
 Return array value for main::gcd is:
 1
 
+trepan.pl: That's all, folks...
diff --git a/t/data/line.right b/t/data/line.right
@@ -9,3 +9,4 @@ Line not showing as associated with code
 
 Expecting a line number or function; got a
 Function main::gcd in file gcd.pl lines 8..16
+trepan.pl: That's all, folks...
diff --git a/t/data/list1.right b/t/data/list1.right
@@ -45,3 +45,4 @@ test-require.pl [2-9]
   8    	
   9    	
 *** Bad line range [10...19]; file "test-require.pl" has only 9 lines
+trepan.pl: That's all, folks...
diff --git a/t/data/list2.right b/t/data/list2.right
@@ -45,3 +45,4 @@ test-require.pl [1-9]
   7 B02	my $y = $x;
   8    	
   9    	
+trepan.pl: That's all, folks...
diff --git a/t/data/list3.right b/t/data/list3.right
@@ -72,3 +72,4 @@ test-require.pl [1-9]
   7    	my $y = $x;
   8    	
   9    	
+trepan.pl: That's all, folks...
diff --git a/t/data/list4.right b/t/data/list4.right
@@ -41,3 +41,4 @@ gcd.pl [7-16]
  14    	    return $a if ($a == 1) or ($b-$a == 0);
  15    	    return gcd($b-$a, $a);
  16    	}
+trepan.pl: That's all, folks...
diff --git a/t/data/my.right b/t/data/my.right
@@ -28,3 +28,4 @@ $%h = {'food' => 'fight','1' => 'foo'};
 -- main::(my.pl:6)
     return $h;
 $h = {'food' => 'fight','1' => 'foo'}
+trepan.pl: That's all, folks...
diff --git a/t/data/next2.right b/t/data/next2.right
@@ -5,3 +5,4 @@ my $y=3;
 Eval result display style is dumper.
 $DB::D[0] = next2.pl
 $DB::D[1] = 1.0
+trepan.pl: That's all, folks...
diff --git a/t/data/opt-e.right b/t/data/opt-e.right
@@ -2,4 +2,5 @@
 no warnings "once";$x=1; $y=2
 -- (tempfile.pl:1)
 no warnings "once";$x=1; $y=2
-Debugged program terminated.  Use 'q' to quit or 'R' to restart.
+Debugged program terminated.  Use 'q' to quit or 'R' to restart.
+trepan.pl: That's all, folks...
diff --git a/t/data/sig2.right b/t/data/sig2.right
@@ -15,3 +15,4 @@ Program received signal HUP.
 -- main::(signal.pl:21)
     sleep 1;
 $DB::D[0] = 1
+trepan.pl: That's all, folks...
diff --git a/t/data/step.right b/t/data/step.right
@@ -11,3 +11,4 @@ $x=6; $y = p(); my $z = p();
 $x = 8;
 -- main::(nexting.pl:15)
 $x += $z;
+trepan.pl: That's all, folks...
diff --git a/t/data/trace2.right b/t/data/trace2.right
@@ -18,4 +18,5 @@ xx main::(gcd.pl:9)
 -- main::(gcd.pl:15)
     return gcd($b-$a, $a);
 xx main::(gcd.pl:9)
-    my ($a, $b) = @_;
+    my ($a, $b) = @_;
+trepan.pl: That's all, folks...
diff --git a/t/data/trace3.right b/t/data/trace3.right
@@ -37,4 +37,5 @@ Breakpoint 1 disabled
 -- main::(gcd.pl:14)
     return $a if ($a == 1) or ($b-$a == 0);
 <- main::(gcd.pl:21) main::gcd
-printf "The GCD of %d and %d is %d\n", $a, $b, gcd($a, $b);
+printf "The GCD of %d and %d is %d\n", $a, $b, gcd($a, $b);
+trepan.pl: That's all, folks...
diff --git a/t/data/watch1.right b/t/data/watch1.right
@@ -38,3 +38,4 @@ No actions.
 Num Type       Enb Expression
 1   watchpoint y   $a
 	watchpoint already hit 1 time
+trepan.pl: That's all, folks...
diff --git a/t/data/watch2.right b/t/data/watch2.right
@@ -20,3 +20,4 @@ old value	2
 new value	1
 wa main::(gcd.pl:11)
     ($a, $b) = ($b, $a) if ($a > $b);
+trepan.pl: That's all, folks...