languages/tcl/t/harness

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::Harness qw/&runtests $verbose/;
   7 use File::Spec;
   8
   9 $verbose = 0;
  10
  11 my $language = "tcl";
  12
  13 =pod
  14
  15 conformant to a recent post on p6i, if I'm called with a single
  16 argument of "-files", I just return a list of files to process.
  17 This list is one per line, and is relative to the languages dir.
  18
  19 If I'm called with no args, I run the suite.
  20
  21 =cut
  22
  23 my @files;
  24
  25 # Setting these options helps flush out issues that might otherwise
  26 # happen to slip by.
  27
  28 my @required_options = qw/--gc-debug -D40/;
  29
  30
  31 $ENV{TEST_PROG_ARGS} = "" unless defined($ENV{TEST_PROG_ARGS});
  32
  33 foreach my $option (@required_options) {
  34   if ( $ENV{TEST_PROG_ARGS} !~ /\b$option\b/) {
  35     $ENV{TEST_PROG_ARGS} .= " $option";
  36   }
  37 }
  38
  39 my $DTotal = 0;
  40 while ($ENV{TEST_PROG_ARGS} =~ s/-D(\d*)//) {
  41   $DTotal += $1;
  42 }
  43
  44 if ($DTotal) {
  45   $ENV{TEST_PROG_ARGS} .= "-D$DTotal";
  46 }
  47
  48 if ( grep { /^--files$/ } @ARGV ) {
  49     # I must be running out of languages/
  50     my $dir = File::Spec->catfile( $language, "t" );
  51     my @files = glob( File::Spec->catfile( $dir, "*.t" ) );
  52     print join("\n",@files);
  53     print "\n" if @files;
  54     exit;
  55 } elsif (@ARGV) {
  56     # Someone specified tests for me to run.
  57     @files = grep {-f $_} @ARGV
  58 } else {
  59     # I must be running out of languages/$language
  60     # You may want a deeper search than this.
  61     @files = glob( File::Spec->catfile( "t", "*.t" ) );
  62 }
  63
  64 exit unless @files;
  65 print STDERR $ENV{TEST_PROG_ARGS};
  66 runtests(@files);
  67
  68 # Local Variables:
  69 #   mode: cperl
  70 #   cperl-indent-level: 4
  71 #   fill-column: 100
  72 # End:
  73 # vim: expandtab shiftwidth=4: