Commit | Line | Data |
---|---|---|
4343e7c3 | 1 | # This is a replacement for the old BEGIN preamble which heads (or |
db7c4376 | 2 | # should head) up every core test program to prepare it for running. |
4343e7c3 MS |
3 | # Now instead of: |
4 | # | |
5 | # BEGIN { | |
6 | # chdir 't' if -d 't'; | |
7 | # @INC = '../lib'; | |
8 | # } | |
9 | # | |
c1b78184 MS |
10 | # Its primary purpose is to clear @INC so core tests don't pick up |
11 | # modules from an installed Perl. | |
12 | # | |
db7c4376 PG |
13 | # t/TEST will use -MTestInit. You may "use TestInit" in the test |
14 | # programs but it is not required. | |
4343e7c3 | 15 | # |
db7c4376 PG |
16 | # P.S. This documentation is not in POD format in order to avoid |
17 | # problems when there are fundamental bugs in perl. | |
4343e7c3 | 18 | |
18fc9488 DM |
19 | package TestInit; |
20 | ||
5c9e8bc6 | 21 | $VERSION = 1.04; |
2af1ab88 | 22 | |
5ed59b83 NC |
23 | # Let tests know they're running in the perl core. Useful for modules |
24 | # which live dual lives on CPAN. | |
e447daf9 NC |
25 | # Don't interfere with the taintedness of %ENV, this could perturbate tests. |
26 | # This feels like a better solution than the original, from | |
27 | # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2003-07/msg00154.html | |
28 | $ENV{PERL_CORE} = $^X; | |
2adbc9b6 | 29 | |
6bb18b54 NC |
30 | $0 =~ s/\.dp$//; # for the test.deparse make target |
31 | ||
2adbc9b6 NC |
32 | sub import { |
33 | my $self = shift; | |
b6800926 | 34 | my @up_2_t = ('../../lib', '../../t'); |
b6800926 | 35 | my ($abs, $chdir, $setopt); |
2adbc9b6 NC |
36 | foreach (@_) { |
37 | if ($_ eq 'U2T') { | |
09e28dd9 | 38 | @INC = @up_2_t; |
b6800926 | 39 | $setopt = 1; |
76cc22ec | 40 | } elsif ($_ eq 'U1') { |
09e28dd9 | 41 | @INC = '../lib'; |
b6800926 | 42 | $setopt = 1; |
2adbc9b6 NC |
43 | } elsif ($_ eq 'NC') { |
44 | delete $ENV{PERL_CORE} | |
45 | } elsif ($_ eq 'A') { | |
46 | $abs = 1; | |
a14453b9 NC |
47 | } elsif ($_ eq 'T') { |
48 | $chdir = '..' | |
49 | unless -f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext'; | |
09e28dd9 | 50 | @INC = 'lib'; |
a14453b9 | 51 | $setopt = 1; |
2adbc9b6 NC |
52 | } else { |
53 | die "Unknown option '$_'"; | |
54 | } | |
55 | } | |
56 | ||
b6800926 NC |
57 | # Need to default. This behaviour is consistent with previous behaviour, |
58 | # as the equivalent of this code used to be run at the top level, hence | |
59 | # would happen (unconditionally) before import() was called. | |
09e28dd9 | 60 | unless ($setopt) { |
b6800926 NC |
61 | if (-f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext') { |
62 | # We're being run from the top level. Try to change directory, and | |
63 | # set things up correctly. This is a 90% solution, but for | |
64 | # hand-running tests, that's good enough | |
d36b6fc6 | 65 | if ($0 =~ s!^((?:ext|dist|cpan)[\\/][^\\/]+)[\\/](.*\.t)$!$2!) { |
b6800926 NC |
66 | # Looks like a test in ext. |
67 | $chdir = $1; | |
09e28dd9 | 68 | @INC = @up_2_t; |
b6800926 | 69 | $setopt = 1; |
6bb18b54 | 70 | $^X =~ s!^\.([\\/])!..$1..$1!; |
b6800926 NC |
71 | } else { |
72 | $chdir = 't'; | |
09e28dd9 | 73 | @INC = '../lib'; |
b6800926 NC |
74 | $setopt = $0 =~ m!^lib/!; |
75 | } | |
76 | } else { | |
77 | # (likely) we're being run by t/TEST or t/harness, and we're a test | |
78 | # in t/ | |
e1498de2 FC |
79 | if (defined &DynaLoader::boot_DynaLoader) { |
80 | @INC = '../lib'; | |
81 | } | |
82 | else { | |
83 | # miniperl/minitest | |
84 | # t/TEST does not supply -I../lib, so buildcustomize.pl is | |
85 | # not automatically included. | |
86 | unshift @INC, '../lib'; | |
87 | do "../lib/buildcustomize.pl"; | |
88 | } | |
2adbc9b6 | 89 | } |
b6800926 NC |
90 | } |
91 | ||
92 | if (defined $chdir) { | |
93 | chdir $chdir or die "Can't chdir '$chdir': $!"; | |
94 | } | |
95 | ||
96 | if ($abs) { | |
2adbc9b6 NC |
97 | require File::Spec::Functions; |
98 | # Forcibly untaint this. | |
09e28dd9 | 99 | @INC = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } @INC; |
2adbc9b6 NC |
100 | $^X = File::Spec::Functions::rel2abs($^X); |
101 | } | |
102 | ||
db6ebcbf NC |
103 | if ($setopt) { |
104 | my $sep; | |
105 | if ($^O eq 'VMS') { | |
106 | $sep = '|'; | |
107 | } elsif ($^O eq 'MSWin32') { | |
108 | $sep = ';'; | |
109 | } else { | |
110 | $sep = ':'; | |
111 | } | |
112 | ||
09e28dd9 | 113 | my $lib = join $sep, @INC; |
db6ebcbf NC |
114 | if (exists $ENV{PERL5LIB}) { |
115 | $ENV{PERL5LIB} = $lib . substr $ENV{PERL5LIB}, 0, 0; | |
116 | } else { | |
117 | $ENV{PERL5LIB} = $lib; | |
118 | } | |
119 | } | |
09e28dd9 NC |
120 | |
121 | push @INC, '.' unless ${^TAINT}; | |
5ed59b83 | 122 | } |
a1910616 | 123 | |
ec5f1610 | 124 | 1; |