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 | ||
76cc22ec | 21 | $VERSION = 1.03; |
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 NC |
29 | |
30 | sub new_inc { | |
31 | if (${^TAINT}) { | |
32 | @INC = @_; | |
33 | } else { | |
34 | @INC = (@_, '.'); | |
35 | } | |
36 | } | |
37 | ||
38 | sub set_opt { | |
39 | my $sep; | |
40 | if ($^O eq 'VMS') { | |
41 | $sep = '|'; | |
1ff5bc37 | 42 | } elsif ($^O eq 'MSWin32') { |
2adbc9b6 NC |
43 | $sep = ';'; |
44 | } else { | |
45 | $sep = ':'; | |
46 | } | |
47 | ||
48 | my $lib = join $sep, @_; | |
49 | if (exists $ENV{PERL5LIB}) { | |
50 | $ENV{PERL5LIB} = $lib . substr $ENV{PERL5LIB}, 0, 0; | |
51 | } else { | |
52 | $ENV{PERL5LIB} = $lib; | |
53 | } | |
54 | } | |
55 | ||
8fcfece7 NC |
56 | my @up_2_t = ('../../lib', '../../t'); |
57 | # This is incompatible with the import options. | |
58 | if (-f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext') { | |
59 | # We're being run from the top level. Try to change directory, and set | |
60 | # things up correctly. This is a 90% solution, but for hand-running tests, | |
61 | # that's good enough | |
a193a2db | 62 | if ($0 =~ s!^((?:ext|dist|cpan)[\\/][^\\/]+)[\//](.*\.t)$!$2!) { |
8fcfece7 NC |
63 | # Looks like a test in ext. |
64 | chdir $1 or die "Can't chdir '$1': $!"; | |
65 | new_inc(@up_2_t); | |
982c4793 NC |
66 | set_opt(@up_2_t); |
67 | $^X =~ s!^\./!../../!; | |
68 | $^X =~ s!^\.\\!..\\..\\!; | |
8fcfece7 NC |
69 | } else { |
70 | chdir 't' or die "Can't chdir 't': $!"; | |
71 | new_inc('../lib'); | |
76cc22ec | 72 | set_opt('../lib') if $0 =~ m!^lib/!; |
8fcfece7 NC |
73 | } |
74 | } else { | |
75 | new_inc('../lib'); | |
76 | } | |
2adbc9b6 NC |
77 | |
78 | sub import { | |
79 | my $self = shift; | |
80 | my $abs; | |
81 | foreach (@_) { | |
82 | if ($_ eq 'U2T') { | |
8fcfece7 | 83 | @new_inc = @up_2_t; |
76cc22ec NC |
84 | } elsif ($_ eq 'U1') { |
85 | @new_inc = '../lib'; | |
2adbc9b6 NC |
86 | } elsif ($_ eq 'NC') { |
87 | delete $ENV{PERL_CORE} | |
88 | } elsif ($_ eq 'A') { | |
89 | $abs = 1; | |
90 | } else { | |
91 | die "Unknown option '$_'"; | |
92 | } | |
93 | } | |
94 | ||
95 | if ($abs) { | |
96 | if(!@new_inc) { | |
97 | @new_inc = '../lib'; | |
98 | } | |
99 | @INC = @new_inc; | |
100 | require File::Spec::Functions; | |
101 | # Forcibly untaint this. | |
102 | @new_inc = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } | |
103 | @new_inc; | |
104 | $^X = File::Spec::Functions::rel2abs($^X); | |
105 | } | |
106 | ||
107 | if (@new_inc) { | |
108 | new_inc(@new_inc); | |
109 | set_opt(@new_inc); | |
110 | } | |
5ed59b83 | 111 | } |
a1910616 | 112 | |
7a315204 | 113 | $0 =~ s/\.dp$//; # for the test.deparse make target |
ec5f1610 RH |
114 | 1; |
115 |