Tests.pm

#-------------------------------------------------------------------------------
#  University of Applied Sciences Technikum Wien
#
#  Department of Embedded Systems
#  http://embsys.technikum-wien.at
#
#  Josef Ressel Center for Verification of Embedded Computing Systems
#  http://vecs.technikum-wien.at
#
#-------------------------------------------------------------------------------
#  Description:
#
# Contains helper functions to deal with FIJI Test files.
#-------------------------------------------------------------------------------

## @file Tests.pm
# @brief Contains class \ref FIJI::Tests

## @class FIJI::Tests
#
# @brief Contains helper functions to deal with FIJI Test files.
package FIJI::Tests;

use strict;
use warnings;

use Scalar::Util 'blessed';
use Log::Log4perl qw(get_logger);
use Scalar::Util "looks_like_number";
use Clone qw(clone);
use File::Spec;

use FIJI::ConfigSorted;
use FIJI::Settings;
use FIJI::Tests::VHDL;
use FIJI::Tests::SystemVerilog;
use FIJI qw(:all);

# @FIXME this was almost a 1:1 copy of Settings.pm. refactoring or cleanup is required

## @function public new ($phase, %$global_settings_ref, $fiji_ini_file, %$existing_settings)
# Create a new settings instance.
#
# \param phase Tool flow phase the settings need to be compatible with.
# \param fiji_ini_file (optional) Path to the configuration file to read.
# \param existing_settings (optional) A reference to reuse and return
#        with values read from file. Any contained data will be cleared.
# \returns The new settings instance or a string describing the reason
#          why it could not be created.
sub new {
    my $logger = get_logger("");
    my ($class, $phase, $global_settings_ref, $fiji_ini_file, $existing_settings, $num_tests) = @_;

    my $self = {};

    # if there is no existing settings instance yet, create one
    if (!defined($existing_settings)) {
        $self = bless($self, $class);
    } else {
        $self = $existing_settings;
    }
    if (!blessed($self) || !$self->isa("FIJI::Tests")) {
        my $msg;
        if (!defined($existing_settings)) {
            $msg = "Could not create FIJI::Tests instance.";
        } else {
            $msg = "Given settings are not of type FIJI::Tests.";
        }
        $logger->error($msg);
        return (undef, $msg);
    }

    my $warn;
    # If there is a file given, try to read it. Else just create a default instance.
    if (defined($fiji_ini_file)) {
        ($self, $warn) = $self->_read_settingsfile($phase, $global_settings_ref, $fiji_ini_file);

        if (!defined($self)) {
            return (undef, $warn);
        }
        $self->{'filename'} = $fiji_ini_file;

    } else {

        # create a default instance

        $self->{'design'} = {};
        $self->_set_defaults(TESTCONSTMAP, $self->{'design'}, $phase);
        $self->{'design'}->{'NUM_TESTS'} = $num_tests;

        my $tkm_ref = TESTCONSTMAP;
        for my $k (keys(%{$tkm_ref})) {
            my $def;
            if (ref(TESTCONSTMAP->{$k}->{default}) eq 'CODE') {
                $def = TESTCONSTMAP->{$k}->{'default'}->($global_settings_ref);
                $def = @{$def}[0] if (ref($def) eq 'ARRAY');
            } else {
                $def = TESTCONSTMAP->{$k}->{'default'};
            }
            $self->{'design'}->{$k} = $def;
        }

        $self->{'TESTPATMAP'}   = $self->_generate_testpatmap($global_settings_ref);

        $self->{'tests'} = [];

        if (defined($num_tests)) {
            for (my $i = 0 ; $i < $num_tests ; $i++) {
                my $thistest = {};
                for my $k (keys(%{$self->{'TESTPATMAP'}})) {
                    my $def;
                    my $defsrc = $self->{'TESTPATMAP'}->{$k}->{'default'};
                    if (ref($defsrc) eq 'CODE') {
                        $def = $defsrc->($global_settings_ref);
                        $def = @{$def}[0] if (ref($def) eq 'ARRAY');
                    } else {
                        $def = $defsrc;
                    }
                    $thistest->{$k} = $def;
                }
                push @{$self->{'tests'}}, $thistest;
            }
        }
    }
    return ($self, $warn);
}

