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