source: trunk/third/perl/t/harness @ 18450

Revision 18450, 2.9 KB checked in by zacheiss, 22 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r18449, which included commits to RCS files with non-trunk default branches.
  • Property svn:executable set to *
Line 
1#!./perl
2
3# We suppose that perl _mostly_ works at this moment, so may use
4# sophisticated testing.
5
6BEGIN {
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
12my $torture; # torture testing?
13
14use Test::Harness;
15
16$Test::Harness::switches = "";    # Too much noise otherwise
17$Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v';
18
19if ($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
44foreach (keys %datahandle) {
45     unlink "$_.t";
46}
47
48my @tests = ();
49
50if (@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}
86if ($^O eq 'MSWin32') {
87    s,\\,/,g for @tests;
88}
89Test::Harness::runtests @tests;
90exit(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
99my $dhwrapper = <<'EOT';
100open DATA,"<".__FILE__;
101until (($_=<DATA>) =~ /^__END__/) {};
102EOT
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
119print "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
125Test::Harness::runtests @tests;
126foreach (keys %datahandle) {
127     unlink "$_.t";
128}
Note: See TracBrowser for help on using the repository browser.