perl 5.003_02: [no incremental changelog available]

5 files changed, 65 insertions, 18 deletions

diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm
index 341786da91..b70659a41c 100644
--- a/lib/ExtUtils/MM_Unix.pm
+++ b/lib/ExtUtils/MM_Unix.pm
@@ -1147,8 +1147,8 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
     foreach $name ($self->lsdir($self->curdir)){
 	next if $name eq $self->curdir or $name eq $self->updir or $ignore{$name};
 	next unless $self->libscan($name);
-	next if -l $name; # We do not support symlinks at all
 	if (-d $name){
+	    next if -l $name; # We do not support symlinks at all
 	    $dir{$name} = $name if (-f $self->catfile($name,"Makefile.PL"));
 	} elsif ($name =~ /\.xs$/){
 	    my($c); ($c = $name) =~ s/\.xs$/.c/;
@@ -1365,14 +1365,11 @@ sub init_main {
     # It may also edit @modparts if required.
     if (defined &DynaLoader::mod2fname) {
         $modfname = &DynaLoader::mod2fname(\@modparts);
-    } elsif ($Is_OS2) {                # Need manual correction if run with miniperl:-(
-        $modfname = substr($modfname, 0, 7) . '_';
-    }
-
+    } 
 
     ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!([\w:]+::)?(\w+)$! ;
 
-    if (defined &DynaLoader::mod2fname or $Is_OS2) {
+    if (defined &DynaLoader::mod2fname) {
 	# As of 5.001m, dl_os2 appends '_'
 	$self->{DLBASE} = $modfname;
     } else {
@@ -2609,14 +2606,14 @@ sub static_lib {
     my(@m);
     push(@m, <<'END');
 $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists
+	$(RM_RF) $@
 END
     # If this extension has it's own library (eg SDBM_File)
     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
     push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB};
 
     push @m,
-q{	$(RM_RF) $@
-	$(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
+q{	$(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
 	}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
 	$(CHMOD) 755 $@
 };
diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm
index 544dece638..a3307a1aa9 100644
--- a/lib/ExtUtils/MakeMaker.pm
+++ b/lib/ExtUtils/MakeMaker.pm
@@ -25,8 +25,9 @@ use vars qw(
 	   );
 # use strict;
 
-eval {require DynaLoader;};	# Get mod2fname, if defined. Will fail
-                                # with miniperl.
+# &DynaLoader::mod2fname should be available to miniperl, thus 
+# should be a pseudo-builtin (cmp. os2.c).
+#eval {require DynaLoader;};
 
 #
 # Set up the inheritance before we pull in the MM_* packages, because they
diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm
index 5c0173a508..3583194c4a 100644
--- a/lib/ExtUtils/Mksymlists.pm
+++ b/lib/ExtUtils/Mksymlists.pm
@@ -40,6 +40,7 @@ sub Mksymlists {
     }
 
 #    We'll need this if we ever add any OS which uses mod2fname
+#    not as pseudo-builtin.
 #    require DynaLoader;
     if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
         $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 2a89f20dde..387c40c128 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -5,7 +5,10 @@ use Exporter;
 use Benchmark;
 use Config;
 use FileHandle;
-use vars qw($VERSION $verbose $switches $have_devel_corestack);
+use strict;
+
+use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest
+	    @ISA @EXPORT @EXPORT_OK);
 $have_devel_corestack = 0;
 
 $VERSION = "1.12";
@@ -14,6 +17,23 @@ $VERSION = "1.12";
 @EXPORT= qw(&runtests);
 @EXPORT_OK= qw($verbose $switches);
 
+format STDOUT_TOP =
+Failed Test  Status Wstat Total Fail  Failed  List of failed
+------------------------------------------------------------------------------
+.
+
+format STDOUT =
+@<<<<<<<<<<<<<< @>> @>>>> @>>>> @>>> ^##.##%  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+{ $curtest->{name},
+                $curtest->{estat},
+                    $curtest->{wstat},
+                          $curtest->{max},
+                                $curtest->{failed},
+                                     $curtest->{percent},
+                                              $curtest->{canon}
+}
+.
+
 
 $verbose = 0;
 $switches = "-w";
@@ -21,7 +41,7 @@ $switches = "-w";
 sub runtests {
     my(@tests) = @_;
     local($|) = 1;
-    my($test,$te,$ok,$next,$max,$pct);
+    my($test,$te,$ok,$next,$max,$pct,$totok,@failed,%failedtests);
     my $totmax = 0;
     my $files = 0;
     my $bad = 0;
@@ -82,6 +102,11 @@ sub runtests {
 		}
 	    }
 	    $bad++;
+	    $failedtests{$test} = { canon => '??',  max => $max || '??',
+				    failed => '??', 
+				    name => $test, percent => undef,
+				    estat => $estatus, wstat => $wstatus,
+				  };
 	} elsif ($ok == $max && $next == $max+1) {
 	    if ($max) {
 		print "ok\n";
@@ -94,14 +119,30 @@ sub runtests {
 		push @failed, $next..$max;
 	    }
 	    if (@failed) {
-		print canonfailed($max,@failed);
+		my ($txt, $canon) = canonfailed($max,@failed);
+		print $txt;
+		$failedtests{$test} = { canon => $canon,  max => $max,
+					failed => scalar @failed,
+					name => $test, percent => 100*(scalar @failed)/$max,
+					estat => '', wstat => '',
+				      };
 	    } else {
 		print "Don't know which tests failed: got $ok ok, expected $max\n";
+		$failedtests{$test} = { canon => '??',  max => $max,
+					failed => '??', 
+					name => $test, percent => undef,
+					estat => '', wstat => '',
+				      };
 	    }
 	    $bad++;
 	} elsif ($next == 0) {
 	    print "FAILED before any test output arrived\n";
 	    $bad++;
+	    $failedtests{$test} = { canon => '??',  max => '??',
+				    failed => '??',
+				    name => $test, percent => undef,
+				    estat => '', wstat => '',
+				  };
 	}
     }
     my $t_total = timediff(new Benchmark, $t_start);
@@ -117,9 +158,12 @@ sub runtests {
 	$pct = sprintf("%.2f", $good / $total * 100);
 	my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
 	$totmax - $totok, $totmax, 100*$totok/$totmax;
-	if ($bad == 1) {
-	    die "Failed 1 test script, $pct% okay.$subpct\n";
-	} else {
+	my $script;
+	for $script (sort keys %failedtests) {
+	  $curtest = $failedtests{$script};
+	  write;
+	}
+	if ($bad > 1) {
 	    die "Failed $bad/$total test scripts, $pct% okay.$subpct\n";
 	}
     }
@@ -154,6 +198,7 @@ sub canonfailed ($@) {
     my @canon = ();
     my $min;
     my $last = $min = shift @failed;
+    my $canon;
     if (@failed) {
 	for (@failed, $failed[-1]) { # don't forget the last one
 	    if ($_ > $last+1 || $_ == $last) {
@@ -168,13 +213,16 @@ sub canonfailed ($@) {
 	}
 	local $" = ", ";
 	push @result, "FAILED tests @canon\n";
+	$canon = "@canon";
     } else {
 	push @result, "FAILED test $last\n";
+	$canon = $last;
     }
 
     push @result, "\tFailed $failed/$max tests, ";
     push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay\n";
-    join "", @result;
+    my $txt = join "", @result;
+    ($txt, $canon);
 }
 
 1;
diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm
index 317597cb83..33b683525d 100644
--- a/lib/Text/ParseWords.pm
+++ b/lib/Text/ParseWords.pm
@@ -115,7 +115,7 @@ sub quotewords {
                last;
 	    }
 	    else {
-                while (length($_) && !(/^$delim/ || /^['"\\]/)) {
+                while ($_ && !(/^$delim/ || /^['"\\]/)) {
 		   $snippet .=  substr($_, 0, 1);
                    substr($_, 0, 1) = '';
                 }