summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2007-01-15 13:40:18 +0000
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2007-01-15 13:40:18 +0000
commitafb1190b3ee338cb3041f40222683e67349d3ab0 (patch)
tree31f5fd1f0bd8d3835d39a431070b37b36387c144
parent8fd870d929de5f21b44ff2edf7d01f4570f834b3 (diff)
downloadperl-afb1190b3ee338cb3041f40222683e67349d3ab0.tar.gz
Various cleanup and factorization by Schwern
for tests for warnings and features p4raw-id: //depot/perl@29823
-rw-r--r--t/lib/common.pl39
1 files changed, 23 insertions, 16 deletions
diff --git a/t/lib/common.pl b/t/lib/common.pl
index 605bc2a21e..c60fd94c4e 100644
--- a/t/lib/common.pl
+++ b/t/lib/common.pl
@@ -1,10 +1,10 @@
# This code is used by lib/warnings.t and lib/feature.t
BEGIN {
- require Config; import Config;
require './test.pl';
}
+use Config;
use File::Path;
use File::Spec::Functions;
@@ -13,10 +13,10 @@ our $pragma_name;
$| = 1;
-my $Is_MacOS = $^O eq 'MacOS';
+my $Is_MacOS = $^O eq 'MacOS';
my $tmpfile = "tmp0000";
1 while -e ++$tmpfile;
-END { if ($tmpfile) { 1 while unlink $tmpfile} }
+END { 1 while unlink $tmpfile }
my @prgs = () ;
my @w_files = () ;
@@ -160,24 +160,15 @@ for (@prgs){
if ( $results =~ s/^SKIPPED\n//) {
print "$results\n" ;
}
- elsif ($option_random)
- {
+ elsif ($option_random) {
$ok = randomMatch($results, $expected);
}
elsif (($prefix && (( $option_regex && $results !~ /^$expected/) ||
(!$option_regex && $results !~ /^\Q$expected/))) or
(!$prefix && (( $option_regex && $results !~ /^$expected/) ||
- (!$option_regex && $results ne $expected)))) {
- my $err_line = "PROG: $switch\n$prog\n" .
- "EXPECTED:\n$expected\n" .
- "GOT:\n$results\n";
- if ($todo) {
- $err_line =~ s/^/# /mg;
- print $err_line; # Harness can't filter it out from STDERR.
- }
- else {
- print STDERR $err_line;
- }
+ (!$option_regex && $results ne $expected))))
+ {
+ print_err_line( $switch, $prog, $expected, $results, $todo );
$ok = 0;
}
@@ -202,4 +193,20 @@ sub randomMatch
}
+sub print_err_line {
+ my($switch, $prog, $expected, $results, $todo) = @_;
+ my $err_line = "PROG: $switch\n$prog\n" .
+ "EXPECTED:\n$expected\n" .
+ "GOT:\n$results\n";
+ if ($todo) {
+ $err_line =~ s/^/# /mg;
+ print $err_line; # Harness can't filter it out from STDERR.
+ }
+ else {
+ print STDERR $err_line;
+ }
+
+ return 1;
+}
+
1;