204 lines
6.7 KiB
Perl
204 lines
6.7 KiB
Perl
|
#
|
||
|
|
# Module for parsing and loading regression test lists.
|
||
|
|
#
|
||
|
|
|
||
|
|
package RegressionList;
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
|
||
|
|
our $VERSION = '1.01';
|
||
|
|
|
||
|
|
use base 'Exporter';
|
||
|
|
|
||
|
|
our @EXPORT = qw(read_regression_list @testlist %srcpath %testtype
|
||
|
|
%args %plargs %diff %gold %unordered %testmod %offset);
|
||
|
|
|
||
|
|
# Properties of each test.
|
||
|
|
# It may be nicer to have read_regression_list return an array
|
||
|
|
# of hashes with these as keys.
|
||
|
|
our (@testlist, %srcpath, %testtype, %args, %plargs,
|
||
|
|
%diff, %gold, %unordered, %testmod, %offset) = ();
|
||
|
|
|
||
|
|
#
|
||
|
|
# Parses the regression list file
|
||
|
|
#
|
||
|
|
# Parameters:
|
||
|
|
# $regress_fn = file name to read tests from.
|
||
|
|
# $ver = iverilog version.
|
||
|
|
#
|
||
|
|
# (from left-to-right in regression file):
|
||
|
|
#
|
||
|
|
# test_name type,opt_ivl_args test_dir opt_module_name log/gold_file
|
||
|
|
#
|
||
|
|
# type can be:
|
||
|
|
# normal
|
||
|
|
# CO = compile only.
|
||
|
|
# CE = compile error.
|
||
|
|
# CN = compile null.
|
||
|
|
# RE = runtime error.
|
||
|
|
# EF = expected fail.
|
||
|
|
# NI = not implemented.
|
||
|
|
#
|
||
|
|
sub read_regression_list {
|
||
|
|
my $regress_fn = shift
|
||
|
|
or die "No regression list file name specified";
|
||
|
|
my $ver = shift
|
||
|
|
or die "No iverilog version specified";
|
||
|
|
my $force_sv = shift;
|
||
|
|
my $opt = shift;
|
||
|
|
|
||
|
|
my ($line, @fields, $tname, $tver, %nameidx, $options);
|
||
|
|
open (REGRESS_LIST, "<$regress_fn") or
|
||
|
|
die "Error: unable to open $regress_fn for reading.\n";
|
||
|
|
|
||
|
|
while ($line = <REGRESS_LIST>) {
|
||
|
|
# can't use chomp here - in MSYS2 it only consumes the LF, not the CR
|
||
|
|
$line =~ s/\r?\n?$//;
|
||
|
|
# recognise a trailing '\' as a line continuation
|
||
|
|
if ($line =~ s/\\$//) {
|
||
|
|
my $next_line = <REGRESS_LIST>;
|
||
|
|
$next_line =~ s/^\s+//;
|
||
|
|
$line .= $next_line;
|
||
|
|
redo unless eof(REGRESS_LIST);
|
||
|
|
}
|
||
|
|
next if ($line =~ /^\s*#/); # Skip comments.
|
||
|
|
next if ($line =~ /^\s*$/); # Skip blank lines.
|
||
|
|
|
||
|
|
$line =~ s/#.*$//; # Strip in line comments.
|
||
|
|
$line =~ s/\s+$//; # Strip trailing white space.
|
||
|
|
|
||
|
|
@fields = split(' ', $line);
|
||
|
|
if (@fields < 2) {
|
||
|
|
die "Error: $fields[0] must have at least 3 fields.\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
$tname = $fields[0];
|
||
|
|
if ($tname =~ /:/) {
|
||
|
|
($tver, $tname) = split(":", $tname);
|
||
|
|
# Skip if this is not our version or option.
|
||
|
|
next if (($tver ne "v$ver") && ($tver ne $opt));
|
||
|
|
} else {
|
||
|
|
next if (exists($testtype{$tname})); # Skip if already defined.
|
||
|
|
}
|
||
|
|
|
||
|
|
# Get the test type and the iverilog argument(s). Separate the
|
||
|
|
# arguments with a space.
|
||
|
|
if ($fields[1] =~ ',') {
|
||
|
|
($testtype{$tname},$args{$tname}) = split(',', $fields[1], 2);
|
||
|
|
if ($args{$tname} =~ ',') {
|
||
|
|
my @args = split(',', $args{$tname});
|
||
|
|
$plargs{$tname} = join(' ', grep(/^\+/, @args));
|
||
|
|
$args{$tname} = join(' ', grep(!/^\+/, @args));
|
||
|
|
} elsif ($args{$tname} =~ /^\+/) {
|
||
|
|
$plargs{$tname} = $args{$tname};
|
||
|
|
$args{$tname} = "";
|
||
|
|
} else {
|
||
|
|
$plargs{$tname} = "";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$testtype{$tname} = $fields[1];
|
||
|
|
$plargs{$tname} = "";
|
||
|
|
$args{$tname} = "";
|
||
|
|
}
|
||
|
|
if ($opt ne "std") {
|
||
|
|
$args{$tname} = $opt . $args{$tname};
|
||
|
|
}
|
||
|
|
|
||
|
|
$srcpath{$tname} = $fields[2];
|
||
|
|
$srcpath{$tname} = "" if (!defined($srcpath{$tname}));
|
||
|
|
|
||
|
|
# The four field case.
|
||
|
|
if (@fields == 4) {
|
||
|
|
if ($fields[3] =~ s/^diff=//) {
|
||
|
|
$testmod{$tname} = "" ;
|
||
|
|
($diff{$tname}, $gold{$tname}, $offset{$tname}) =
|
||
|
|
split(':', $fields[3]);
|
||
|
|
# Make sure this is numeric if it is not given.
|
||
|
|
if (!$offset{$tname}) {
|
||
|
|
$offset{$tname} = 0;
|
||
|
|
}
|
||
|
|
} elsif ($fields[3] =~ s/^gold=//) {
|
||
|
|
$testmod{$tname} = "" ;
|
||
|
|
$diff{$tname} = "";
|
||
|
|
$gold{$tname} = "gold/$fields[3]";
|
||
|
|
$offset{$tname} = 0;
|
||
|
|
} elsif ($fields[3] =~ s/^unordered=//) {
|
||
|
|
$testmod{$tname} = "" ;
|
||
|
|
$diff{$tname} = "";
|
||
|
|
$gold{$tname} = "gold/$fields[3]";
|
||
|
|
$unordered{$tname} = 1;
|
||
|
|
$offset{$tname} = 0;
|
||
|
|
} else {
|
||
|
|
$testmod{$tname} = $fields[3];
|
||
|
|
$diff{$tname} = "";
|
||
|
|
$gold{$tname} = "";
|
||
|
|
$offset{$tname} = 0;
|
||
|
|
}
|
||
|
|
# The five field case.
|
||
|
|
} elsif (@fields == 5) {
|
||
|
|
if ($fields[4] =~ s/^diff=//) {
|
||
|
|
$testmod{$tname} = "" ;
|
||
|
|
($diff{$tname}, $gold{$tname}, $offset{$tname}) =
|
||
|
|
split(':', $fields[4]);
|
||
|
|
# Make sure this is numeric if it is not given.
|
||
|
|
if (!$offset{$tname}) {
|
||
|
|
$offset{$tname} = 0;
|
||
|
|
}
|
||
|
|
} elsif ($fields[4] =~ s/^gold=//) {
|
||
|
|
$testmod{$tname} = "" ;
|
||
|
|
$diff{$tname} = "";
|
||
|
|
$gold{$tname} = "gold/$fields[4]";
|
||
|
|
$offset{$tname} = 0;
|
||
|
|
} elsif ($fields[4] =~ s/^unordered=//) {
|
||
|
|
$testmod{$tname} = "" ;
|
||
|
|
$diff{$tname} = "";
|
||
|
|
$gold{$tname} = "gold/$fields[4]";
|
||
|
|
$unordered{$tname} = 1;
|
||
|
|
$offset{$tname} = 0;
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$testmod{$tname} = "";
|
||
|
|
$diff{$tname} = "";
|
||
|
|
$gold{$tname} = "";
|
||
|
|
$offset{$tname} = 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
# If the name exists this is a replacement so skip the original one.
|
||
|
|
if (exists($nameidx{$tname})) {
|
||
|
|
splice(@testlist, $nameidx{$tname}, 1, "");
|
||
|
|
}
|
||
|
|
push (@testlist, $tname);
|
||
|
|
$nameidx{$tname} = @testlist - 1;
|
||
|
|
|
||
|
|
# The generation to use is passed if it does not match
|
||
|
|
# the default. To make sure the tests are protable we
|
||
|
|
# use the force SV flag to force all tests to be run
|
||
|
|
# as the latest SystemVerilog generation. This assumes
|
||
|
|
# the correct `begin_keywords has been added to the
|
||
|
|
# various files.
|
||
|
|
if ($force_sv) {
|
||
|
|
my $fsv_flags = "-g2012";
|
||
|
|
$args{$tname} =~ s/-g2012//;
|
||
|
|
$args{$tname} =~ s/-g2009//;
|
||
|
|
$args{$tname} =~ s/-g2005-sv//;
|
||
|
|
$args{$tname} =~ s/-g2005//;
|
||
|
|
$args{$tname} =~ s/-g2001-noconfig//;
|
||
|
|
$args{$tname} =~ s/-g2001//;
|
||
|
|
$args{$tname} =~ s/-g1995//;
|
||
|
|
$args{$tname} =~ s/-g2x/-gicarus-misc/; # Deprecated for 2001
|
||
|
|
$args{$tname} =~ s/-g2//; # Deprecated for 2001
|
||
|
|
$args{$tname} =~ s/-g1//; # Deprecated for 1995
|
||
|
|
if ($args{$tname}) {
|
||
|
|
$args{$tname} = "$fsv_flags $args{$tname}";
|
||
|
|
} else {
|
||
|
|
$args{$tname} = "$fsv_flags";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
close (REGRESS_LIST);
|
||
|
|
}
|
||
|
|
|
||
|
|
1; # Module loaded OK
|