head	1.4;
access;
symbols;
locks; strict;
comment	@# @;


1.4
date	2000.04.13.09.53.32;	author phil;	state Exp;
branches;
next	1.3;

1.3
date	99.11.13.17.45.16;	author phil;	state Exp;
branches;
next	1.2;

1.2
date	98.09.17.02.00.32;	author phil;	state Exp;
branches;
next	1.1;

1.1
date	98.09.16.23.49.59;	author phil;	state Exp;
branches;
next	;


desc
@@


1.4
log
@*** empty log message ***
@
text
@#!/usr/bin/perl

# $Id: debian-test,v 1.3 1999/11/13 17:45:16 phil Exp phil $
# Copyright (c) 1998 Philip Hands <phil@@hands.com>
#
# This program is distributable under the terms of the GPL

#---
#  Usage: debian-test [options] <package-name> ...
#         debian-test -a [options]
# Options:
#    -q   produces no output
#    -v   asks tests to be verbose, by passing on the -v option
#    -i   allows tests to be interactive
#    -a   runs all tests
#    -s   prints success/failure summary

$DT_DIR = "/usr/lib/debian-test" ;
$ENV{'DEBIANTEST_LIB'} = $DT_DIR . "/lib" ;

use Getopt::Std ;

getopts('aimsqv');

# print the usage message 
sub usage {
  printf "Usage: debian-test [options] [<package-name> ...]
    -q   quiet (produces no output)
    -v   asks tests to be verbose, by passing on the -v option
    -i   allows tests to be interactive (by passing on the -i option)
    -a   runs all tests.
    -s   prints success/failure summary for each test
    -m   mail report (currently disabled)

Either the -a option, or the name(s) of the package(s) to be tested
must be specified, but not both.\n"
}


# Given a package name, find the associated test
sub pkg_tests($) {
  my ($pkg) = @@_ ;
  my $try ;
  
  for $try ( "tests/$pkg", "default-tests/$pkg" ) {
    if (-f "$DT_DIR/$try") { return ($try) }
    if (-d "$DT_DIR/$try") {
      opendir(TRY, "$DT_DIR/$try" ) || next ;
      my @@tests = grep { s#^(test-.*)$#$try/\1# } readdir(TRY) ;
      closedir(TRY) ;
      return(@@tests) if (@@tests) ;
    }
  }
}


# run the test(s) for a package
sub run_tests($) {
  my($pkg) = @@_ ;
  my $test ;
  my $test_cnt=0, $test_fail_cnt=0;

  for $test (pkg_tests($pkg)) {
    chdir($DT_DIR) || die ;
    open(TEST, "$test |") || die ;
    while(<TEST>) {
      $test_cnt++ if (/debian-test RESULT:/) ;
      $test_fail_cnt++  if (/debian-test RESULT: .*: FAILED/) ;
      
      next if $opt_q ;
      if ($opt_v) {
	if (/debian-test (.*)$/) {
	  print "$test: $1\n" ;
	} else {
	  chomp;
	  printf "$test: [%s]\n", $_ ;
	}
      } else {
	if (/debian-test RESULT: (.*): FAILED/) {
	  print "$test: $1: failed\n" ;
	} elsif  (/debian-test MESSAGE: (.*)$/) {
	  print "$test: $1\n" ;
	}
      } 
    }
    close(TEST) ;
  }

  printf ("%-20s Tests Run: %2d, Tests Failed: %2d\n",
	  $pkg . ":", $test_cnt, $test_fail_cnt)
      if ($opt_s) ;

  return($test_fail_cnt == 0) ;
}

sub all_tests() {
  my (%testflag) ;

  for $dir ("tests", "default-tests") {
    $fulldir = $DT_DIR . '/' . $dir ;
    opendir(DIR, $fulldir) || die "opening $fulldir" ;
    while ($_=readdir(DIR)) {
      my($name) = $_ ;

      next if ($name eq "." || $name eq ".." || /~$/ || /.bak$/) ;
      $fullname = $fulldir . '/' . $name ;
      if (-f $fullname && -x $fullname) {
	$testflag{$name} = 1 ;
      }
      if (-d $fullname && (@@subtests = glob($fullname . '/test-*'))) {
	foreach (@@subtests) {
	  if (-f && -x) {
	    $testflag{$name} = 1 ;
	    last ;
	  }
	}
      }
    }
    closedir(DIR) ;
  }
  return (keys(%testflag)) ;
}


# --- Main program starts here ---

# check that -a or some args, but not both have been specified
unless ($opt_a xor @@ARGV) {
  usage() ;
  exit 2 ;
}

# run the tests
my $return_val = 0;

foreach ($opt_a ? all_tests() : @@ARGV) {
  $return_val = 1 unless run_tests( $_ ) ;
}

exit($return_val) ;

# Local variables:
# perl-indent-level: 2
# End:
__END__
@


1.3
log
@add proper code to handle tests in subdirectories
@
text
@d3 1
a3 1
# $Id: debian-test,v 1.2 1998/09/17 02:00:32 phil Exp phil $
d16 1
d23 1
a23 1
getopts('aimqv');
d32 1
d61 1
d67 3
d75 2
a76 1
	  print ;
d88 6
d130 1
a130 1
  exit 1 ;
d134 2
d137 1
a137 1
  run_tests( $_ ) ;
d139 2
@


1.2
log
@first working version
@
text
@d3 1
a3 1
# $Id: debian-test,v 1.1 1998/09/16 23:49:59 phil Exp phil $
d33 2
a34 2
  Either the -a option, or the name(s) of the package(s) to be tested
  must be specified, but not both.\n"
d42 1
a42 1

d44 7
a50 2
    if (-f $try) { return ($try) } ;
    if (-d $try) { return (glob($try . '/test-*')) } ;
d58 1
d125 3
@


1.1
log
@Initial revision
@
text
@d3 2
a4 2
# $Id:$
# Copyright (c) 1998 Philip Hands <http://www.hands.com/~phil/>
d6 1
a6 1
# This program is distributed under the terms of the GPL
d17 2
a18 1
$TESTDIR = "/usr/lib/debian-test" ;
d24 1
d37 10
a46 6
sub run_test {
 if  -f "
print "Run: " ;
if ($opt_v) { print "verbose " }
if ($opt_q) { print "quiet " }
print $_, "\n" ;
d49 23
a71 23
####
# Given a package name, find the associated test
sub find_tests {
  if (@@_) {
    foreach $pkg (@@_) {
      my($r) ;
      if ($r = find_test($pkg)) push(@@result, $r);
    }
    else {
      
    }
  
  opendir(DIR, $TESTDIR) ;
  while ($_=readdir(DIR)) {
    next if ($_ eq "." || $_ eq ".." || $_ eq "DEFAULT") ;
    next if (/~$/ || /.bak$/) ;
    next if (/^Functions/) ;
    $testname = ${TESTDIR} . "/" . $_ ;
    if (-f $testname && -x $testname) {
      $relative_path{"main",$testname} = $_ ;
    }
    elsif (-d $testname && -x "$testname/main") {
      $relative_path{"main",$testname} = $_/main ;
d73 1
d75 1
d77 2
d80 21
a100 1
        
d102 1
a102 1
  closedir(DIR) ;
d106 2
d114 4
a117 1
@@tests = findtests(@@ARGV) ;
d119 1
a119 3
foreach (@@ARGV) {
  run_test($_);
}
@
