END {
my $ran = $test - 1;
if (!$NO_ENDING && defined $planned && $planned != $ran) {
- print STDOUT "# Looks like you planned $planned tests but ran $ran.\n";
+ print STDERR "# Looks like you planned $planned tests but ran $ran.\n";
}
}
+# Use this instead of "print STDERR" when outputing failure diagnostic
+# messages
+sub _diag {
+ my $fh = $TODO ? *STDOUT : *STDERR;
+ print $fh @_;
+}
+
sub skip_all {
if (@_) {
print STDOUT "1..0 - @_\n";
print STDOUT "$out\n";
unless ($pass) {
- print STDOUT "# Failed $where\n";
+ _diag "# Failed $where\n";
}
# Ensure that the message is properly escaped.
- print STDOUT map { /^#/ ? "$_\n" : "# $_\n" }
- map { split /\n/ } @mess if @mess;
+ _diag map { /^#/ ? "$_\n" : "# $_\n" }
+ map { split /\n/ } @mess if @mess;
$test++;
if (ref $expected eq 'Regexp') {
$pass = $got =~ $expected;
unless ($pass) {
- unshift(@mess, "# got '$got'\n");
+ unshift(@mess, "# got '$got'\n",
+ "# expected /$expected/\n");
}
} else {
$pass = $got =~ /$expected/;
$key = "" . $key;
if (exists $orig->{$key}) {
if ($orig->{$key} ne $value) {
- print "# key ", _qq($key), " was ", _qq($orig->{$key}),
- " now ", _qq($value), "\n";
+ print STDOUT "# key ", _qq($key), " was ", _qq($orig->{$key}),
+ " now ", _qq($value), "\n";
$fail = 1;
}
} else {
- print "# key ", _qq($key), " is ", _qq($value), ", not in original.\n";
+ print STDOUT "# key ", _qq($key), " is ", _qq($value),
+ ", not in original.\n";
$fail = 1;
}
}
# Force a hash recompute if this perl's internals can cache the hash key.
$_ = "" . $_;
next if (exists $suspect->{$_});
- print "# key ", _qq($_), " was ", _qq($orig->{$_}), " now missing.\n";
+ print STDOUT "# key ", _qq($_), " was ", _qq($orig->{$_}), " now missing.\n";
$fail = 1;
}
!$fail;
if ($args{verbose}) {
my $runperldisplay = $runperl;
$runperldisplay =~ s/\n/\n\#/g;
- print STDOUT "# $runperldisplay\n";
+ print STDERR "# $runperldisplay\n";
}
my $result = `$runperl`;
$result =~ s/\n\n/\n/ if $is_vms; # XXX pipes sometimes double these
}
-sub BAILOUT {
- print STDOUT "Bail out! @_\n";
- exit;
+sub DIE {
+ print STDERR "# @_\n";
+ exit 1;
}
# A somewhat safer version of the sometimes wrong $^X.
} else {
$exe = $Config{_exe};
}
+ $exe = '' unless defined $exe;
# This doesn't absolutize the path: beware of future chdirs().
# We could do File::Spec->abs2rel() but that does getcwd()s,
return $Perl;
}
+sub unlink_all {
+ foreach my $file (@_) {
+ 1 while unlink $file;
+ print STDERR "# Couldn't unlink '$file': $!\n" if -f $file;
+ }
+}
1;