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'; require './charset_tools.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 pragma to test from file name '$file'";
  21
  22 $| = 1;
  23
  24 my @w_files;
  25
  26 if (@ARGV) {
  27     print "ARGV = [@ARGV]\n";
  28     @w_files = map { "./lib/$pragma_name/$_" } @ARGV;
  29 } else {
  30     @w_files = sort grep !/( \.rej | ~ | \ \(Autosaved\)\.txt ) \z/nx,
  31                          glob catfile(curdir(), "lib", $pragma_name, "*");
  32 }
  33
  34 if ($::IS_EBCDIC) { # Skip Latin1 files
  35     @w_files = grep { $_ !~ / _l1 $/x } @w_files
  36 }
  37
  38 my ($tests, @prgs) = setup_multiple_progs(@w_files);
  39
  40 $^X = rel2abs($^X);
  41 @INC = map { rel2abs($_) } @INC;
  42 my $tempdir = tempfile;
  43
  44 mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
  45 chdir $tempdir or die die "Can't chdir '$tempdir': $!";
  46 my $cleanup = 1;
  47
  48 END {
  49     if ($cleanup) {
  50         chdir '..' or die "Couldn't chdir .. for cleanup: $!";
  51         rmtree($tempdir);
  52     }
  53 }
  54
  55 if ($::local_tests && $::local_tests =~ /\D/) {
  56     # If input is 'no_plan', pass it on unchanged
  57     plan $::local_tests;
  58 } else {
  59     plan $tests + ($::local_tests || 0);
  60 }
  61
  62 run_multiple_progs('../..', @prgs);
  63
  64 1;