sub _export_value {
    my $logger = get_logger("");
    my ($map_ref, $k, $v_ref) = @_;

    if (defined($map_ref->{$k}->{'type'})) {
        my $orig = ${$v_ref};
        if ($map_ref->{$k}->{'type'} eq 'hexadecimal') {
            ${$v_ref} = sprintf("0x%x", $orig);

            # } elsif ($map_ref->{$k}->{'type'} eq 'natural') {
            # } elsif ($map_ref->{$k}->{'type'} eq 'boolean') {
            $logger->trace("Converted value of $k (\"$orig\") to \"${$v_ref}\".") if ($orig ne ${$v_ref});
        }

        # } elsif (defined($map_ref->{$k}->{'values'})) {
    }
}

## @method public save ($fiji_ini_file)
# @brief Store contained FIJI Settings to file.
#
# @attention Will happily overwrite existing files!
#
# \param fiji_ini_file The file name to write the FIJI Settings to.
sub save {
    my $logger = get_logger("");
    my ($self, $fiji_ini_file) = @_;
    return "No file name given" if !defined($fiji_ini_file);

    my $fiji_ini = new FIJI::ConfigSorted(syntax => 'ini');
    my $design_ref;
    my $test_cnt = 0;

    foreach my $key (keys %{$self}) {
        my $val = $self->{$key};
        if (ref(\$val) eq "REF") {
            if (ref($val) eq "HASH") {
                if ($key eq "design") {
                    $design_ref = $val;
                    next;
                } elsif ($key eq "TESTPATMAP") {
                    next;
                }
            } elsif (ref($val) eq "ARRAY") {
                if ($key eq "tests") {
                    foreach my $test (@{$val}) {
                        my $ini_test;

                        foreach my $k (keys(%{$test})) {
                            my $ini_name = $self->{'TESTPATMAP'}->{$k}->{'ini_name'};
                            if (!defined($test->{$k})) {
                                $logger->debug("Skip saving undefined value of TEST constant with key $ini_name.");
                                next;
                            }

                            # Copy value to new hash with external naming.
                            $ini_test->{$ini_name} = $test->{$k};

                            # Convert value to external representation
                            _export_value($self->{'TESTPATMAP'}, $k, \$ini_test->{$ini_name});
                            $logger->trace(sprintf("Exporting TEST%d setting %s -> %s (%s -> %s).", $test_cnt, $k, $ini_name, defined($test->{$k}) ? $test->{$k} : "undef", defined($ini_test->{$ini_name}) ? $ini_test->{$ini_name} : "undef"),);
                        }
                        $fiji_ini->set_block("TEST" . $test_cnt++, $ini_test);
                    }
                    next;
                }
            }
        } elsif ($key eq "filename") {
            next;
        }

        my $err = "Unknown element found in FIJI Settings: \"$val\"";
        $logger->error($err);

        #return $err;
    }
    $design_ref->{'NUM_TESTS'} = $test_cnt;
    my $ini_design;
    foreach my $k (keys(%{$design_ref})) {
        my $ini_name = TESTCONSTMAP->{$k}->{'ini_name'};
        if (!defined($design_ref->{$k})) {
            $logger->debug("Skip saving undefined value of design constant with key $ini_name.");
            next;
        }

        # Copy value to new hash with external naming.
        $ini_design->{$ini_name} = $design_ref->{$k};

        # Convert value to external representation
        _export_value(TESTCONSTMAP, $k, \$ini_design->{$ini_name});
        $logger->trace(sprintf("Exporting Design setting %s -> %s (%s -> %s).", $k, $ini_name, defined($design_ref->{$k}) ? $design_ref->{$k} : "undef", defined($ini_design->{$ini_name}) ? $ini_design->{$ini_name} : "undef"),);
    }
    $fiji_ini->set_block("CONSTS", $ini_design);

    if (!defined($fiji_ini->write($fiji_ini_file))) {
        my $err = FIJI::ConfigSorted->error();
        $logger->error($err);
        return $err;
    }

    $self->{'filename'} = $fiji_ini_file;
    return undef;
}

