t/lib/common.pl

   1 # This code is used by lib/charnames.t, lib/croak.t, lib/feature.t,
   2 # lib/subs.t, lib/strict.t and lib/warnings.t
   3 #
   4 # On input, $::local_tests is the number of tests in the caller; or
   5 # 'no_plan' if unknown, in which case it is the caller's responsibility
   6 # to call cur_test() to find out how many this executed
   7
   8 BEGIN {
   9     require './test.pl';
  10 }
  11
  12 use Config;
  13 use File::Path;
  14 use File::Spec::Functions qw(catfile curdir rel2abs);
  15
  16 use strict;
  17 use warnings;
  18 my (undef, $file) = caller;
  19 my ($pragma_name) = $file =~ /([A-Za-z_0-9]+)\.t$/
  20     or die "Can't identify pragama to test from file name '$file'";
  21
  22 $| = 1;
  23
  24 my @prgs = () ;
  25 my @w_files = () ;
  26
  27 if (@ARGV)
  28   { print "ARGV = [@ARGV]\n" ;
  29       @w_files = map { s#^#./lib/$pragma_name/#; $_ } @ARGV
  30   }
  31 else
  32   { @w_files = sort glob(catfile(curdir(), "lib", $pragma_name, "*")) }
  33
  34 my $files = 0;
  35 foreach my $file (@w_files) {
  36
  37     next if $file =~ /(~|\.orig|,v)$/;
  38     next if $file =~ /perlio$/ && !(find PerlIO::Layer 'perlio');
  39     next if -d $file;
  40
  41     open my $fh, '<', $file or die "Cannot open $file: $!\n" ;
  42     my $line = 0;
  43     my $found;
  44     while (<$fh>) {
  45         $line++;
  46         if (/^__END__/) {
  47             ++$found;
  48             last;
  49         }
  50     }
  51     # This is an internal error, and should never happen. All bar one of the
  52     # files had an __END__ marker to signal the end of their preamble, although
  53     # for some it wasn't technically necessary as they have no tests.
  54     # It might be possible to process files without an __END__ by seeking back
  55     # to the start and treating the whole file as tests, but it's simpler and
  56     # more reliable just to make the rule that all files must have __END__ in.
  57     # This should never fail - a file without an __END__ should not have been
  58     # checked in, because the regression tests would not have passed.
  59     die "Could not find '__END__' in $file"
  60         unless $found;
  61
  62     {
  63         local $/ = undef;
  64         $files++;
  65         @prgs = (@prgs, $file, split "\n########\n", <$fh>) ;
  66     }
  67     close $fh;
  68 }
  69
  70 $^X = rel2abs($^X);
  71 @INC = map { rel2abs($_) } @INC;
  72 my $tempdir = tempfile;
  73
  74 mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
  75 chdir $tempdir or die die "Can't chdir '$tempdir': $!";
  76 my $cleanup = 1;
  77
  78 END {
  79     if ($cleanup) {
  80         chdir '..' or die "Couldn't chdir .. for cleanup: $!";
  81         rmtree($tempdir);
  82     }
  83 }
  84
  85 local $/ = undef;
  86
  87 my $tests = $::local_tests || 0;
  88 $tests = scalar(@prgs)-$files + $tests if $tests !~ /\D/;
  89 plan $tests;    # If input is 'no_plan', pass it on unchanged
  90
  91 run_multiple_progs('../..', @prgs);
  92
  93 1;