#!/usr/bin/perl # # usage: t.rules/run [--verbose] [--tests=BOUNCE_MESSAGE,FOO,BAR] [file ...] # # TODO: Generate TAP output use strict; use warnings; use Getopt::Long; Getopt::Long::Configure( qw(bundling no_getopt_compat permute no_auto_abbrev no_ignore_case) ); my %opt = ( ); GetOptions( 'tests|t=s' => \$opt{'tests'}, 'verbose|v' => \$opt{'verbose'}, ); my $verbose = $opt{'verbose'}; $opt{'tests'} ||= join " ", ; my $testsfailed = 0; if (@ARGV) { foreach my $f (@ARGV) { test_msg($f, $1); } } else { main(); } exit $testsfailed; sub main { foreach my $rule (split(/[\s,]/, $opt{'tests'})) { $rule =~ s/^t.rules\///; chomp $rule; my $ruledir="t.rules/$rule"; next unless -d $ruledir; warn "\nRunning tests for $rule:\n" if $verbose; foreach my $f (<$ruledir/*>) { (-f $f) and test_msg($f); } } } sub test_msg { my ($f) = @_; ($f =~ /\/([^\/]+)\/[^\/]+$/) or warn "cannot find rule in '$f'"; my $rule = $1; # if the filename starts with "fp", we want a _miss_ for the named rule my $want_hit = 1; if ($f =~ /\/fp/i) { $want_hit = 0; } my $testsline; open (IN, "./spamassassin --cf='use_bayes 0' --cf='use_awl 0' -D -Lt < $f 2>&1 |") or warn "sa failed"; open (LOG, ">o.log") or die; while () { print LOG; /check: tests=(.*)$/ and $testsline = $1; /check: subtests=(.*)$/ and $testsline .= ",$1"; } close IN; close LOG; if ($testsline =~ /(?:[ ,]|^)\Q$rule\E(?:[ ,]|$)/) { if ($want_hit) { pass($rule, $f, "$testsline"); } else { fail($rule, $f, "want=n got=y: $testsline"); } } else { if ($want_hit) { fail($rule, $f, "want=y got=n: $testsline"); } else { pass($rule, $f, "$testsline"); } } } sub fail { my ($rule, $f, $err) = @_; print "NOT ok on $f for $rule: $err\n"; $testsfailed++; } sub pass { my ($rule, $f, $err) = @_; if (!$verbose) { print "ok on $f\n" } else { print "ok on $f for $rule: $err\n" } }