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 |
3 | # Now instead of: |
4 | # |
5 | # BEGIN { |
6 | # chdir 't' if -d 't'; |
7 | # @INC = '../lib'; |
8 | # } |
9 | # |
c1b78184 |
10 | # Its primary purpose is to clear @INC so core tests don't pick up |
11 | # modules from an installed Perl. |
12 | # |
db7c4376 |
13 | # t/TEST will use -MTestInit. You may "use TestInit" in the test |
14 | # programs but it is not required. |
4343e7c3 |
15 | # |
db7c4376 |
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 |
19 | package TestInit; |
20 | |
5ed59b83 |
21 | $VERSION = 1.02; |
2af1ab88 |
22 | |
2adbc9b6 |
23 | # This is incompatible with the import options. |
5ed59b83 |
24 | chdir 't' if -f 't/TestInit.pm'; |
a1910616 |
25 | |
5ed59b83 |
26 | # Let tests know they're running in the perl core. Useful for modules |
27 | # which live dual lives on CPAN. |
e447daf9 |
28 | # Don't interfere with the taintedness of %ENV, this could perturbate tests. |
29 | # This feels like a better solution than the original, from |
30 | # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2003-07/msg00154.html |
31 | $ENV{PERL_CORE} = $^X; |
2adbc9b6 |
32 | |
33 | sub new_inc { |
34 | if (${^TAINT}) { |
35 | @INC = @_; |
36 | } else { |
37 | @INC = (@_, '.'); |
38 | } |
39 | } |
40 | |
41 | sub set_opt { |
42 | my $sep; |
43 | if ($^O eq 'VMS') { |
44 | $sep = '|'; |
45 | } elsif ($^O eq 'Win32') { |
46 | $sep = ';'; |
47 | } else { |
48 | $sep = ':'; |
49 | } |
50 | |
51 | my $lib = join $sep, @_; |
52 | if (exists $ENV{PERL5LIB}) { |
53 | $ENV{PERL5LIB} = $lib . substr $ENV{PERL5LIB}, 0, 0; |
54 | } else { |
55 | $ENV{PERL5LIB} = $lib; |
56 | } |
57 | } |
58 | |
59 | new_inc('../lib'); |
60 | |
61 | sub import { |
62 | my $self = shift; |
63 | my $abs; |
64 | foreach (@_) { |
65 | if ($_ eq 'U2T') { |
66 | @new_inc = ('../../lib', '../../t'); |
67 | } elsif ($_ eq 'NC') { |
68 | delete $ENV{PERL_CORE} |
69 | } elsif ($_ eq 'A') { |
70 | $abs = 1; |
71 | } else { |
72 | die "Unknown option '$_'"; |
73 | } |
74 | } |
75 | |
76 | if ($abs) { |
77 | if(!@new_inc) { |
78 | @new_inc = '../lib'; |
79 | } |
80 | @INC = @new_inc; |
81 | require File::Spec::Functions; |
82 | # Forcibly untaint this. |
83 | @new_inc = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } |
84 | @new_inc; |
85 | $^X = File::Spec::Functions::rel2abs($^X); |
86 | } |
87 | |
88 | if (@new_inc) { |
89 | new_inc(@new_inc); |
90 | set_opt(@new_inc); |
91 | } |
5ed59b83 |
92 | } |
a1910616 |
93 | |
7a315204 |
94 | $0 =~ s/\.dp$//; # for the test.deparse make target |
ec5f1610 |
95 | 1; |
96 | |