Testbench::Regression

 

package Testbench::Regression;
require 5.000;
require Exporter;

use strict;
use vars qw ($Debug $VERSION $info $error $debug);
use Carp;
use IO::File;
use File::Find;
use Pod::Find qw(pod_where);
use Pod::Usage;

###############################################
#### Configuration Section 
$Debug = 0;
$VERSION = '1.1';

### message
$info  = "###(info) $0";
$error = "###(error) $0";
$debug = "###(debug) $0";

###############################################
###############################################
###############################################
sub new {
    @_>=1 or croak 'usage: Testbench::Regression->new({options})';
    my $class = shift;
    $class ||= "Testbench::Regression";
    my $self = {
        bfm => 'cpm',
        bfmdir => 'arm',
        tests => [],
        lefts => [],
        filter => [],
        filterout => [],
        message => [],
        nomessage => [],
        __tmp  => [],
        @_
    };
    bless $self, $class;
    return $self;
}

###############################################
## display class member for debugging
sub display {
    my $self=shift;
    print "bfm => $self->{bfm}\n";
    print "bfmdir => $self->{bfmdir}\n";
    $self->_print_refarray("tests");
    $self->_print_refarray("lefts");
    $self->_print_refarray("filter");
    $self->_print_refarray("filterout");
    $self->_print_refarray("message");
    $self->_print_refarray("nomessage");
}

## display usage and exit
sub usage {
    my $self=shift;
    my $v=shift;
    pod2usage( -input => pod_where({-inc=>1},__PACKAGE__), -verbose=>$v, -exitval=>1);
}

## Get all tests which meet requirement
sub gettests {
    my $self = shift;
    ## closure to support arguments
    find(sub{_process($self);},"../$self->{bfm}_tests");
    $self->_log_check();
    return @{$self->{tests}};
}

sub _process {
    my $self = shift;
    my $select = 1;
    my $reject = 0;
    ## only process directory
    if (-d) {
        if (/CVS/) {
            $File::Find::prune=1;
        }
        elsif (-d "$_/$self->{bfmdir}") {
            $File::Find::prune=1;
            # filter
            $select = _filter($self->{filter},$_,1);
            $reject = _filterout($self->{filterout},$_,1);
            $select |= _filter($self->{filter},$File::Find::name,0);
            $reject |= _filterout($self->{filterout},$File::Find::name,0);
            if (!$select || $reject) {
                push @{$self->{lefts}}, $File::Find::name;
                print "$debug: filtered out -- $File::Find::name\n" if $Debug;
            }
            else {
                push @{$self->{__tmp}}, $File::Find::name;
                print "$debug: matches -- $File::Find::name\n" if $Debug;
            }
            $select=1;
            $reject=0;
        }
    }
}

## check simulation report message
sub _log_check {
    my $self = shift;
    my $testdir = "$self->{bfm}_tests";
    if ( (ref($self->{message}) eq 'ARRAY' && @{$self->{message}}==0 ) && (ref($self->{nomessage}) eq 'ARRAY' && @{$self->{nomessage}}==0 ) ) {
        push @{$self->{tests}},@{$self->{__tmp}};
        print "$debug: not check message in log files\n" if $Debug;
        return;
    }

    # corresponding log file exist -> message has value --> if match then select else !select
    #                              -> message has no value -> select
    # corresponding log file not exist -> !select
    ##
    # corresponding log file exist -> nomessage has value --> if match then reject else !reject
    #                              -> nomessage has no value -> !reject
    # corresponding log file not exist -> !reject

    foreach my $testcase (@{$self->{__tmp}}) {
        my $select =0;    # file not exist, default value
        my $reject =0;    # file not exist, default value
        my $savecase = $testcase;
        $testcase =~ s!^.*/$testdir/!!;
        $testcase =~ s!/!.!;
        $testcase = "$testdir.$testcase";
        my @logfile = glob("./log/$testcase.log ./log/$testcase-*.log");
        foreach my $file (@logfile) {
            if ( -e $file ) {
                $select=_filter($self->{message}, '',0);  # empty file
                $reject=_filterout($self->{nomessage},'',0); # empty file
                print "$debug: checking log files -- $file\n" if $Debug;
                my $fh = IO::File->new("<$file");
                while (my $line= $fh->getline()) {
                    $select=_filter($self->{message}, $line,0);
                    $reject=_filterout($self->{nomessage}, $line,0);
                    if ($reject) { # once reject, then exit loop
                        last;
                    }
                    elsif ($select) { # not default, then exit loop
                        if(ref($self->{message}) eq 'ARRAY'){
                            last if (@{$self->{message}})
                        }
                        else {
                            last if $self->{message};
                        }
                    }
                }
                $fh->close;
            }
            else {
                $select =0;
                $reject =0;
            }
            $savecase="$savecase -seed $1" if ($file =~ m{\./log/$testcase-(\d+)\.log});
            if ($select & !$reject) {
                push @{$self->{tests}},$savecase;
                print "$debug: message expected in ./log/$testcase.log\n" if $Debug;
            }
            else {
                push @{$self->{lefts}},$savecase;
                print "$debug: message unexpected in ./log/$testcase.log\n" if $Debug;
            }
        }

    }
    @{$self->{__tmp}}=();
}

