+2009-09-05 Steven Schubiger <stsc@member.fsf.org>
+
+ * run-px: Introduce two new diagnostics: Skip and Unknown.
+
+ * WgetFeature.pm (import): Parse the version output of Wget
+ and assert the availability of a feature.
+
+ * WgetFeature.cfg: Messages to be printed in absence of a
+ required feature.
+
+ * Test-ftp-iri-disabled.px, Test-ftp-iri-fallback.px,
+ Test-ftp-iri-recursive.px, Test-ftp-iri.px, Test-idn-cmd.px,
+ Test-idn-headers.px, Test-idn-meta.px, Test-idn-robots.px,
+ Test-iri-forced-remote.px, Test-iri-list.px,
+ Test-iri-percent.px, Test-iri.px: Use WgetFeature.pm to
+ check for the presence of the IDN/IRI feature.
+
+ * Test-proxied-https-auth.px: Replace grepping for a feature
+ with loading WgetFeature.pm at compile-time.
+
+ * Makefile.am: Add WgetFeature.pm and WgetFeature.cfg
+ to EXTRA_DIST.
+
2009-09-02 Micah Cowan <micah@cowan.name>
* Makefile.am (unit-tests): explicit dependency is
$(srcdir)/run-px $(top_srcdir)
EXTRA_DIST = FTPServer.pm FTPTest.pm HTTPServer.pm HTTPTest.pm \
+ WgetFeature.pm WgetFeature.cfg \
Test-auth-basic.px \
Test-auth-no-challenge.px \
Test-auth-no-challenge-url.px \
use strict;
use warnings;
+use WgetFeature qw(iri);
use FTPTest;
use strict;
use warnings;
+use WgetFeature qw(iri);
use FTPTest;
use strict;
use warnings;
+use WgetFeature qw(iri);
use FTPTest;
use strict;
use warnings;
+use WgetFeature qw(iri);
use FTPTest;
use strict;
use warnings;
+use WgetFeature qw(iri);
use HTTPTest;
# " Kon'nichiwa <dot> Japan
use strict;
use warnings;
+use WgetFeature qw(iri);
use HTTPTest;
# " Kon'nichiwa <dot> Japan
use strict;
use warnings;
+use WgetFeature qw(iri);
use HTTPTest;
# " Kon'nichiwa <dot> Japan
use strict;
use warnings;
+use WgetFeature qw(iri);
use HTTPTest;
# " Kon'nichiwa <dot> Japan
use strict;
use warnings;
+use WgetFeature qw(iri);
use HTTPTest;
# cf. http://en.wikipedia.org/wiki/Latin1
use strict;
use warnings;
+use WgetFeature qw(iri);
use HTTPTest;
# cf. http://en.wikipedia.org/wiki/Latin1
use strict;
use warnings;
+use WgetFeature qw(iri);
use HTTPTest;
# Just a sanity check to verify that %-encoded values are always left
use strict;
use warnings;
+use WgetFeature qw(iri);
use HTTPTest;
# cf. http://en.wikipedia.org/wiki/Latin1
use strict;
use warnings;
+use WgetFeature qw(https);
use WgetTest; # For $WGETPATH.
my $cert_path;
$cert_path = "$top_srcdir/tests/certs/server-cert.pem";
}
-# Have we even built an HTTPS-supporting Wget?
-{
- my @version_lines = `${WgetTest::WGETPATH} --version`;
- unless (grep /\+(openssl|gnutls)/, @version_lines) {
- print "Not running test: Wget under test doesn't support HTTPS.\n";
- exit 0;
- }
-}
-
use HTTP::Daemon;
use HTTP::Request;
use IO::Socket::SSL;
--- /dev/null
+%skip_messages = (
+ https => "Not running test: Wget under test doesn't support HTTPS.",
+ iri => "Not running test: Wget under test doesn't support IDN/IRI.",
+);
+
+1;
--- /dev/null
+package WgetFeature;
+
+use strict;
+use warnings;
+
+use WgetTest;
+
+our %skip_messages;
+require 'WgetFeature.cfg';
+
+sub import
+{
+ my ($class, $feature) = @_;
+
+ my $output = `$WgetTest::WGETPATH --version`;
+ my ($list) = $output =~ /^([\+\-]\S+(?:\s+[\+\-]\S+)+)/m;
+ my %have_features = map {
+ my $feature = $_;
+ $feature =~ s/^.//;
+ ($feature, /^\+/ ? 1 : 0);
+ } split /\s+/, $list;
+
+ unless ($have_features{$feature}) {
+ print $skip_messages{$feature}, "\n";
+ exit 2; # skip
+ }
+}
+
+1;
use strict;
use warnings;
-use Term::ANSIColor ':constants';
-$Term::ANSIColor::AUTORESET = 1;
+use Term::ANSIColor;
die "Please specify the top source directory.\n" if (!@ARGV);
my $top_srcdir = shift @ARGV;
foreach my $test (@tests) {
print "Running $test\n\n";
system("$^X -I$top_srcdir/tests $top_srcdir/tests/$test $top_srcdir");
- push @tested, { name => $test, result => $? };
+ push @tested, { name => $test, result => $? >> 8 };
}
foreach my $var (qw(SYSTEM_WGETRC WGETRC)) {
delete $ENV{$var};
}
+my %exit = (
+ pass => 0,
+ fail => 1,
+ skip => 2,
+ unknown => 3, # or greater
+);
+
+my %colors = (
+ $exit{pass} => colored('pass:', 'green' ),
+ $exit{fail} => colored('FAIL:', 'red' ),
+ $exit{skip} => colored('Skip:', 'yellow' ),
+ $exit{unknown} => colored('Unknown:', 'magenta'),
+);
+
print "\n";
foreach my $test (@tested) {
- ($test->{result} == 0)
- ? print GREEN 'pass: '
- : print RED 'FAIL: ';
- print $test->{name}, "\n";
+ my $colored = exists $colors{$test->{result}}
+ ? $colors{$test->{result}}
+ : $colors{$exit{unknown}};
+ print "$colored $test->{name}\n";
}
my $count = sub
{
return {
- pass => sub { scalar grep $_->{result} == 0, @tested },
- fail => sub { scalar grep $_->{result} != 0, @tested },
+ pass => sub { scalar grep $_->{result} == $exit{pass}, @tested },
+ fail => sub { scalar grep $_->{result} == $exit{fail}, @tested },
+ skip => sub { scalar grep $_->{result} == $exit{skip}, @tested },
+ unknown => sub { scalar grep $_->{result} >= $exit{unknown}, @tested },
}->{$_[0]}->();
};
my @lines = (
"${\scalar @tested} tests were run",
"${\$count->('pass')} PASS, ${\$count->('fail')} FAIL",
+ "${\$count->('skip')} SKIP, ${\$count->('unknown')} UNKNOWN",
);
my $len_longest = sub
{
print "\n";
print $count->('fail')
- ? RED $summary
- : GREEN $summary;
+ ? colored($summary, 'red')
+ : colored($summary, 'green');
print "\n";
exit $count->('fail');