## @method public read_settingsfile ($phase, $fiji_ini_file)
# @brief Load the FIJI Settings file containing design and TEST constants.
#
# \param phase  Tool flow phase the settings stored in the given file
#               need to be compatible with.
# \param fiji_ini_file The name of an .ini file with FIJI Settings:
#         - a 'consts' block containing the constants specified by
#           \ref _sanitize_design.
#         - at least one TEST block named "TEST<number>" where "<number>"
#           is a strictly increasing integer starting with 0 containing
#           the constants for the respective TEST, see \ref _sanitize_test
#
# \returns a reference to the hash containing the read constants.
sub _read_settingsfile {
    my $logger = get_logger("");
    my ($self, $phase, $global_settings_ref, $fiji_ini_file) = @_;
    my $fiji_ini;
    my $msg_ref;

    eval { $fiji_ini = new FIJI::ConfigSorted($fiji_ini_file) };    # pesky library tries to die on syntax errors
    if (!defined($fiji_ini)) {
        my $submsg = defined($@) ? $@ : FIJI::ConfigSorted->error();
        if (length($submsg) == 0) {
            $submsg = "Empty file?";
        }
        my $msg = "Could not read config file \"$fiji_ini_file\": $submsg";
        $logger->error($msg);
        push(@$msg_ref, $msg);
    }

    my $design_ref = $fiji_ini->get_block("CONSTS");
    if (!(%$design_ref)) {
        my $msg = "Could not fetch CONSTS block from config file \"$fiji_ini_file\"";
        $logger->error($msg);
        push(@$msg_ref, $msg);
    }
    $self->_set_defaults(TESTCONSTMAP, $design_ref, $phase);

    $design_ref = _rename_import(TESTCONSTMAP, $design_ref);
    if (!defined($design_ref)) {
        my $msg = "Design constants do not match the FIJI Tests naming scheme.";
        $logger->error($msg);
        push(@$msg_ref, $msg);
    }

    # Reuse the shallow hull of the existing Tests instance

    # Clear the hash
    for (keys %$self) {
        delete $self->{$_};
    }

    # Generate data structure to verify any tests structure based on the given FIJI settings.
    # This allows, for example, to make sure we don't try to operate on an FIU that does not even exist.
    $self->{'TESTPATMAP'} = $self->_generate_testpatmap($global_settings_ref);
    $self->{'design'}     = $design_ref;
    $self->{'tests'}      = [];

    my $warn;
    # sanitize and validate read design constants
    ($design_ref, $warn) = _sanitize_design($global_settings_ref, $design_ref, $phase);
    if (defined($warn)) {
        push(@$msg_ref, @$warn);
    }
    if (!ref($design_ref)) {
        return (undef, $msg_ref);
    }

    my $test_num = 0;

    # loop over all read TESTs
    while (1) {
        my $test_name = "TEST" . $test_num;
        my $test_ref  = $fiji_ini->get_block($test_name);
        if (!(%$test_ref)) {
            last;
        }

        $test_ref = _rename_import($self->{'TESTPATMAP'}, $test_ref);
        if (!defined($test_ref)) {
            my $msg = "Test constants of $test_name do not match the FIJI Tests naming scheme.";
            $logger->error($msg);
            push(@$msg_ref, $msg);
        }

        my $tmp_test = {};
        $self->_set_defaults($self->{'TESTPATMAP'}, $tmp_test, $phase);

        # overwrite default entries
        foreach my $k (keys(%{$test_ref})) {
            $tmp_test->{$k} = $test_ref->{$k};
        }
        $test_ref = $tmp_test;

        my $warn;
        ($test_ref, $warn) = _sanitize_test($global_settings_ref, $self->{'TESTPATMAP'}, $test_ref, $phase);
        if (!ref($test_ref)) {
            my $msg = "(Some) constants for $test_name in Tests Settings are invalid.";
            $logger->error($msg);
            push(@$msg_ref, unshift(@$warn, $msg));
        }
        $self->{'tests'}->[$test_num] = $test_ref;
        $test_num++;
        $logger->trace("Read in $test_name from FIJI Tests file successfully.");
    }

    if ($test_num == 0) {
        $logger->debug("Could not fetch any TEST blocks from config file \"$fiji_ini_file\"");
    }

    # TEST_NUM is optional in the Settings file... if it was set check that
    # it corresponds to the number of TEST<number> blocks.
    if (defined($design_ref->{'NUM_TESTS'}) && $design_ref->{'NUM_TESTS'} != $test_num) {
        my $msg = NUM_TESTS->{'ini_name'} . " does not match the numbers of TEST blocks found.";
        $logger->error($msg);
        push(@$msg_ref, $msg);
    } else {
        $design_ref->{'NUM_TESTS'} = $test_num;    # assume the best if TEST_NUM constant is not given
    }

    splice(@{$self->{'tests'}}, $test_num);
    $logger->info("Successfully read in design constants and $test_num TEST definitions from FIJI Tests file \"$fiji_ini_file\".");
    return ($self, $msg_ref);
}

