X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fperl5db.pl;h=c87e905399ee407779d1182f7aaf7569ca3508f0;hb=7ea36084e4245db25ca4470a515a3d5817ca9c0f;hp=a2b9926cc1e949a17e0a1abf020a1076239d2bf4;hpb=c6f14548d7bd301fc081005522b7fbe495c9b172;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index a2b9926..c87e905 100644
--- 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.02;
+$VERSION = 1.03;
 $header = "perl5db.pl version $VERSION";
 
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
@@ -1182,9 +1182,13 @@ sub sub {
 	 ? ( (print $LINEINFO ' ' x $#stack, "out "), 
 	     print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
 	 : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
-	print ($OUT ($frame & 16 ? ' ' x $#stack : ""),
-		    "list context return from $sub:\n"), dumpit( \@ret ),
-	  $doret = -2 if $doret eq $#stack or $frame & 16;
+	if ($doret eq $#stack or $frame & 16) {
+            my $fh = ($doret eq $#stack ? $OUT : $LINEINFO);
+	    print $fh ' ' x $#stack if $frame & 16;
+	    print $fh "list context return from $sub:\n"; 
+	    dumpit($fh, \@ret );
+	    $doret = -2;
+	}
 	@ret;
     } else {
         if (defined wantarray) {
@@ -1197,9 +1201,15 @@ sub sub {
 	 ? ( (print $LINEINFO ' ' x $#stack, "out "), 
 	      print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
 	 : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
-	print ($OUT ($frame & 16 ? ' ' x $#stack : ""),
-		    "scalar context return from $sub: "), dumpit( $ret ),
-	  $doret = -2 if $doret eq $#stack or $frame & 16;
+	if ($doret eq $#stack or $frame & 16 and defined wantarray) {
+            my $fh = ($doret eq $#stack ? $OUT : $LINEINFO);
+	    print $fh (' ' x $#stack) if $frame & 16;
+	    print $fh (defined wantarray 
+			 ? "scalar context return from $sub: " 
+			 : "void context return from $sub\n");
+	    dumpit( $fh, $ret ) if defined wantarray;
+	    $doret = -2;
+	}
 	$ret;
     }
 }
@@ -1229,7 +1239,7 @@ sub eval {
     if ($at) {
 	print $OUT $at;
     } elsif ($onetimeDump eq 'dump') {
-	dumpit(\@res);
+	dumpit($OUT, \@res);
     } elsif ($onetimeDump eq 'methods') {
 	methods($res[0]);
     }
@@ -1284,7 +1294,7 @@ sub postponed {
 }
 
 sub dumpit {
-    local ($savout) = select($OUT);
+    local ($savout) = select(shift);
     my $osingle = $single;
     my $otrace = $trace;
     $single = $trace = 0;
@@ -1365,7 +1375,7 @@ sub dump_trace {
 	push(@a, $_);
       }
     }
-    $context = $context ? '@' : "\$";
+    $context = $context ? '@' : (defined $context ? "\$" : '.');
     $args = $h ? [@a] : undef;
     $e =~ s/\n\s*\;\s*\Z// if $e;
     $e =~ s/([\\\'])/\\$1/g if $e;