Change 34250 by [EMAIL PROTECTED] on 2008/09/03 18:23:52
Integrate:
[ 34097]
Avoid using -> function call notation within test.pl, which is supposed
to keep to simple constructions to facilitate accurately testing the
core interpreter, which might be buggy.
[ 34152]
Subject: [PATCH] Fix skips in test.pl
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Fri, 18 Jul 2008 09:09:41 -0400
Message-ID: <[EMAIL PROTECTED]>
Changes skip messages to be consistent with Test::Builder.
[ 34173]
Better temporary file name generation. (Avoid using ++, avoid file
names clashing between different scripts, which may now be executing
in parallel)
[ 34178]
A proper tempfile function that can be used multiple times.
[ 34179]
Fix bug in counting in tempfile().
Also we need to note file names we give out, as some callers don't
create them before calling us a second time.
Add a regexp that matches the tempfile() names, for tests that want to
munge output.
Affected files ...
... //depot/maint-5.10/perl/t/test.pl#4 integrate
Differences ...
==== //depot/maint-5.10/perl/t/test.pl#4 (text) ====
Index: perl/t/test.pl
--- perl/t/test.pl#3~34247~ 2008-09-03 09:58:09.000000000 -0700
+++ perl/t/test.pl 2008-09-03 11:23:52.000000000 -0700
@@ -70,9 +70,7 @@
return unless @_;
my @mess = map { /^#/ ? "$_\n" : "# $_\n" }
map { split /\n/ } @_;
- my $func = $TODO ? \&_print : \&_print_stderr;
- $func->(@mess);
-
+ $TODO ? _print(@mess) : _print_stderr(@mess);
}
sub diag {
@@ -81,7 +79,7 @@
sub skip_all {
if (@_) {
- _print "1..0 # Skipped: @_\n";
+ _print "1..0 # Skip @_\n";
} else {
_print "1..0\n";
}
@@ -318,7 +316,7 @@
my $why = shift;
my $n = @_ ? shift : 1;
for (1..$n) {
- _print "ok $test # skip: $why\n";
+ _print "ok $test # skip $why\n";
$test = $test + 1;
}
local $^W = 0;
@@ -330,7 +328,7 @@
my $n = @_ ? shift : 1;
for (1..$n) {
- _print "not ok $test # TODO & SKIP: $why\n";
+ _print "not ok $test # TODO & SKIP $why\n";
$test = $test + 1;
}
local $^W = 0;
@@ -621,10 +619,37 @@
}
}
+my %tmpfiles;
+END { unlink_all keys %tmpfiles }
+
+# A regexp that matches the tempfile names
+$::tempfile_regexp = 'tmp\d+[A-Z][A-Z]?';
+
+# Avoid ++, avoid ranges, avoid split //
+my @letters = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z);
+sub tempfile {
+ my $count = 0;
+ do {
+ my $temp = $count;
+ my $try = "tmp$$";
+ do {
+ $try .= $letters[$temp % 26];
+ $temp = int ($temp / 26);
+ } while $temp;
+ # Need to note all the file names we allocated, as a second request may
+ # come before the first is created.
+ if (!-e $try && !$tmpfiles{$try}) {
+ # We have a winner
+ $tmpfiles{$try}++;
+ return $try;
+ }
+ $count = $count + 1;
+ } while $count < 26 * 26;
+ die "Can't find temporary file name starting 'tmp$$'";
+}
-my $tmpfile = "misctmp000";
-1 while -f ++$tmpfile;
-END { unlink_all $tmpfile }
+# This is the temporary file for _fresh_perl
+my $tmpfile = tempfile();
#
# _fresh_perl
@@ -660,8 +685,8 @@
# Clean up the results into something a bit more predictable.
$results =~ s/\n+$//;
- $results =~ s/at\s+misctmp\d+\s+line/at - line/g;
- $results =~ s/of\s+misctmp\d+\s+aborted/of - aborted/g;
+ $results =~ s/at\s+$::tempfile_regexp\s+line/at - line/g;
+ $results =~ s/of\s+$::tempfile_regexp\s+aborted/of - aborted/g;
# bison says 'parse error' instead of 'syntax error',
# various yaccs may or may not capitalize 'syntax'.
End of Patch.
