Merge Mainline

p4raw-id: //depot/ansiperl@1566

3 files changed, 56 insertions, 21 deletions

diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm
index 267b809b21..5b7bb0b6da 100644
--- a/lib/ExtUtils/MakeMaker.pm
+++ b/lib/ExtUtils/MakeMaker.pm
@@ -1758,14 +1758,14 @@ or you can edit the default by saying something like:
 	    $inherited;
 	}
 
-If you running experiments with embedding perl as a library into other
-applications, you might find MakeMaker not sufficient. You'd better
-have a look at ExtUtils::embed which is a collection of utilities for
-embedding.
+If you are running experiments with embedding perl as a library into
+other applications, you might find MakeMaker is not sufficient. You'd
+better have a look at ExtUtils::Embed which is a collection of utilities
+for embedding.
 
 If you still need a different solution, try to develop another
-subroutine, that fits your needs and submit the diffs to
-F<perl5-porters@nicoh.com> or F<comp.lang.perl.misc> as appropriate.
+subroutine that fits your needs and submit the diffs to
+F<perl5-porters@perl.org> or F<comp.lang.perl.moderated> as appropriate.
 
 For a complete description of all MakeMaker methods see L<ExtUtils::MM_Unix>.
 
@@ -1919,7 +1919,7 @@ different means on the current architecture).
 =head1 SEE ALSO
 
 ExtUtils::MM_Unix, ExtUtils::Manifest, ExtUtils::testlib,
-ExtUtils::Install, ExtUtils::embed
+ExtUtils::Install, ExtUtils::Embed
 
 =head1 AUTHORS
 
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index e2c47d62ad..5decc756ff 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -11,7 +11,13 @@ use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest
 	    @ISA @EXPORT @EXPORT_OK);
 $have_devel_corestack = 0;
 
-$VERSION = "1.1601";
+$VERSION = "1.1602";
+
+# Some experimental versions of OS/2 build have broken $?
+my $ignore_exitcode = $ENV{HARNESS_IGNORE_EXITCODE};
+
+my $tests_skipped = 0;
+my $subtests_skipped = 0;
 
 @ISA=('Exporter');
 @EXPORT= qw(&runtests);
@@ -123,7 +129,7 @@ sub runtests {
 	    }
 	}
 	$fh->close; # must close to reap child resource values
-	my $wstatus = $?;
+	my $wstatus = $ignore_exitcode ? 0 : $?;	# Can trust $? ?
 	my $estatus;
 	$estatus = ($^O eq 'VMS'
 		       ? eval 'use vmsish "status"; $estatus = $?'
@@ -172,6 +178,7 @@ sub runtests {
 		print "ok\n";
 	    } else {
 		print "skipping test on this platform\n";
+		$tests_skipped++;
 	    }
 	    $good++;
 	} elsif ($max) {
@@ -204,6 +211,7 @@ sub runtests {
 				    estat => '', wstat => '',
 				  };
 	}
+	$subtests_skipped += $skipped;
     }
     my $t_total = timediff(new Benchmark, $t_start);
     
@@ -218,6 +226,16 @@ sub runtests {
     $bonusmsg = (" ($totbonus subtest".($totbonus>1?'s':'').
 	       " UNEXPECTEDLY SUCCEEDED)")
 	if $totbonus;
+    if ($tests_skipped) {
+	$bonusmsg .= ", $tests_skipped test" . ($tests_skipped != 1 ? 's' : '') .
+			' skipped';
+    }
+    if ($subtests_skipped) {
+	$bonusmsg .= ($tests_skipped ? ', plus ' : ', '). 
+			"$subtests_skipped subtest"
+			. ($subtests_skipped != 1 ? 's' : '') .
+			" skipped";
+    }
     if ($bad == 0 && $totmax) {
 	print "All tests successful$bonusmsg.\n";
     } elsif ($total==0){
@@ -235,6 +253,8 @@ sub runtests {
 	  write;
 	}
 	if ($bad) {
+	    $bonusmsg =~ s/^,\s*//;
+	    print "$bonusmsg.\n" if $bonusmsg;
 	    die "Failed $bad/$total test scripts, $pct% okay.$subpct\n";
 	}
     }
@@ -399,6 +419,11 @@ above messages.
 
 =back
 
+=head1 ENVIRONMENT
+
+Setting C<HARNESS_IGNORE_EXITCODE> makes it ignore the exit status
+of child processes.
+
 =head1 SEE ALSO
 
 L<Test> for writing test scripts and also L<Benchmark> for the
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index a2b9926cc1..67a6a6d839 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)
@@ -1043,7 +1043,7 @@ EOP
 		    $cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do {
 			pop(@hist) if length($cmd) > 1;
 			$i = $1 ? ($#hist-($2?$2:1)) : ($2?$2:$#hist);
-			$cmd = $hist[$i] . "\n";
+			$cmd = $hist[$i];
 			print $OUT $cmd;
 			redo CMD; };
 		    $cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
@@ -1059,7 +1059,7 @@ EOP
 			    print $OUT "No such command!\n\n";
 			    next CMD;
 			}
-			$cmd = $hist[$i] . "\n";
+			$cmd = $hist[$i];
 			print $OUT $cmd;
 			redo CMD; };
 		    $cmd =~ /^$sh$/ && do {
@@ -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;