X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a14453b94fa229e50f3dc0e7cc4b9a763b933cb6..6deb7a5e3707524fd23c0080d6a762ff30e50494:/TestInit.pm?ds=sidebyside diff --git a/TestInit.pm b/TestInit.pm index c921686..16eb318 100644 --- a/TestInit.pm +++ b/TestInit.pm @@ -27,43 +27,18 @@ $VERSION = 1.04; # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2003-07/msg00154.html $ENV{PERL_CORE} = $^X; -sub new_inc { - if (${^TAINT}) { - @INC = @_; - } else { - @INC = (@_, '.'); - } -} - -sub set_opt { - my $sep; - if ($^O eq 'VMS') { - $sep = '|'; - } elsif ($^O eq 'MSWin32') { - $sep = ';'; - } else { - $sep = ':'; - } - - my $lib = join $sep, @_; - if (exists $ENV{PERL5LIB}) { - $ENV{PERL5LIB} = $lib . substr $ENV{PERL5LIB}, 0, 0; - } else { - $ENV{PERL5LIB} = $lib; - } -} +$0 =~ s/\.dp$//; # for the test.deparse make target sub import { my $self = shift; my @up_2_t = ('../../lib', '../../t'); - my @new_inc; my ($abs, $chdir, $setopt); foreach (@_) { if ($_ eq 'U2T') { - @new_inc = @up_2_t; + @INC = @up_2_t; $setopt = 1; } elsif ($_ eq 'U1') { - @new_inc = '../lib'; + @INC = '../lib'; $setopt = 1; } elsif ($_ eq 'NC') { delete $ENV{PERL_CORE} @@ -72,7 +47,7 @@ sub import { } elsif ($_ eq 'T') { $chdir = '..' unless -f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext'; - @new_inc = 'lib'; + @INC = 'lib'; $setopt = 1; } else { die "Unknown option '$_'"; @@ -82,26 +57,26 @@ sub import { # Need to default. This behaviour is consistent with previous behaviour, # as the equivalent of this code used to be run at the top level, hence # would happen (unconditionally) before import() was called. - unless (@new_inc) { + unless ($setopt) { if (-f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext') { # We're being run from the top level. Try to change directory, and # set things up correctly. This is a 90% solution, but for # hand-running tests, that's good enough - if ($0 =~ s!^((?:ext|dist|cpan)[\\/][^\\/]+)[\//](.*\.t)$!$2!) { + if ($0 =~ s!^((?:ext|dist|cpan)[\\/][^\\/]+)[\\/](.*\.t)$!$2!) { # Looks like a test in ext. $chdir = $1; - @new_inc = @up_2_t; + @INC = @up_2_t; $setopt = 1; - $^X =~ s!^\.([/\\])!..$1..$1!; + $^X =~ s!^\.([\\/])!..$1..$1!; } else { $chdir = 't'; - @new_inc = '../lib'; + @INC = '../lib'; $setopt = $0 =~ m!^lib/!; } } else { # (likely) we're being run by t/TEST or t/harness, and we're a test # in t/ - @new_inc = '../lib'; + @INC = '../lib'; } } @@ -110,18 +85,31 @@ sub import { } if ($abs) { - @INC = @new_inc; require File::Spec::Functions; # Forcibly untaint this. - @new_inc = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } - @new_inc; + @INC = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } @INC; $^X = File::Spec::Functions::rel2abs($^X); } - new_inc(@new_inc); - set_opt(@new_inc) if $setopt; + if ($setopt) { + my $sep; + if ($^O eq 'VMS') { + $sep = '|'; + } elsif ($^O eq 'MSWin32') { + $sep = ';'; + } else { + $sep = ':'; + } + + my $lib = join $sep, @INC; + if (exists $ENV{PERL5LIB}) { + $ENV{PERL5LIB} = $lib . substr $ENV{PERL5LIB}, 0, 0; + } else { + $ENV{PERL5LIB} = $lib; + } + } + + push @INC, '.' unless ${^TAINT}; } -$0 =~ s/\.dp$//; # for the test.deparse make target 1; -