This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
As rules can be glob patterns, leave them as glob patterns, and instead
[perl5.git] / t / harness
CommitLineData
a5f75d66
AD
1#!./perl
2
3# We suppose that perl _mostly_ works at this moment, so may use
4# sophisticated testing.
5
aa689395
PP
6BEGIN {
7 chdir 't' if -d 't';
122a0375 8 @INC = '../lib'; # pick up only this build's lib
ef712cf7 9 $ENV{PERL5LIB} = '../lib'; # so children will see it too
aa689395 10}
aa689395 11
e018f8be
JH
12my $torture; # torture testing?
13
a5f75d66 14use Test::Harness;
9a4933c3 15use strict;
a5f75d66 16
ef712cf7 17$Test::Harness::switches = ""; # Too much noise otherwise
9d6c4c89 18$Test::Harness::Verbose++ while @ARGV && $ARGV[0] eq '-v' && shift;
a5f75d66 19
12558422 20if ($ARGV[0] && $ARGV[0] eq '-torture') {
e018f8be
JH
21 shift;
22 $torture = 1;
23}
24
60e23f2f
MS
25# Let tests know they're running in the perl core. Useful for modules
26# which live dual lives on CPAN.
27$ENV{PERL_CORE} = 1;
28
0ca04487 29#fudge DATA for now.
9a4933c3 30my %datahandle = qw(
0ca04487
VB
31 lib/bigint.t 1
32 lib/bigintpm.t 1
33 lib/bigfloat.t 1
34 lib/bigfloatpm.t 1
35 op/gv.t 1
36 lib/complex.t 1
37 lib/ph.t 1
38 lib/soundex.t 1
39 op/misc.t 1
40 op/runlevel.t 1
41 op/tie.t 1
42 op/lex_assign.t 1
0ca04487
VB
43 );
44
45foreach (keys %datahandle) {
46 unlink "$_.t";
47}
48
9ae5a6c3 49my (@tests, $rules, $re);
122a0375 50
40996b78
AT
51# [.VMS]TEST.COM calls harness with empty arguments, so clean-up @ARGV
52@ARGV = grep $_ && length( $_ ) => @ARGV;
53
6234cb77
NC
54sub _populate_hash {
55 return map {$_, 1} split /\s+/, $_[0];
56}
57
9ae5a6c3
NC
58sub _glob_and_parallelise {
59 my @dirs;
60 # Run the tests in each of these directories in sequence, but the
61 # directories themselves can be parallelised.
62 foreach (@_) {
0ae187c2 63 push @dirs, { seq => "$_/*.t" };
9ae5a6c3
NC
64 }
65 { par => \@dirs };
66}
67
68# Generate T::H schedule rules that run the contents of each directory
69# sequentially.
70sub _seq_dir_rules {
71 my @tests = @_;
72 my %dir;
73 for (@tests) {
74 s{[^/]+$}{\*};
75 $dir{$_}++;
76 }
77
78 return { par => [ map { { seq => $_ } } sort keys %dir ] };
79}
80
81sub _extract_tests;
82sub _extract_tests {
83 # This can probably be done more tersely with a map, but I doubt that it
84 # would be as clear
85 my @results;
86 foreach (@_) {
87 my $ref = ref $_;
88 if ($ref) {
89 if ($ref eq 'ARRAY') {
90 push @results, _extract_tests @$_;
91 } elsif ($ref eq 'HASH') {
92 push @results, _extract_tests values %$_;
93 } else {
94 die "Unknown reference type $ref";
95 }
96 } else {
0ae187c2 97 push @results, glob $_;
9ae5a6c3
NC
98 }
99 }
100 @results;
101}
102
12558422 103if ($ARGV[0] && $ARGV[0]=~/^-re/) {
8a76aa1f
YO
104 if ($ARGV[0]!~/=/) {
105 shift;
106 $re=join "|",@ARGV;
107 @ARGV=();
108 } else {
109 (undef,$re)=split/=/,shift;
110 }
111}
112
7a315204 113if (@ARGV) {
4efb34a6
NIS
114 if ($^O eq 'MSWin32') {
115 @tests = map(glob($_),@ARGV);
116 }
117 else {
118 @tests = @ARGV;
119 }
7a315204 120} else {
9ae5a6c3
NC
121 # Ideally we'd get somewhere close to Tux's Oslo rules
122 # my $rules = {
123 # par => [
124 # { seq => '../ext/DB_File/t/*' },
125 # { seq => '../ext/IO_Compress_Zlib/t/*' },
126 # { seq => '../lib/CPANPLUS/*' },
127 # { seq => '../lib/ExtUtils/t/*' },
128 # '*'
129 # ]
130 # };
131
132 # but for now, run all directories in sequence. In particular, it would be
133 # nice to get the tests in t/op/*.t able to run in parallel.
134
b695f709 135 unless (@tests) {
9ae5a6c3
NC
136 my @seq;
137 push @seq, <base/*.t>;
138
139 push @seq, _glob_and_parallelise qw(comp cmd run io);
e6867818 140 my @next = qw(uni mro lib);
9ae5a6c3
NC
141 push @next, 'japh' if $torture;
142 push @next, 'win32' if $^O eq 'MSWin32';
e6867818
NC
143 push @seq, { par => [
144 {seq => [ glob "op/*.t" ]},
145 map { glob "$_/*.t" } @next
146 ] };
9ae5a6c3
NC
147
148 my @last;
6234cb77
NC
149 use Config;
150 my %skip;
151 {
152 my %extensions = _populate_hash $Config{'extensions'};
153 my %known_extensions = _populate_hash $Config{'known_extensions'};
154 foreach (keys %known_extensions) {
155 $skip{$_}++ unless $extensions{$_};
156 }
157 }
b695f709
JH
158 use File::Spec;
159 my $updir = File::Spec->updir;
122a0375 160 my $mani = File::Spec->catfile(File::Spec->updir, "MANIFEST");
b695f709 161 if (open(MANI, $mani)) {
b1d1c89d 162 my @manitests = ();
00701878 163 my $ext_pat = $^O eq 'MSWin32' ? '(?:win32/)?ext' : 'ext';
b695f709 164 while (<MANI>) { # similar code in t/TEST
00701878 165 if (m!^($ext_pat/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) {
6234cb77
NC
166 my ($test, $extension) = ($1, $2);
167 if (defined $extension) {
168 $extension =~ s!/t$!!;
169 # XXX Do I want to warn that I'm skipping these?
170 next if $skip{$extension};
171 }
b1d1c89d 172 push @manitests, File::Spec->catfile($updir, $test);
b695f709 173 }
7a315204 174 }
35d88760 175 close MANI;
b1d1c89d
SH
176 # Sort the list of test files read from MANIFEST into a sensible
177 # order instead of using the order in which they are listed there
9ae5a6c3 178 push @last, sort { lc $a cmp lc $b } @manitests;
b695f709
JH
179 } else {
180 warn "$0: cannot open $mani: $!\n";
7a315204 181 }
9ae5a6c3
NC
182 push @last, <Module_Pluggable/*.t>;
183 push @last, <pod/*.t>;
184 push @last, <x2p/*.t>;
185
186 @tests = (_extract_tests (@seq), @last);
187
188 push @seq, _seq_dir_rules @last;
189
190 $rules = { seq => \@seq };
191
7a315204
JH
192 }
193}
22a65f1e
GS
194if ($^O eq 'MSWin32') {
195 s,\\,/,g for @tests;
196}
8a76aa1f
YO
197@tests=grep /$re/, @tests
198 if $re;
9ae5a6c3
NC
199
200my $jobs = $ENV{TEST_JOBS};
201if ($jobs) {
202 eval 'use TAP::Harness 3.13; 1' or die $@;
203 my $h = TAP::Harness->new({ jobs => $jobs, rules => $rules});
204 $h->runtests(@tests);
205} else {
206 Test::Harness::runtests @tests;
207}
de125441 208exit(0);