TestInit.pm

   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
  38 package TestInit;
  39
  40 our $VERSION = 1.05;
  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 # Message-ID: [email protected]
  47 # https://www.nntp.perl.org/group/perl.perl5.porters/2003/07/msg77533.html
  48 $ENV{PERL_CORE} = $^X;
  49
  50 $0 =~ s/\.dp$//; # for the test.deparse make target
  51
  52 my $add_dot = (@INC && $INC[-1] eq '.'); # preserve existing,
  53
  54 sub import {
  55     my $self = shift;
  56     my @up_2_t = ('../../lib', '../../t');
  57     my ($abs, $chdir, $setopt);
  58     foreach (@_) {
  59         if ($_ eq 'U2T') {
  60             @INC = @up_2_t;
  61             $setopt = 1;
  62         } elsif ($_ eq 'U1') {
  63             @INC = '../lib';
  64             $setopt = 1;
  65         } elsif ($_ eq 'NC') {
  66             delete $ENV{PERL_CORE}
  67         } elsif ($_ eq 'A') {
  68             $abs = 1;
  69         } elsif ($_ eq 'T') {
  70             $chdir = '..'
  71                 unless -f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext';
  72             @INC = 'lib';
  73             $setopt = 1;
  74         } elsif ($_ eq 'DOT') {
  75             $add_dot = 1;
  76         } else {
  77             die "Unknown option '$_'";
  78         }
  79     }
  80
  81     # Need to default. This behaviour is consistent with previous behaviour,
  82     # as the equivalent of this code used to be run at the top level, hence
  83     # would happen (unconditionally) before import() was called.
  84     unless ($setopt) {
  85         if (-f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext') {
  86             # We're being run from the top level. Try to change directory, and
  87             # set things up correctly. This is a 90% solution, but for
  88             # hand-running tests, that's good enough
  89             if ($0 =~ s!^((?:ext|dist|cpan)[\\/][^\\/]+)[\\/](.*\.t)$!$2!) {
  90                 # Looks like a test in ext.
  91                 $chdir = $1;
  92                 @INC = @up_2_t;
  93                 $setopt = 1;
  94                 $^X =~ s!^\.([\\/])!..$1..$1!;
  95             } else {
  96                 $chdir = 't';
  97                 @INC = '../lib';
  98                 $setopt = $0 =~ m!^lib/!;
  99             }
 100         } else {
 101             # (likely) we're being run by t/TEST or t/harness, and we're a test
 102             # in t/
 103             if (defined &DynaLoader::boot_DynaLoader) {
 104                 @INC = '../lib';
 105             }
 106             else {
 107                 # miniperl/minitest
 108                 # t/TEST does not supply -I../lib, so buildcustomize.pl is
 109                 # not automatically included.
 110                 unshift @INC, '../lib';
 111                 do "../lib/buildcustomize.pl";
 112             }
 113         }
 114     }
 115
 116     if (defined $chdir) {
 117         chdir $chdir or die "Can't chdir '$chdir': $!";
 118     }
 119
 120     if ($abs) {
 121         require File::Spec::Functions;
 122         # Forcibly untaint this.
 123         @INC = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } @INC;
 124         $^X = File::Spec::Functions::rel2abs($^X);
 125     }
 126
 127     if ($setopt) {
 128         my $sep;
 129         if ($^O eq 'VMS') {
 130             $sep = '|';
 131         } elsif ($^O eq 'MSWin32') {
 132             $sep = ';';
 133         } else {
 134             $sep = ':';
 135         }
 136
 137         my $lib = join $sep, @INC;
 138         if (exists $ENV{PERL5LIB}) {
 139             $ENV{PERL5LIB} = $lib . substr $ENV{PERL5LIB}, 0, 0;
 140         } else {
 141             $ENV{PERL5LIB} = $lib;
 142         }
 143     }
 144
 145     push @INC, '.' if $add_dot;
 146 }
 147
 148 1;