minions/bin/autotest.pl

#!/usr/bin/perl -w

## Author: Alois Mahdal at zxcvb cz
# my private testing helper script

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.


use v5.10;
use warnings;

$PLATFORM   = (-d "c:\\windows" ? 'windows' : 'unix' );
$DUMPS      = "dumps";
$TESTS      = "t";
$COLORS     = { windows => { ok => 'color 0a', nok => 'color 0c' } };

sub clear {
    if ($PLATFORM eq 'windows') {
        system "cls";
    } elsif ($PLATFORM eq 'unix') {
        system "clear";
    }
}

sub color {
	$mood = shift;
	$cmd = $COLORS->{$PLATFORM}->{$mood};
	system ($cmd) if $cmd;
}

sub cat {
	$_  = shift;
    my ($name) = m|^.*/(.*?)$|;
    printf "$name:\n";
    if (open my $fh,  "<", $_) {
        my @lines = <$fh>;
        print @lines, "\n";
        close $fh or die "cannot close $_"
    }
    else {
        warn "cannot open $_";
        next STDERR;
    }
}

sub run_tests {
    my $ret = 0;
	printf "===== STDOUT =====\n";
	foreach (@_) {
        s|^$TESTS/*||;
        say "$_:"; 
		$cmd = sprintf 'perl %s 2>%s', "$TESTS\\$_", "$DUMPS\\$_.err";
		system($cmd);
		$ret = $? >> 8;
        if ($ret) {
            print "last test failed with exit code $ret!\n";
            return;
        }
	}
	return 1;
}

sub freakout {
    my $ret = shift;
	color "nok";
	my @paths = glob "$DUMPS/*.err";
	printf "\n===== STDERR =====\n";
    STDERR: foreach (@paths) {
        cat $_ and unlink $_ or warn "could not print $_";
    }
}

mkdir $DUMPS unless -d $DUMPS;

while (1) {
	my @paths = glob "$TESTS/*.t";
	&clear;
	color "ok";
    my $ok = &run_tests(@paths);
    if ($ok) {
        say "------------------";
        say "All tests finished.";
    } else {
        &freakout();
    }
	sleep 5;
}