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