Initail import package wget: A utility for retrieving files using the HTTP or FTP...
[external/wget.git] / 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-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
79 foreach my $var (qw(SYSTEM_WGETRC WGETRC)) {
80     $ENV{$var} = '/dev/null';
81 }
82
83 my @tested;
84
85 foreach 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
91 foreach my $var (qw(SYSTEM_WGETRC WGETRC)) {
92     delete $ENV{$var};
93 }
94
95 my %exit = (
96     pass    => 0,
97     fail    => 1,
98     skip    => 2,
99     unknown => 3, # or greater
100 );
101
102 my %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
109 print "\n";
110 foreach 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
117 my $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
127 my $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
150 print "\n";
151 print $count->('fail') || $count->('unknown')
152   ? colored($summary, 'red')
153   : colored($summary, 'green');
154 print "\n";
155
156 exit $count->('fail') + $count->('unknown');