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# 4# BEGIN { 5# chdir 't' if -d 't'; 6# @INC = '../lib'; 7# } 8# 9# Its primary purpose is to clear @INC so core tests don't pick up 10# modules from an installed Perl. 11# 12# t/TEST and t/harness will invoke each test script with 13# perl -I. -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. 34# 35# P.S. This documentation is not in POD format in order to avoid 36# problems when there are fundamental bugs in perl. 37 38package TestInit; 39 40$VERSION = 1.04; 41 42# Let tests know they're running in the perl core. Useful for modules 43# which live dual lives on CPAN. 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; 48 49$0 =~ s/\.dp$//; # for the test.deparse make target 50 51my $add_dot = (@INC && $INC[-1] eq '.'); # preserve existing, 52 53sub import { 54 my $self = shift; 55 my @up_2_t = ('../../lib', '../../t'); 56 my ($abs, $chdir, $setopt); 57 foreach (@_) { 58 if ($_ eq 'U2T') { 59 @INC = @up_2_t; 60 $setopt = 1; 61 } elsif ($_ eq 'U1') { 62 @INC = '../lib'; 63 $setopt = 1; 64 } elsif ($_ eq 'NC') { 65 delete $ENV{PERL_CORE} 66 } elsif ($_ eq 'A') { 67 $abs = 1; 68 } elsif ($_ eq 'T') { 69 $chdir = '..' 70 unless -f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext'; 71 @INC = 'lib'; 72 $setopt = 1; 73 } elsif ($_ eq 'DOT') { 74 $add_dot = 1; 75 } else { 76 die "Unknown option '$_'"; 77 } 78 } 79 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. 83 unless ($setopt) { 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 88 if ($0 =~ s!^((?:ext|dist|cpan)[\\/][^\\/]+)[\\/](.*\.t)$!$2!) { 89 # Looks like a test in ext. 90 $chdir = $1; 91 @INC = @up_2_t; 92 $setopt = 1; 93 $^X =~ s!^\.([\\/])!..$1..$1!; 94 } else { 95 $chdir = 't'; 96 @INC = '../lib'; 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/ 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 } 112 } 113 } 114 115 if (defined $chdir) { 116 chdir $chdir or die "Can't chdir '$chdir': $!"; 117 } 118 119 if ($abs) { 120 require File::Spec::Functions; 121 # Forcibly untaint this. 122 @INC = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } @INC; 123 $^X = File::Spec::Functions::rel2abs($^X); 124 } 125 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 136 my $lib = join $sep, @INC; 137 if (exists $ENV{PERL5LIB}) { 138 $ENV{PERL5LIB} = $lib . substr $ENV{PERL5LIB}, 0, 0; 139 } else { 140 $ENV{PERL5LIB} = $lib; 141 } 142 } 143 144 push @INC, '.' if $add_dot; 145} 146 1471; 148