1# This is a replacement for the old BEGIN preamble which heads (or 2# should head) up every core test program to prepare it for running. 3# Now instead of: 4# 5# BEGIN { 6# chdir 't' if -d 't'; 7# @INC = '../lib'; 8# } 9# 10# Its primary purpose is to clear @INC so core tests don't pick up 11# modules from an installed Perl. 12# 13# t/TEST will use -MTestInit. You may "use TestInit" in the test 14# programs but it is not required. 15# 16# P.S. This documentation is not in POD format in order to avoid 17# problems when there are fundamental bugs in perl. 18 19package TestInit; 20 21$VERSION = 1.04; 22 23# Let tests know they're running in the perl core. Useful for modules 24# which live dual lives on CPAN. 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; 29 30$0 =~ s/\.dp$//; # for the test.deparse make target 31 32sub import { 33 my $self = shift; 34 my @up_2_t = ('../../lib', '../../t'); 35 my ($abs, $chdir, $setopt); 36 foreach (@_) { 37 if ($_ eq 'U2T') { 38 @INC = @up_2_t; 39 $setopt = 1; 40 } elsif ($_ eq 'U1') { 41 @INC = '../lib'; 42 $setopt = 1; 43 } elsif ($_ eq 'NC') { 44 delete $ENV{PERL_CORE} 45 } elsif ($_ eq 'A') { 46 $abs = 1; 47 } elsif ($_ eq 'T') { 48 $chdir = '..' 49 unless -f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext'; 50 @INC = 'lib'; 51 $setopt = 1; 52 } else { 53 die "Unknown option '$_'"; 54 } 55 } 56 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. 60 unless ($setopt) { 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 65 if ($0 =~ s!^((?:ext|dist|cpan)[\\/][^\\/]+)[\\/](.*\.t)$!$2!) { 66 # Looks like a test in ext. 67 $chdir = $1; 68 @INC = @up_2_t; 69 $setopt = 1; 70 $^X =~ s!^\.([\\/])!..$1..$1!; 71 } else { 72 $chdir = 't'; 73 @INC = '../lib'; 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/ 79 @INC = '../lib'; 80 } 81 } 82 83 if (defined $chdir) { 84 chdir $chdir or die "Can't chdir '$chdir': $!"; 85 } 86 87 if ($abs) { 88 require File::Spec::Functions; 89 # Forcibly untaint this. 90 @INC = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } @INC; 91 $^X = File::Spec::Functions::rel2abs($^X); 92 } 93 94 if ($setopt) { 95 my $sep; 96 if ($^O eq 'VMS') { 97 $sep = '|'; 98 } elsif ($^O eq 'MSWin32') { 99 $sep = ';'; 100 } else { 101 $sep = ':'; 102 } 103 104 my $lib = join $sep, @INC; 105 if (exists $ENV{PERL5LIB}) { 106 $ENV{PERL5LIB} = $lib . substr $ENV{PERL5LIB}, 0, 0; 107 } else { 108 $ENV{PERL5LIB} = $lib; 109 } 110 } 111 112 push @INC, '.' unless ${^TAINT}; 113} 114 1151; 116