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.02; 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 30sub new_inc { 31 if (${^TAINT}) { 32 @INC = @_; 33 } else { 34 @INC = (@_, '.'); 35 } 36} 37 38sub set_opt { 39 my $sep; 40 if ($^O eq 'VMS') { 41 $sep = '|'; 42 } elsif ($^O eq 'MSWin32') { 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 56my @up_2_t = ('../../lib', '../../t'); 57# This is incompatible with the import options. 58if (-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 62 if ($0 =~ s!^((?:ext|dist|cpan)[\\/][^\\/]+)[\//](.*\.t)$!$2!) { 63 # Looks like a test in ext. 64 chdir $1 or die "Can't chdir '$1': $!"; 65 new_inc(@up_2_t); 66 set_opt(@up_2_t); 67 $^X =~ s!^\./!../../!; 68 $^X =~ s!^\.\\!..\\..\\!; 69 } else { 70 chdir 't' or die "Can't chdir 't': $!"; 71 new_inc('../lib'); 72 } 73} else { 74 new_inc('../lib'); 75} 76 77sub import { 78 my $self = shift; 79 my $abs; 80 foreach (@_) { 81 if ($_ eq 'U2T') { 82 @new_inc = @up_2_t; 83 } elsif ($_ eq 'NC') { 84 delete $ENV{PERL_CORE} 85 } elsif ($_ eq 'A') { 86 $abs = 1; 87 } else { 88 die "Unknown option '$_'"; 89 } 90 } 91 92 if ($abs) { 93 if(!@new_inc) { 94 @new_inc = '../lib'; 95 } 96 @INC = @new_inc; 97 require File::Spec::Functions; 98 # Forcibly untaint this. 99 @new_inc = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } 100 @new_inc; 101 $^X = File::Spec::Functions::rel2abs($^X); 102 } 103 104 if (@new_inc) { 105 new_inc(@new_inc); 106 set_opt(@new_inc); 107 } 108} 109 110$0 =~ s/\.dp$//; # for the test.deparse make target 1111; 112 113