1#!/usr/bin/env perl
2
3use 5.006;
4use strict;
5use warnings;
6
7use Term::ANSIColor;
8
9die "Please specify the top source directory.\n" if (!@ARGV);
10my $top_srcdir = shift @ARGV;
11
12my @tests = (
13    'Test-auth-basic.px',
14    'Test-auth-no-challenge.px',
15    'Test-auth-no-challenge-url.px',
16    'Test-auth-with-content-disposition.px',
17    'Test-cookies.px',
18    'Test-cookies-401.px',
19    'Test-proxy-auth-basic.px',
20    'Test-proxied-https-auth.px',
21    'Test-N-HTTP-Content-Disposition.px',
22    'Test--spider.px',
23    'Test-c-full.px',
24    'Test-c-partial.px',
25    'Test-c-shorter.px',
26    'Test-c.px',
27    'Test-E-k-K.px',
28    'Test-E-k.px',
29    'Test-ftp.px',
30    'Test-ftp-pasv-fail.px',
31    'Test-ftp-bad-list.px',
32    'Test-ftp-recursive.px',
33    'Test-ftp-iri.px',
34    'Test-ftp-iri-fallback.px',
35    'Test-ftp-iri-recursive.px',
36    'Test-ftp-iri-disabled.px',
37    'Test-HTTP-Content-Disposition-1.px',
38    'Test-HTTP-Content-Disposition-2.px',
39    'Test-HTTP-Content-Disposition.px',
40    'Test-idn-headers.px',
41    'Test-idn-meta.px',
42    'Test-idn-cmd.px',
43    'Test-idn-robots.px',
44    'Test-iri.px',
45    'Test-iri-percent.px',
46    'Test-iri-disabled.px',
47    'Test-iri-forced-remote.px',
48    'Test-iri-list.px',
49    'Test-k.px',
50    'Test-meta-robots.px',
51    'Test-N-current.px',
52    'Test-N-smaller.px',
53    'Test-N-no-info.px',
54    'Test-N--no-content-disposition.px',
55    'Test-N--no-content-disposition-trivial.px',
56    'Test--no-content-disposition.px',
57    'Test--no-content-disposition-trivial.px',
58    'Test-N-old.px',
59    'Test-nonexisting-quiet.px',
60    'Test-noop.px',
61    'Test-np.px',
62    'Test-N.px',
63    'Test-O-HTTP-Content-Disposition.px',
64    'Test-O--no-content-disposition.px',
65    'Test-O--no-content-disposition-trivial.px',
66    'Test-O-nonexisting.px',
67    'Test-O.px',
68    'Test-O-nc.px',
69    'Test-restrict-ascii.px',
70    'Test-Restrict-Lowercase.px',
71    'Test-Restrict-Uppercase.px',
72    'Test--spider-fail.px',
73    'Test--spider-r-HTTP-Content-Disposition.px',
74    'Test--spider-r--no-content-disposition.px',
75    'Test--spider-r--no-content-disposition-trivial.px',
76    'Test--spider-r.px',
77);
78
79foreach my $var (qw(SYSTEM_WGETRC WGETRC)) {
80    $ENV{$var} = '/dev/null';
81}
82
83my @tested;
84
85foreach my $test (@tests) {
86    print "Running $test\n\n";
87    system("$^X -I$top_srcdir/tests $top_srcdir/tests/$test $top_srcdir");
88    push @tested, { name => $test, result => $? >> 8 };
89}
90
91foreach my $var (qw(SYSTEM_WGETRC WGETRC)) {
92    delete $ENV{$var};
93}
94
95my %exit = (
96    pass    => 0,
97    fail    => 1,
98    skip    => 2,
99    unknown => 3, # or greater
100);
101
102my %colors = (
103    $exit{pass}    => colored('pass:',    'green'  ),
104    $exit{fail}    => colored('FAIL:',    'red'    ),
105    $exit{skip}    => colored('Skip:',    'yellow' ),
106    $exit{unknown} => colored('Unknown:', 'magenta'),
107);
108
109print "\n";
110foreach my $test (@tested) {
111    my $colored = exists $colors{$test->{result}}
112      ? $colors{$test->{result}}
113      : $colors{$exit{unknown}};
114    print "$colored $test->{name}\n";
115}
116
117my $count = sub
118{
119    return {
120      pass    => sub { scalar grep $_->{result} == $exit{pass},    @tested },
121      fail    => sub { scalar grep $_->{result} == $exit{fail},    @tested },
122      skip    => sub { scalar grep $_->{result} == $exit{skip},    @tested },
123      unknown => sub { scalar grep $_->{result} >= $exit{unknown}, @tested },
124    }->{$_[0]}->();
125};
126
127my $summary = sub
128{
129    my @lines = (
130        "${\scalar @tested} tests were run",
131        "${\$count->('pass')} PASS, ${\$count->('fail')} FAIL",
132        "${\$count->('skip')} SKIP, ${\$count->('unknown')} UNKNOWN",
133    );
134    my $len_longest = sub
135    {
136        local $_ = 0;
137        foreach my $line (@lines) {
138            if (length $line > $_) {
139                $_ = length $line;
140            }
141        }
142        return $_;
143    }->();
144    return join "\n",
145      '=' x $len_longest,
146      @lines,
147      '=' x $len_longest;
148}->();
149
150print "\n";
151print $count->('fail') || $count->('unknown')
152  ? colored($summary, 'red')
153  : colored($summary, 'green');
154print "\n";
155
156exit $count->('fail') + $count->('unknown');
157