root/tests/testsuite.pl

#!/usr/bin/perl -w
# -----------------------------
# Test Suite Runner:
# ./testsuite -c <crules bin-path> -t <test-folder> -r <results>
#
# author: RedBrain ( Philip Herron )
# maintainer: RedBrain
# -----------------------------

use utf8;

use strict;
use IPC::Open3;
use Getopt::Long;
use Pod::Usage;

use Test::Simple tests => 18;

my $crl_bin_path = '../src/crules';
my $crl_test_path = 't/';
my $crl_res_path = 'r/';

sub check_results {
    my $oa = $_[0];
    my $ob = $_[1];
    my $curr_test = $_[2];

    ok( $oa eq $ob, "Test: $curr_test" );
}

sub get_correct_results {

    my $tr = substr( $_[0], 0, -4);
    $tr = substr( $tr, 2 );
    my $trr= $tr . ".r";
    my $rr = $crl_res_path . $trr;

    open( DAT, $rr ) || die("Error: opening results file <$rr>!\n");
    my @raw_data = <DAT>;
    close(DAT);

    my $len= scalar(@raw_data);
    my $str; my $it= 0;
    while ( $it < $len ) {
        if ( $raw_data[ $it ] =~ /TestIdent/ ) {
            print "Testing: $raw_data[ $it ]";
        }
        else {
            $str = $str . $raw_data[ $it ];
        }
        $it++;
    }

    return ( $str );
}

sub exec_test {
    # the test should be the first argument!
    my $ct = $_[0];
    my($wtr, $rdr, $err);
    use Symbol 'gensym'; $err = gensym;

    print "Atempting to run test: $ct!\n";
    my $time1 = time;
    my $pid = open3( $wtr, $rdr, $err,
                     "$crl_bin_path", "$ct" );

    waitpid( $pid, 0 );
    my $child_exit_status = $? >> 8;
    my @rstdout = <$rdr>;
    if( $child_exit_status != 0 ) {
        die("test $ct did not exit cleanly exit code <$child_exit_status>!\n");
    }

    my $time2 = time; my $lent= $time2 - $time1;
    print "Test $ct took: $lent!\n";

    my $len= scalar(@rstdout);
    my $str; my $it= 0;
    while ( $it < $len ) {
        $str = $str . $rstdout[ $it ];
        $it++;
    }
    return ( $str );
}

sub main {

    my @t_files = <$crl_test_path*.crl>;
    my @r_files = <$crl_res_path*.r>;

    ## find lengths!
    my $tl = scalar( @t_files );
    my $rl = scalar( @r_files );

    if( $tl == $rl )
    {
        foreach( @t_files ) {
            my $retval_t = &exec_test( $_ );
            my $retval_r = &get_correct_results( $_ );
            &check_results( $retval_t, $retval_r, $_ );
            print "\n"; # just to space out the verbose output!
        }
    }
    else
    {
        print "Error: un-equal number of tests and results!\n";
        # work on giving more details...
    }
}

&main( );