## @method private _generate_testpatmap ()
# @brief generates tailored TESTPATMAP for validating test patterns
#
# clones the original TESTPATMAP and adds FIU_x_FAULT_y keys
#
# @returns the tailored TESTPATMAP
sub _generate_testpatmap {
    my ($self, $global_settings_ref) = @_;

    my $testpatmap = clone(TESTPATMAP);

    for (my $pattern_idx = 1 ; $pattern_idx <= $global_settings_ref->{'design'}->{'CFGS_PER_MSG'} ; $pattern_idx++) {

        my $prop_name = "TIMER_VALUE_${pattern_idx}";
        $testpatmap->{$prop_name} = {
            ini_name   => $prop_name,
            default    => $global_settings_ref->default_timer_value(),
            type       => "natural",
            phases_opt => [qw(manual)]
        };

        for (my $fiu_idx = 0 ; $fiu_idx < $global_settings_ref->{'design'}->{'FIU_NUM'} ; $fiu_idx++) {
            my $prop_name = "FIU_${fiu_idx}_FAULT_${pattern_idx}";
            $testpatmap->{$prop_name} = {
                ini_name   => $prop_name,
                default    => "NONE",
                values     => [qw(NONE STUCK_AT_0 STUCK_AT_1 DELAY SEU STUCK_OPEN)],
                phases_opt => [qw(manual)]
            };
        }
    }

    return $testpatmap;
}

## @method public set_test_defaults (%$test_ref)
# @brief Overwrite existing fields (if defined) with defaults defined in FIJI.pm.
#
sub set_test_defaults {
    my ($self, $consts_ref) = @_;
    return $self->_set_defaults($self->{'TESTPATMAP'}, $consts_ref);
}

## @method public _set_defaults (%$map_ref, %$consts_ref)
# @brief Set defaults according to FIJI.pm.
sub _set_defaults {
    my $logger = get_logger("");
    my ($self, $map_ref, $consts_ref, $phase) = @_;
    foreach my $k (keys(%{$map_ref})) {
        if (exists($map_ref->{$k}->{'default'})) {

            # Set default only if it is not mandatory in the given phase.
            if (defined($phase) && scalar(grep { $_ eq $phase } @{$map_ref->{$k}->{'phases_opt'}}) == 0) {
                next;
            }

            # Also, do not overwrite existing values
            if (defined($consts_ref->{$k})) {
                next;
            }

            my $def;
            if (ref($map_ref->{$k}->{default}) eq 'CODE') {
                $def = $map_ref->{$k}->{'default'}->($self->{'settings'});
            } else {
                $def = $map_ref->{$k}->{'default'};
            }
            $consts_ref->{$k} = $def;
            $logger->trace(sprintf("Adding default constant: %s (%s) = %s.", $k, $map_ref->{$k}->{'ini_name'}, $def));
        }
    }
}