## parameter $self->{filter}, $File::Find::name, $isdirectory
## nothing compare return value  1, compared with matching, return 1, compared not matching retrun 0,
## return 1 means select
sub _filter {
    my ($filter,$mixture,$subdir) = @_;
    my $match = 1;
    if (ref($filter) eq 'ARRAY') {
        foreach my $pat (@$filter) {
            $match = 0;
            if (($subdir && -e "$mixture/$pat") || (!$subdir && $mixture =~ m{$pat})) {
                $match = 1;
                last;
            }
        }
    }
    else {
        foreach my $pat ($filter) {
            $match = 0;
            if (($subdir && -e "$mixture/$pat") || (!$subdir && $mixture =~ m{$pat})) {
                $match = 1;
                last;
            }
        }
    }
    return $match;
}

# filter out
## nothing compare return value  0, compared with matching, return 1, compared not matching retrun 0,
## return 1 means reject
sub _filterout {
    my ($filterout,$mixture,$subdir) = @_;
    my $del = 0;
    if (ref($filterout) eq 'ARRAY') {
        foreach my $pat (@$filterout) {
            if (($subdir && -e "$mixture/$pat") || (!$subdir && $mixture =~ m{$pat})) {
                $del = 1;
                last;
            }
        }
    }
    else {
        foreach my $pat ($filterout) {
            if (($subdir && -e "$mixture/$pat") || (!$subdir && $mixture =~ m{$pat})) {
                $del = 1;
                last;
            }
        }
    }
    return $del;
}

# display class member, for debugging
sub _print_refarray {
    my $self = shift;
    my $member = shift;
    if(defined $self->{$member}) {
        if ( ref($self->{$member}) eq 'ARRAY' ) {
            print "$member => [";
            foreach (@{$self->{$member}}) {
                print "           $_\n";
            }
            print "]\n";
        }
        else {
            print "$member =>\'$self->{$member}\'\n";
        }
    }

}

1;
__END__

#-----------------------------------------------------------
=pod

=head1 NAME

Testbench::Regression -- get the test collection which meets the requirements.

=head1 SYNOPSIS

     use Testbench::Regression;
     my $reg=new Testbench::Regression(bfmdir=>'ppc',filterout=>'hdl', filter=>['spi','uart']);
     my @tests=$reg->gettests(); 
     print "@tests \n";
     $reg->display();

=head1 DESCRIPTION

Testbench::Regression is used for dealing with regression tests filter for soc verification.
Some Typical Applications are listed here:

     1) find out all the testcases do not have 'hdl' directory in  and 'defines.v' files, these testcases
        can skip compilation to run simulation directly.

        filterout=>['hdl','defines.v']

     2) find out all testcases not sucessfully finished. ie. no log file or log file not contains successful message
        nomessage=>['Test PASS', 'BOOT OK']

     3) find out gpu testcases
        filter=>'gpu'

=over 4

=item $reg = new Testbench::Regression(params)

Testbench::Regression Constructor support following parameters

     <> bfm    => cpm/scm/vmm       complete processor or systemc or vmm BFM model
     <> bfmdir => ppc/scenario      directory identifies testcase, up directory is testname  
     <> filter => []                filter the testcase with pattern 
     <> filterout => []             filter out the testcase with pattern 
     <> message => []               filter the testcase with message pattern in corresponding log file
     <> nomessage => []             filter out the testcase with message pattern in corresponding log file

     filter and filter out use both exact and ambiguous matching policy.
     Only directory contains bfmdir is exactly matching. for instance:

     ../cpm_tests/dmac contains 'arm' and 'hdl' directory,
     if bfmdir=>'arm', filter=>'hd' will not match ../cpm_tests/dma/hdl.
     you must use filter=>'hdl'. but filter=>'dma' will match ../cpm_tests/dmac.

     filter and filter out pattern are parallel, testcase are selected/deselect once one pattern matches.

=item @tests=$reg->gettests();

Return filtered array, filtered out array left in @{$reg->{lefts}};

=item $reg->display();

Display all class member for Debugging;

=item $reg->usage(verbose);

print out the usage in pod fomat which is compact(verbose=1) or detail (verbose=2)

=item @{$reg->{tests}};

all collected test cases which meet requirments;

=item @{$reg->{lefts}};

filtered out test cases which do not meet requirments;

=back

=head1 AUTHOR

I<Michael.Kang  E<lt>[e-mail]<gt>>

Copyright (c) 2011 Verisilicon Verification Group

=head1 SEE ALSO

I<Testbench::Run>

=head1 VERSION HISTORY

v1.0  initial version

=cut