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; |
56eca212 |
129 | exit(0) unless -e "../testcompile"; |
130 | |
e4f0d88d |
131 | # %infinite = qw ( |
132 | # op/bop.t 1 |
133 | # lib/hostname.t 1 |
134 | # op/lex_assign.t 1 |
595ae481 |
135 | # lib/ph.t 1 |
e4f0d88d |
136 | # ); |
56eca212 |
137 | |
138 | my $dhwrapper = <<'EOT'; |
139 | open DATA,"<".__FILE__; |
140 | until (($_=<DATA>) =~ /^__END__/) {}; |
141 | EOT |
52cebf5e |
142 | |
143 | @tests = grep (!$infinite{$_}, @tests); |
56eca212 |
144 | @tests = map { |
ef712cf7 |
145 | my $new = $_; |
adac82c7 |
146 | if ($datahandle{$_} && !( -f "$new.t") ) { |
ef712cf7 |
147 | $new .= '.t'; |
148 | local(*F, *T); |
149 | open(F,"<$_") or die "Can't open $_: $!"; |
150 | open(T,">$new") or die "Can't open $new: $!"; |
151 | print T $dhwrapper, <F>; |
152 | close F; |
153 | close T; |
154 | } |
155 | $new; |
156 | } @tests; |
157 | |
158 | print "The tests ", join(' ', keys(%infinite)), |
159 | " generate infinite loops! Skipping!\n"; |
160 | |
595ae481 |
161 | $ENV{'HARNESS_COMPILE_TEST'} = 1; |
9636a016 |
162 | $ENV{'PERLCC_TIMEOUT'} = 120 unless $ENV{'PERLCC_TIMEOUT'}; |
ef712cf7 |
163 | |
595ae481 |
164 | Test::Harness::runtests @tests; |
56eca212 |
165 | foreach (keys %datahandle) { |
166 | unlink "$_.t"; |
52cebf5e |
167 | } |