## @function public validate_value (%$map_ref, $k, $$v_ref, $old, $log_func)
#   Do validation (and conversation from external->internal representation)
#
#   \param global_settings_ref  reference to FIJI Settings mappings
#   \param map_ref  reference to FIJI Test mappings
#   \param k        key identifying the respective setting
#   \param v_ref    scalar reference to the proposed value (that may be modified)
#   \param old      (optional) previously valid value
#   \param log_func (optional) the (log4perl) log function to use
#                   (default is \&Log::Log4perl::Logger::trace)
sub validate_value {
    my $logger = get_logger("");
    my ($global_settings_ref, $map_ref, $k, $v_ref, $old, $log_func) = @_;
    $log_func = \&Log::Log4perl::Logger::trace if !defined($log_func);
    if (defined($map_ref->{$k}->{'type'})) {
        my $orig = ${$v_ref};

        # @FIXME: check if the constant is depending on another constant, that needs to be enabled.
        # my $dependency = @{$map_ref->{$k}->{'depends_on'}};
        # if (defined($dependency) && defined(@{$map_ref->{$dependency}->{'value'}}
        # }

        if ($map_ref->{$k}->{'type'} eq 'hexadecimal') {
            if ($orig !~ /^(0|(0[xX][[:xdigit:]]+))$/) {
                $log_func->($logger, "$k: $orig does not look like a natural hexadecimal number.");
                return 0;
            }
            ${$v_ref} = hex($orig);

            # Check for natural value range. Should never trigger due to the regex above.
            if (${$v_ref} < 0) {
                $log_func->($logger, "$k: $orig is negative.");
                return 0;
            }
        } elsif ($map_ref->{$k}->{'type'} eq 'natural'
            || $map_ref->{$k}->{'type'} eq 'min_duration'
            || $map_ref->{$k}->{'type'} eq 'max_duration')
        {
            # Match hexadecimal, binary, octal and decimal numbers (the latter also in scientific notation)
            if ($orig !~ /^(0|(0(x[0-9a-fA-F]+|[0-7]+))|(0b[01]+)|([1-9][0-9]*(e(-[0-9])?[0-9]+)?))$/) {
                $log_func->($logger, "$k: $orig does not look like a number.");
                return 0;
            }

            # convert non-decimal (hexadecimal, binary, octal) values to decimal
            ${$v_ref} = oct($orig) if $orig =~ /^0/;
            if (!looks_like_number(${$v_ref})) {
                $log_func->($logger, "$k: $orig does not look like a number.");
                return 0;
            }

            # Check for natural value range. Should never trigger due to the regex above.
            if (${$v_ref} < 0) {
                $log_func->($logger, "$k: $orig is negative.");
                return 0;
            }
        } elsif ($map_ref->{$k}->{'type'} eq 'boolean') {

            # convert strings to binary if need be
            if (!defined($orig)) {
                $log_func->($logger, "$k: \"undef\" is not a boolean value.");
                return 0;
            } elsif (lc($orig) eq 'true') {
                $orig = 1;
            } elsif (lc($orig) eq 'false') {
                $orig = 0;
            }
            if (($orig ne '0') && ($orig ne '1')) {
                $log_func->($logger, "$k: \"$orig\" does not look like a boolean value.");
                return 0;
            }

            # ensure proper boolean value, i.e. 0 or 1
            ${$v_ref} = (!!$orig) ? 1 : 0;
        } elsif ($map_ref->{$k}->{'type'} eq 'prob') {
            if ($orig !~ /^[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/) {
                $log_func->($logger, "$k: $orig does not look like a positive real number.");
                return 0;
            }
        }

        $logger->trace("Converted value of $k (\"$orig\") to \"${$v_ref}\".") if (defined($orig) && $orig ne ${$v_ref});
    }

    if (defined($map_ref->{$k}->{'values'})) {
        my $values_ref = $map_ref->{$k}->{'values'};
        if (ref($values_ref) eq 'ARRAY') {

            # Look for given value in allowed values
            if (scalar(grep { $_ eq ${$v_ref} } @{$values_ref}) == 0) {
                $log_func->($logger, "$k: ${$v_ref} is not allowed. Allowed values are: " . join(", ", @{$map_ref->{$k}->{'values'}}));
                return 0;
            }
        } elsif (ref($values_ref) eq 'CODE') {
            my $new_vals = $values_ref->($old, $global_settings_ref);
            if (!defined($new_vals) || (ref($new_vals) eq "SCALAR" && ${$v_ref} ne $new_vals) || (ref($new_vals) eq "ARRAY" && scalar(grep { $_ eq ${$v_ref} } @{$new_vals}) == 0)) {
                $log_func->($logger, "$k: ${$v_ref} is not allowed.");
                return 0;
            }
        }
    }

    return 1;
}

# @function public _rename_import (%$map_ref, %$consts_ref)
# Rename and convert entries in consts_ref according to map_ref.
#
# This function takes a hash of FIJI Settings and converts its contents
# to the respective internal representation. This allows to use different
# names and value representations in the external file than within the
# implementation.
#
# \returns $consts_ref, or undef on errors
sub _rename_import {
    my $logger = get_logger("");
    my ($map_ref, $consts_ref) = @_;
    if (ref($consts_ref) ne 'HASH') {
        $logger->error("Parameter is not a reference to a hash (containing design constants).");
        return undef;
    }

    # Iterating over respective hash from FIJI.pm and rename the entries
    # to match our internal naming scheme.
    foreach my $k (keys(%{$map_ref})) {
        my $ini_name = $map_ref->{$k}->{'ini_name'};
        if (exists($consts_ref->{$ini_name}) && $ini_name ne $k) {
            $consts_ref->{$k} = $consts_ref->{$ini_name};
            $logger->trace(sprintf("Renaming Design setting %s -> %s (=%s).", $ini_name, $k, defined($consts_ref->{$ini_name}) ? $consts_ref->{$ini_name} : "undef"),);
            delete $consts_ref->{$ini_name};
        }
    }
    foreach my $entry_key (keys(%{$consts_ref})) {
        if (!exists($map_ref->{$entry_key})) {
            $logger->debug(sprintf("Deleting unknown setting %s = %s.", $entry_key, $consts_ref->{$entry_key}));
            delete $consts_ref->{$entry_key};
        }
    }

    return $consts_ref;
}

## @function public _sanitize_test (%$test_ref, $phase)
# @brief Convert and sanity check FIJI Settings.
#
# \param test_ref a reference to a hash containing FIJI Settings for a
#                single TEST.
# \param phase the current design phase
#
# \returns A new hash with all constants required in the TEST settings
#          in sanitized form, or undef on errors.
sub _sanitize_test {
    my $logger = get_logger("");
    my ($global_settings_ref, $testpatmap, $test_ref, $phase) = @_;
    if (ref($test_ref) ne 'HASH') {
        my $msg = "Parameter is not a reference to a hash (containing TEST constants).";
        $logger->error($msg);
        return (undef, $msg);
    }

    return _validate_hashmap($global_settings_ref, $testpatmap, $test_ref, $phase);
}

sub _disabled_via_dependency ($$$) {
    my ($map_ref, $consts_ref, $k) = @_;
    my $dependency = $map_ref->{$k}->{'depends_on'};
    return defined($dependency) && !$consts_ref->{$dependency};
}

sub _validate_hashmap ($$$;$) {
    my $logger = get_logger("");
    my ($global_settings_ref, $map_ref, $consts_ref, $phase) = @_;
    my @map_keys = keys(%{$map_ref});
    my $msg_ref;
    foreach my $entry_key (keys(%{$consts_ref})) {
        my $ini_name = $map_ref->{$entry_key}->{'ini_name'};

        if (!exists($map_ref->{$entry_key})) {
            $logger->debug(sprintf("Deleting unknown setting %s = %s.", $entry_key, $consts_ref->{$entry_key}));
            next;
        }

        @map_keys = grep { $_ ne $entry_key } @map_keys;    # mark constant key as done
        if (_disabled_via_dependency($map_ref, $consts_ref, $entry_key)) {
            $logger->debug(sprintf("Key %s is disabled via %s. Skipping validation.", $entry_key, $map_ref->{$entry_key}->{'depends_on'}));
        } elsif (!validate_value($global_settings_ref, $map_ref, $entry_key, \$consts_ref->{$entry_key})) {
            my $msg = sprintf("%s = %s is invalid.", $entry_key, !defined($consts_ref->{$entry_key}) ? "<undef>" : $consts_ref->{$entry_key});
            $logger->error($msg);
            push(@$msg_ref, $msg);
        }
    }

    if (!defined($phase)) {

        # If there is no phase we are creating an "empty" hash that has
        # all possible defaults set earlier already and the there is
        # nothing we can or should do here.
        return ($consts_ref, $msg_ref);
    }

#     Iterate over the constants defined in FIJI.pm that apparently are
#     not contained in $consts_ref.
    foreach my $k (@map_keys) {
        my $dependency = $map_ref->{$k}->{'depends_on'};
        if (
            scalar(grep {$_ eq $phase} @{$map_ref->{$k}->{'phases_opt'}}) == 0 && # mandatory in current phase
            !_disabled_via_dependency($map_ref, $consts_ref, $k) # no dependency or dependency is enabled
           ) {
            my $msg = "$k is mandatory in phase $phase.";
            $logger->error($msg);
            push(@$msg_ref, $msg);
        }
    }
    return ($consts_ref, $msg_ref);
}

## @function public _sanitize_design (%$consts_ref, $phase)
# @brief Sanity check FIJI Design Settings.
#
# The function deals with sanity checks for the values
# themselves. It checks for the following conditions:
#
#   - NUM_TESTS: > 0
#   - REPEAT_OFFSET: 0 .. NUM_TESTS-1
#
# \param consts_ref a reference to a hash containing some design settings
# \param phase the tool flow phase that defines the rules to check against
#
# \returns The given hash with all constants required in the design
#          settings in sanitized form, or an error message.
sub _sanitize_design {
    my $logger = get_logger("");
    my ($global_settings_ref, $consts_ref, $phase) = @_;
    if (ref($consts_ref) ne 'HASH') {
        my $msg = "Parameter is not a reference to a hash (containing design constants).";
        $logger->error($msg);
        return (undef, ($msg));
    }

    my $warn;
    # check for sane values
    ($consts_ref, $warn) = _validate_hashmap($global_settings_ref, TESTCONSTMAP, $consts_ref, $phase);
    if (!ref($consts_ref)) {
        my $msg = "Could not validate Design Constants.";
        $logger->error("$msg $consts_ref");
        return (undef, "$msg $consts_ref");
    }

    if (($consts_ref->{'NUM_TESTS'} <= 0)) {
        my $msg = "NUM_TESTS is <= 0.";
        $logger->error($msg);
        push(@$warn, $msg);
    }

    if (($consts_ref->{'REPEAT_OFFSET'} < 0) || ($consts_ref->{'REPEAT_OFFSET'} >= $consts_ref->{'NUM_TESTS'})) {
        my $msg = "REPEAT_OFFSET (" . $consts_ref->{'REPEAT_OFFSET'} . ") is out of range [0 - NUM_TESTS].";
        $logger->error($msg);
        push(@$warn, $msg);
    }

    return ($consts_ref, $warn);
}

sub export_gate_level {
    my $logger = get_logger("");
    my ($self, $gl_file_name, $global_settings_ref, $num_repetitions, $last_test) = @_;

    my $glfd;

    $num_repetitions = 1 if (!defined $num_repetitions);
    $last_test       = @{$self->{'tests'}} if (!defined $last_test);
    
    if (!defined open($glfd, ">", $gl_file_name)) {
        return "Could not open file $gl_file_name for writing: $!";
    }

    print $glfd FIJI::Tests::VHDL::export_as_vhd_fiji_architecture($self,$last_test,$num_repetitions,$global_settings_ref);

    unless (close($glfd)) {
         return "Could not close file $gl_file_name: $!";
    }
    $logger->info("Exporting as VHDL architecture for gate-level simulation successful.");
    return undef;
}

sub export_tb {
    my $logger = get_logger("");
    my ($self, $tb_file_name, $global_settings_ref, $num_repetitions, $last_test) = @_;

    $num_repetitions = 1 if (!defined $num_repetitions);
    $last_test       = @{$self->{'tests'}} if (!defined $last_test);
    
    my $export_sim_model_map = {
        ".vhd" => \&FIJI::Tests::VHDL::export_as_vhd_fiji_architecture,
        ".sv"  => \&FIJI::Tests::VHDL::export_as_vhd_fiji_architecture,
    };

    my $export_controller_map = {
        ".vhd" => \&FIJI::Tests::VHDL::export_controller,
        ".sv"   => \&FIJI::Tests::SystemVerilog::export_controller,
    };

    my $export_fiu_map = {
        ".vhd" => \&FIJI::Tests::VHDL::export_fiu,
        ".sv"   => \&FIJI::Tests::SystemVerilog::export_fiu,
    };

    for my $ext (".vhd", ".sv") {
        my $tbfd;
        my $fn = $tb_file_name.$ext;

        if (!defined open($tbfd, ">", $fn)) {
            return "Could not open file $fn for writing: $!";
        }

        unless (defined $export_controller_map->{$ext}) {
            return "Controller export: Unknown HDL filetype \"$ext\"";
        }

        print $tbfd $export_controller_map->{$ext}->($self,$last_test,$num_repetitions,$global_settings_ref);

        unless (defined $export_fiu_map->{$ext}) {
            return "FIU export: Unknown HDL filetype \"$ext\"";
        }

        for (my $fi = 0; $fi < $global_settings_ref->{'design'}->{'FIU_NUM'}; $fi++) {
            print $tbfd $export_fiu_map->{$ext}->($fi,$global_settings_ref);
        }

        unless (close($tbfd)) {
             return "Could not close file $fn: $!";
        }
    }
    $logger->info("Exporting as templates for RTL simulation successful.");
    return undef;
}

## @method export_as_sim_script ($sim_file_name, $last_test, $num_repetitions, %$global_settings_ref)
# @brief generate a sim script from the current test file depending on repetitions and the last executed test
#
# @TODO: validate generated sim script files in Questa
#       makes use of random_force functionality or implement a different way of exporting sim scripts
#
# @param sim_file_name         the file to write the simulator script to
# @param last_test             index of the last test to be included in the script
# @param num_repetitions       the number of repetitions to be included in the script
# @param global_settings_ref   a reference to FIJI::Settings
sub export_as_sim_script {
    my $logger = get_logger("");
    my ($self, $sim_file_name, $last_test, $num_repetitions, $global_settings_ref) = @_;
    my $script_text = "# Sim script generated " . localtime . "\n#source random_force.tcl\n";

    if (ref($global_settings_ref) ne "FIJI::Settings") {
        $logger->error("Given settings are not of type FIJI::Settings");
        return 0;
    }

    my $msg;
    my $time   = 0;
    my $indent = "    ";

    open(my $sfd, ">", $sim_file_name);

    if (!defined $sfd) {
        $msg = "Could not open file $sim_file_name for writing: $!";
        return $msg;
    }

    # @FIXME translate in actual Questasim tcl syntax
    if ($global_settings_ref->{'design'}->{'RST_DUT_OUT_EN'} == 1) {
        $script_text .= <<"END_RST";
set testbench_name \$1;
set start    0;
set test     0;
set lfsrval  $global_settings_ref->{'design'}->{'LFSR_SEED'};

proc modbit signal {
     set curval [examine \$signal];

     # Always invert signal
     if {\$curval == "1"} {
        set retstring "0"
     } elseif {\$curval == "0"} {
        set retstring "1"
     } elseif {\$curval == "H"} {
        set retstring "L"
     } elseif {\$curval == "L"} {
        set retstring "H"
     }

    return \$retstring;
}

proc randbit mask {
    return expr {(\$lfsrval & \$mask) > 0};
}

when -label rst {\"\$testbench_name|$global_settings_ref->{'design'}->{'RST_DUT_OUT_NAME'}\" == not $global_settings_ref->{'design'}->{'RST_DUT_IN_ACT'} &&
                 \"\$testbench_name|$global_settings_ref->{'design'}->{'CLOCK_NET'}\" == 1 && \"\$start == 0\"} {
    set start 1;
    nowhen rst;
}

when -label lfsr {\"\$testbench_name|$global_settings_ref->{'design'}->{'CLOCK_NET'}'event && 
                    \$testbench_name|$global_settings_ref->{'design'}->{'CLOCK_NET'}' = '1'\" &&
                  \"\$start == 1\"} {
    if ( expr{ \$lfsrval & (1 << ($global_settings_ref->{'design'}->{'LFSR_WIDTH'}-1))} != 0 ) {
        set \$lfsrval [expr {((\$lfsrval ^ $global_settings_ref->{'design'}->{'LFSR_POLY'}) << 1) | 1}];
    } else {
        set \$lfsrval [expr {(\$lfsrval << 1)}];
    }
}
END_RST
    } else {
        $script_text .= "set start 1";
    }

    my $absolute_test_index = 0;

    for (my $ri = 0 ; $ri <= $num_repetitions ; $ri++) {
        $script_text .= "#\n# Repetition $ri\n#\n";
        my $start = ($ri == 0) ? 0 : $self->{'design'}->{'REPEAT_OFFSET'};
        my $end = ($ri == $num_repetitions) ? $last_test : ($self->{'design'}->{'NUM_TESTS'} - 1);
        for (my $ti = $start ; $ti <= $end ; $ti++) {

            $script_text .= "\n#\n# Test $ri:$ti\n#\n";
            $script_text .= "when -label test_$absolute_test_index \"\$test = $absolute_test_index" . (($absolute_test_index == 0) ? " && \$start = 1" : "") . "\" {\n";

            if ($absolute_test_index > 0) {
                $script_text .= $indent . "eval {nowhen test_" .    ($absolute_test_index - 1) . "}\n";
                $script_text .= $indent . "eval {nowhen dutrst_" .  ($absolute_test_index - 1) . "}\n";
                $script_text .= $indent . "eval {nowhen trigger_" . ($absolute_test_index - 1) . "}\n";
                $script_text .= $indent . "eval {nowhen action_" .  ($absolute_test_index - 1) . "_1}\n";
                $script_text .= $indent . "eval {nowhen action_" .  ($absolute_test_index - 1) . "_2}\n";
                $script_text .= $indent . "eval {nowhen clk}\n";