X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fperl5db.pl;h=63b4381339ce25b8de4c0112074d65c7022164c0;hb=191740791d4b6865c4f2665c148ea4f4d8ec7cc3;hp=7257aa90d40a52fc660bd2e28903eb878bf307b9;hpb=31fc166bd7f2ed3ea063fda6c7a5bbf5dd4fb403;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 7257aa9..63b4381 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -25,7 +25,7 @@ $header = "perl5db.pl version $VERSION";
 # if caller() is called from the package DB, it provides some
 # additional data.
 #
-# The array @{$main::{'_<'.$filename} is the line-by-line contents of
+# The array @{$main::{'_<'.$filename}} is the line-by-line contents of
 # $filename.
 #
 # The hash %{'_<'.$filename} contains breakpoints and action (it is
@@ -401,6 +401,12 @@ if ($notty) {
     $console = "/dev/tty";
   } elsif ($^O eq 'dos' or -e "con" or $^O eq 'MSWin32') {
     $console = "con";
+  } elsif ($^O eq 'MacOS') {
+    if ($MacPerl::Version !~ /MPW/) {
+      $console = "Dev:Console:Perl Debug"; # Separate window for application
+    } else {
+      $console = "Dev:Console";
+    }
   } else {
     $console = "sys\$command";
   }
@@ -426,7 +432,7 @@ if ($notty) {
                                  PeerAddr => $remoteport,
                                  Proto    => 'tcp',
                                );
-    if (!$OUT) { die "Could not create socket to connect to remote host."; }
+    if (!$OUT) { die "Unable to connect to remote host: $remoteport\n"; }
     $IN = $OUT;
   }
   else {
@@ -617,7 +623,7 @@ EOP
 			    next CMD;
 			} 
 		    }
-		    $cmd =~ /^q$/ && ($exiting = 1) && exit 0;
+                   $cmd =~ /^q$/ && ($fall_off_end = 1) && exit $?;
 		    $cmd =~ /^h$/ && do {
 			print_help($help);
 			next CMD; };
@@ -931,7 +937,7 @@ EOP
 			next CMD; };
 		    $cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do {
 			$i = $1 || $line;
-			$cond = defined $2 ? $2 : '1';
+			$cond = length $2 ? $2 : '1';
 			if ($dbline[$i] == 0) {
 			    print $OUT "Line $i not breakable.\n";
 			} else {
@@ -941,8 +947,12 @@ EOP
 			next CMD; };
 		    $cmd =~ /^d\b\s*(\d*)/ && do {
 			$i = $1 || $line;
-			$dbline{$i} =~ s/^[^\0]*//;
-			delete $dbline{$i} if $dbline{$i} eq '';
+                        if ($dbline[$i] == 0) {
+                            print $OUT "Line $i not breakable.\n";
+                        } else {
+			    $dbline{$i} =~ s/^[^\0]*//;
+			    delete $dbline{$i} if $dbline{$i} eq '';
+                        }
 			next CMD; };
 		    $cmd =~ /^A$/ && do {
 		      print $OUT "Deleting all actions...\n";
@@ -1426,7 +1436,7 @@ EOP
 		$piped= "";
 	    }
 	}			# CMD:
-	$exiting = 1 unless defined $cmd;
+       $fall_off_end = 1 unless defined $cmd; # Emulate `q' on EOF
 	foreach $evalarg (@$post) {
 	  &eval;
 	}
@@ -1507,6 +1517,7 @@ sub eval {
 	local $otrace = $trace;
 	local $osingle = $single;
 	local $od = $^D;
+	{ ($evalarg) = $evalarg =~ /(.*)/s; }
 	@res = eval "$usercontext $evalarg;\n"; # '\n' for nice recursive debug
 	$trace = $otrace;
 	$single = $osingle;
@@ -2160,8 +2171,8 @@ B<W>		Delete all watch-expressions.
 B<V> [I<pkg> [I<vars>]]	List some (default all) variables in package (default current).
 		Use B<~>I<pattern> and B<!>I<pattern> for positive and negative regexps.
 B<X> [I<vars>]	Same as \"B<V> I<currentpackage> [I<vars>]\".
-B<x> I<expr>		Evals expression in array context, dumps the result.
-B<m> I<expr>		Evals expression in array context, prints methods callable
+B<x> I<expr>		Evals expression in list context, dumps the result.
+B<m> I<expr>		Evals expression in list context, prints methods callable
 		on the first element of the result.
 B<m> I<class>		Prints methods callable via the given class.
 
@@ -2256,7 +2267,7 @@ I<Debugger controls:>                        B<L>           List break/watch/act
   B<|>[B<|>]I<db_cmd>  Send output to pager        B<$psh>\[B<$psh>\] I<syscmd> Run cmd in a subprocess
   B<q> or B<^D>     Quit			  B<R>	      Attempt a restart
 I<Data Examination:>	      B<expr>     Execute perl code, also see: B<s>,B<n>,B<t> I<expr>
-  B<x>|B<m> I<expr>	Evals expr in array context, dumps the result or lists methods.
+  B<x>|B<m> I<expr>	Evals expr in list context, dumps the result or lists methods.
   B<p> I<expr>	Print expression (uses script's current package).
   B<S> [[B<!>]I<pat>]	List subroutine names [not] matching pattern
   B<V> [I<Pk> [I<Vars>]]	List Variables in Package.  Vars can be ~pattern or !pattern.
@@ -2679,10 +2690,11 @@ sub end_report {
 }
 
 END {
-  $finished = $inhibit_exit;	# So that some keys may be disabled.
+  $finished = 1 if $inhibit_exit;      # So that some keys may be disabled.
+  $fall_off_end = 1 unless $inhibit_exit;
   # Do not stop in at_exit() and destructors on exit:
-  $DB::single = !$exiting && !$runnonstop;
-  DB::fake::at_exit() unless $exiting or $runnonstop;
+  $DB::single = !$fall_off_end && !$runnonstop;
+  DB::fake::at_exit() unless $fall_off_end or $runnonstop;
 }
 
 package DB::fake;