Commit | Line | Data |
a5f75d66 |
1 | #!./perl |
2 | |
3 | # We suppose that perl _mostly_ works at this moment, so may use |
4 | # sophisticated testing. |
5 | |
aa689395 |
6 | BEGIN { |
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 |
12 | my $torture; # torture testing? |
13 | |
a5f75d66 |
14 | use Test::Harness; |
15 | |
ef712cf7 |
16 | $Test::Harness::switches = ""; # Too much noise otherwise |
90ce63d5 |
17 | $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v'; |
a5f75d66 |
18 | |
12558422 |
19 | if ($ARGV[0] && $ARGV[0] eq '-torture') { |
e018f8be |
20 | shift; |
21 | $torture = 1; |
22 | } |
23 | |
60e23f2f |
24 | # Let tests know they're running in the perl core. Useful for modules |
25 | # which live dual lives on CPAN. |
26 | $ENV{PERL_CORE} = 1; |
27 | |
0ca04487 |
28 | #fudge DATA for now. |
29 | %datahandle = qw( |
30 | lib/bigint.t 1 |
31 | lib/bigintpm.t 1 |
32 | lib/bigfloat.t 1 |
33 | lib/bigfloatpm.t 1 |
34 | op/gv.t 1 |
35 | lib/complex.t 1 |
36 | lib/ph.t 1 |
37 | lib/soundex.t 1 |
38 | op/misc.t 1 |
39 | op/runlevel.t 1 |
40 | op/tie.t 1 |
41 | op/lex_assign.t 1 |
0ca04487 |
42 | ); |
43 | |
44 | foreach (keys %datahandle) { |
45 | unlink "$_.t"; |
46 | } |
47 | |
122a0375 |
48 | my @tests = (); |
49 | |
40996b78 |
50 | # [.VMS]TEST.COM calls harness with empty arguments, so clean-up @ARGV |
51 | @ARGV = grep $_ && length( $_ ) => @ARGV; |
52 | |
6234cb77 |
53 | sub _populate_hash { |
54 | return map {$_, 1} split /\s+/, $_[0]; |
55 | } |
56 | |
12558422 |
57 | if ($ARGV[0] && $ARGV[0]=~/^-re/) { |
8a76aa1f |
58 | if ($ARGV[0]!~/=/) { |
59 | shift; |
60 | $re=join "|",@ARGV; |
61 | @ARGV=(); |
62 | } else { |
63 | (undef,$re)=split/=/,shift; |
64 | } |
65 | } |
66 | |
7a315204 |
67 | if (@ARGV) { |
4efb34a6 |
68 | if ($^O eq 'MSWin32') { |
69 | @tests = map(glob($_),@ARGV); |
70 | } |
71 | else { |
72 | @tests = @ARGV; |
73 | } |
7a315204 |
74 | } else { |
b695f709 |
75 | unless (@tests) { |
122a0375 |
76 | push @tests, <base/*.t>; |
77 | push @tests, <comp/*.t>; |
78 | push @tests, <cmd/*.t>; |
79 | push @tests, <run/*.t>; |
80 | push @tests, <io/*.t>; |
81 | push @tests, <op/*.t>; |
37fca15e |
82 | push @tests, <uni/*.t>; |
122a0375 |
83 | push @tests, <lib/*.t>; |
e018f8be |
84 | push @tests, <japh/*.t> if $torture; |
bb27e7b6 |
85 | push @tests, <win32/*.t> if $^O eq 'MSWin32'; |
6234cb77 |
86 | use Config; |
87 | my %skip; |
88 | { |
89 | my %extensions = _populate_hash $Config{'extensions'}; |
90 | my %known_extensions = _populate_hash $Config{'known_extensions'}; |
91 | foreach (keys %known_extensions) { |
92 | $skip{$_}++ unless $extensions{$_}; |
93 | } |
94 | } |
b695f709 |
95 | use File::Spec; |
96 | my $updir = File::Spec->updir; |
122a0375 |
97 | my $mani = File::Spec->catfile(File::Spec->updir, "MANIFEST"); |
b695f709 |
98 | if (open(MANI, $mani)) { |
b1d1c89d |
99 | my @manitests = (); |
00701878 |
100 | my $ext_pat = $^O eq 'MSWin32' ? '(?:win32/)?ext' : 'ext'; |
b695f709 |
101 | while (<MANI>) { # similar code in t/TEST |
00701878 |
102 | if (m!^($ext_pat/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) { |
6234cb77 |
103 | my ($test, $extension) = ($1, $2); |
104 | if (defined $extension) { |
105 | $extension =~ s!/t$!!; |
106 | # XXX Do I want to warn that I'm skipping these? |
107 | next if $skip{$extension}; |
108 | } |
b1d1c89d |
109 | push @manitests, File::Spec->catfile($updir, $test); |
b695f709 |
110 | } |
7a315204 |
111 | } |
35d88760 |
112 | close MANI; |
b1d1c89d |
113 | # Sort the list of test files read from MANIFEST into a sensible |
114 | # order instead of using the order in which they are listed there |
115 | push @tests, sort { lc $a cmp lc $b } @manitests; |
b695f709 |
116 | } else { |
117 | warn "$0: cannot open $mani: $!\n"; |
7a315204 |
118 | } |
b695f709 |
119 | push @tests, <pod/*.t>; |
5e52531c |
120 | push @tests, <x2p/*.t>; |
7a315204 |
121 | } |
122 | } |
22a65f1e |
123 | if ($^O eq 'MSWin32') { |
124 | s,\\,/,g for @tests; |
125 | } |
8a76aa1f |
126 | @tests=grep /$re/, @tests |
127 | if $re; |
a5f75d66 |
128 | Test::Harness::runtests @tests; |
de125441 |
129 | exit(0); |