1 | #!./perl |
---|
2 | |
---|
3 | # We suppose that perl _mostly_ works at this moment, so may use |
---|
4 | # sophisticated testing. |
---|
5 | |
---|
6 | BEGIN { |
---|
7 | chdir 't' if -d 't'; |
---|
8 | @INC = '../lib'; # pick up only this build's lib |
---|
9 | $ENV{PERL5LIB} = '../lib'; # so children will see it too |
---|
10 | } |
---|
11 | |
---|
12 | my $torture; # torture testing? |
---|
13 | |
---|
14 | use Test::Harness; |
---|
15 | |
---|
16 | $Test::Harness::switches = ""; # Too much noise otherwise |
---|
17 | $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v'; |
---|
18 | |
---|
19 | if ($ARGV[0] eq '-torture') { |
---|
20 | shift; |
---|
21 | $torture = 1; |
---|
22 | } |
---|
23 | |
---|
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 | |
---|
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 |
---|
42 | ); |
---|
43 | |
---|
44 | foreach (keys %datahandle) { |
---|
45 | unlink "$_.t"; |
---|
46 | } |
---|
47 | |
---|
48 | my @tests = (); |
---|
49 | |
---|
50 | if (@ARGV) { |
---|
51 | if ($^O eq 'MSWin32') { |
---|
52 | @tests = map(glob($_),@ARGV); |
---|
53 | } |
---|
54 | else { |
---|
55 | @tests = @ARGV; |
---|
56 | } |
---|
57 | } else { |
---|
58 | unless (@tests) { |
---|
59 | push @tests, <base/*.t>; |
---|
60 | push @tests, <comp/*.t>; |
---|
61 | push @tests, <cmd/*.t>; |
---|
62 | push @tests, <run/*.t>; |
---|
63 | push @tests, <io/*.t>; |
---|
64 | push @tests, <op/*.t>; |
---|
65 | push @tests, <uni/*.t>; |
---|
66 | push @tests, <lib/*.t>; |
---|
67 | push @tests, <japh/*.t> if $torture; |
---|
68 | push @tests, <win32/*.t> if $^O eq 'MSWin32'; |
---|
69 | use File::Spec; |
---|
70 | my $updir = File::Spec->updir; |
---|
71 | my $mani = File::Spec->catfile(File::Spec->updir, "MANIFEST"); |
---|
72 | if (open(MANI, $mani)) { |
---|
73 | while (<MANI>) { # similar code in t/TEST |
---|
74 | if (m!^(ext/\S+/?(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) { |
---|
75 | push @tests, File::Spec->catfile($updir, $1); |
---|
76 | } |
---|
77 | } |
---|
78 | close MANI; |
---|
79 | } else { |
---|
80 | warn "$0: cannot open $mani: $!\n"; |
---|
81 | } |
---|
82 | push @tests, <pod/*.t>; |
---|
83 | push @tests, <x2p/*.t>; |
---|
84 | } |
---|
85 | } |
---|
86 | if ($^O eq 'MSWin32') { |
---|
87 | s,\\,/,g for @tests; |
---|
88 | } |
---|
89 | Test::Harness::runtests @tests; |
---|
90 | exit(0) unless -e "../testcompile"; |
---|
91 | |
---|
92 | # %infinite = qw ( |
---|
93 | # op/bop.t 1 |
---|
94 | # lib/hostname.t 1 |
---|
95 | # op/lex_assign.t 1 |
---|
96 | # lib/ph.t 1 |
---|
97 | # ); |
---|
98 | |
---|
99 | my $dhwrapper = <<'EOT'; |
---|
100 | open DATA,"<".__FILE__; |
---|
101 | until (($_=<DATA>) =~ /^__END__/) {}; |
---|
102 | EOT |
---|
103 | |
---|
104 | @tests = grep (!$infinite{$_}, @tests); |
---|
105 | @tests = map { |
---|
106 | my $new = $_; |
---|
107 | if ($datahandle{$_} && !( -f "$new.t") ) { |
---|
108 | $new .= '.t'; |
---|
109 | local(*F, *T); |
---|
110 | open(F,"<$_") or die "Can't open $_: $!"; |
---|
111 | open(T,">$new") or die "Can't open $new: $!"; |
---|
112 | print T $dhwrapper, <F>; |
---|
113 | close F; |
---|
114 | close T; |
---|
115 | } |
---|
116 | $new; |
---|
117 | } @tests; |
---|
118 | |
---|
119 | print "The tests ", join(' ', keys(%infinite)), |
---|
120 | " generate infinite loops! Skipping!\n"; |
---|
121 | |
---|
122 | $ENV{'HARNESS_COMPILE_TEST'} = 1; |
---|
123 | $ENV{'PERLCC_TIMEOUT'} = 120 unless $ENV{'PERLCC_TIMEOUT'}; |
---|
124 | |
---|
125 | Test::Harness::runtests @tests; |
---|
126 | foreach (keys %datahandle) { |
---|
127 | unlink "$_.t"; |
---|
128 | } |
---|