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 | 12 | # t/TEST and t/harness will invoke each test script with |
524a2f33 | 13 | # perl -I. -MTestInit[=arg,arg,..] some/test.t |
19641fd7 DM |
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 | |
0e9a4b85 MM |
46 | # Message-ID: 20030703145818.5bdd2873.rgarciasuarez@free.fr |
47 | # https://www.nntp.perl.org/group/perl.perl5.porters/2003/07/msg77533.html | |
e447daf9 | 48 | $ENV{PERL_CORE} = $^X; |
2adbc9b6 | 49 | |
6bb18b54 NC |
50 | $0 =~ s/\.dp$//; # for the test.deparse make target |
51 | ||
19641fd7 DM |
52 | my $add_dot = (@INC && $INC[-1] eq '.'); # preserve existing, |
53 | ||
2adbc9b6 NC |
54 | sub import { |
55 | my $self = shift; | |
b6800926 | 56 | my @up_2_t = ('../../lib', '../../t'); |
b6800926 | 57 | my ($abs, $chdir, $setopt); |
2adbc9b6 NC |
58 | foreach (@_) { |
59 | if ($_ eq 'U2T') { | |
09e28dd9 | 60 | @INC = @up_2_t; |
b6800926 | 61 | $setopt = 1; |
76cc22ec | 62 | } elsif ($_ eq 'U1') { |
09e28dd9 | 63 | @INC = '../lib'; |
b6800926 | 64 | $setopt = 1; |
2adbc9b6 NC |
65 | } elsif ($_ eq 'NC') { |
66 | delete $ENV{PERL_CORE} | |
67 | } elsif ($_ eq 'A') { | |
68 | $abs = 1; | |
a14453b9 NC |
69 | } elsif ($_ eq 'T') { |
70 | $chdir = '..' | |
71 | unless -f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext'; | |
19641fd7 | 72 | @INC = 'lib'; |
a14453b9 | 73 | $setopt = 1; |
19641fd7 DM |
74 | } elsif ($_ eq 'DOT') { |
75 | $add_dot = 1; | |
2adbc9b6 NC |
76 | } else { |
77 | die "Unknown option '$_'"; | |
78 | } | |
79 | } | |
80 | ||
b6800926 NC |
81 | # Need to default. This behaviour is consistent with previous behaviour, |
82 | # as the equivalent of this code used to be run at the top level, hence | |
83 | # would happen (unconditionally) before import() was called. | |
09e28dd9 | 84 | unless ($setopt) { |
b6800926 NC |
85 | if (-f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext') { |
86 | # We're being run from the top level. Try to change directory, and | |
87 | # set things up correctly. This is a 90% solution, but for | |
88 | # hand-running tests, that's good enough | |
d36b6fc6 | 89 | if ($0 =~ s!^((?:ext|dist|cpan)[\\/][^\\/]+)[\\/](.*\.t)$!$2!) { |
b6800926 NC |
90 | # Looks like a test in ext. |
91 | $chdir = $1; | |
09e28dd9 | 92 | @INC = @up_2_t; |
b6800926 | 93 | $setopt = 1; |
6bb18b54 | 94 | $^X =~ s!^\.([\\/])!..$1..$1!; |
b6800926 NC |
95 | } else { |
96 | $chdir = 't'; | |
09e28dd9 | 97 | @INC = '../lib'; |
b6800926 NC |
98 | $setopt = $0 =~ m!^lib/!; |
99 | } | |
100 | } else { | |
101 | # (likely) we're being run by t/TEST or t/harness, and we're a test | |
102 | # in t/ | |
e1498de2 FC |
103 | if (defined &DynaLoader::boot_DynaLoader) { |
104 | @INC = '../lib'; | |
105 | } | |
106 | else { | |
107 | # miniperl/minitest | |
108 | # t/TEST does not supply -I../lib, so buildcustomize.pl is | |
109 | # not automatically included. | |
110 | unshift @INC, '../lib'; | |
111 | do "../lib/buildcustomize.pl"; | |
112 | } | |
2adbc9b6 | 113 | } |
b6800926 NC |
114 | } |
115 | ||
116 | if (defined $chdir) { | |
117 | chdir $chdir or die "Can't chdir '$chdir': $!"; | |
118 | } | |
119 | ||
120 | if ($abs) { | |
2adbc9b6 NC |
121 | require File::Spec::Functions; |
122 | # Forcibly untaint this. | |
09e28dd9 | 123 | @INC = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } @INC; |
2adbc9b6 NC |
124 | $^X = File::Spec::Functions::rel2abs($^X); |
125 | } | |
126 | ||
db6ebcbf NC |
127 | if ($setopt) { |
128 | my $sep; | |
129 | if ($^O eq 'VMS') { | |
130 | $sep = '|'; | |
131 | } elsif ($^O eq 'MSWin32') { | |
132 | $sep = ';'; | |
133 | } else { | |
134 | $sep = ':'; | |
135 | } | |
136 | ||
09e28dd9 | 137 | my $lib = join $sep, @INC; |
db6ebcbf NC |
138 | if (exists $ENV{PERL5LIB}) { |
139 | $ENV{PERL5LIB} = $lib . substr $ENV{PERL5LIB}, 0, 0; | |
140 | } else { | |
141 | $ENV{PERL5LIB} = $lib; | |
142 | } | |
143 | } | |
09e28dd9 | 144 | |
19641fd7 | 145 | push @INC, '.' if $add_dot; |
5ed59b83 | 146 | } |
a1910616 | 147 | |
ec5f1610 | 148 | 1; |