# Force a hash recompute if this perl's internals can cache the hash key.
$key = "" . $key;
if (exists $orig->{$key}) {
- if ($orig->{$key} ne $value) {
+ if (
+ defined $orig->{$key} != defined $value
+ || (defined $value && $orig->{$key} ne $value)
+ ) {
_print "# key ", _qq($key), " was ", _qq($orig->{$key}),
" now ", _qq($value), "\n";
$fail = 1;
$::tempfile_regexp = 'tmp\d+[A-Z][A-Z]?';
# Avoid ++, avoid ranges, avoid split //
+my $tempfile_count = 0;
sub tempfile {
- my $count = 0;
- do {
- my $temp = $count;
+ while(1){
my $try = "tmp$$";
- do {
- $try = $try . $letters[$temp % 26];
- $temp = int ($temp / 26);
- } while $temp;
+ my $alpha = _num_to_alpha($tempfile_count,2);
+ last unless defined $alpha;
+ $try = $try . $alpha;
+ $tempfile_count = $tempfile_count + 1;
+
# 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}) {
+ if (!$tmpfiles{$try} && !-e $try) {
# We have a winner
$tmpfiles{$try} = 1;
return $try;
}
- $count = $count + 1;
- } while $count < 26 * 26;
+ }
die "Can't find temporary file name starting 'tmp$$'";
}
# The expected output may contain:
# OPTION list of options
# OPTIONS list of options
-# PREFIX
-# indicates that the supplied output is only a prefix to the
-# expected output
#
# The possible options for OPTION may be:
# regex - the expected output is a regular expression
# If the actual output contains a line "SKIPPED" the test will be
# skipped.
#
+# If the actual output contains a line "PREFIX", any output starting with that
+# line will be ignored when comparing with the expected output
+#
# If the global variable $FATAL is true then OPTION fatal is the
# default.
my $tmpfile = tempfile();
+ PROGRAM:
for (@prgs){
unless (/\n/) {
print "# From $_\n";
$reason{$what} = $temp;
}
}
+
my $name = '';
if ($prog =~ s/^#\s*NAME\s+(.+)\n//m) {
$name = $1;
}
+ if ($reason{skip}) {
+ SKIP:
+ {
+ skip($name ? "$name - $reason{skip}" : $reason{skip}, 1);
+ }
+ next PROGRAM;
+ }
+
if ($prog =~ /--FILE--/) {
- my @files = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
+ my @files = split(/\n?--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
shift @files ;
die "Internal error: test $_ didn't split into pairs, got " .
scalar(@files) . "[" . join("%%%%", @files) ."]\n"