Optimise Perl regression test scripts.

When redirection operators are included in a command string passed to
the system() subroutine, it spawns an intermediate shell to handle the
redirection. This is particularly inefficient when running the tests
in MSYS2. Creating our own version of system() based on fork() and
exec() allows us to handle the redirection directly.
This commit is contained in:
Martin Whitaker 2025-10-17 20:50:14 +01:00
parent 884349caab
commit 10770c9129
4 changed files with 45 additions and 24 deletions

View File

@ -11,7 +11,7 @@ our $VERSION = '1.03';
use base 'Exporter';
our @EXPORT = qw(get_args get_regress_fn get_ivl_version);
our @EXPORT = qw(get_args get_regress_fn get_ivl_version run_program);
use constant DEF_REGRESS_FN => './regress.list'; # Default regression list.
use constant DEF_SUFFIX => ''; # Default suffix.
@ -102,4 +102,26 @@ sub get_ivl_version {
}
}
#
# Run a subprogram. This avoids spawing an intermediate shell when output
# is redirected to a log file.
#
sub run_program {
my ($cmd, $log_mode, $log_file) = @_;
my $pid = fork();
if (!defined($pid)) {
die("couldn't spawn new process\n");
} elsif ($pid == 0) {
if ($log_mode) {
open(STDOUT, $log_mode, $log_file) or die("couldn't open log file '$log_file'\n");
open(STDERR, '>&STDOUT');
}
exec($cmd);
} else {
waitpid($pid, 0);
$?; # return the child's exit status
}
}
1; # Module loaded OK

View File

@ -4,7 +4,7 @@
#
# This script is based on code with the following Copyright.
#
# Copyright (c) 1999-2024 Guy Hutchison (ghutchis@pacbell.net)
# Copyright (c) 1999-2025 Guy Hutchison (ghutchis@pacbell.net)
#
# This source code is free software; you can redistribute it
# and/or modify it in source code form under the terms of the GNU
@ -126,9 +126,9 @@ sub execute_regression {
$cmd .= $testtype{$tname} eq "CN" ? " -t null" : " -t vlog95";
$cmd .= " -pfileline=1 -pspacing=4" if ($testtype{$tname} ne "CN");
$cmd .= " -D__ICARUS_UNSIZED__ $args{$tname}";
$cmd .= " ./$srcpath{$tname}/$tname.v > log/$tname.log 2>&1";
$cmd .= " ./$srcpath{$tname}/$tname.v";
# print "$cmd\n";
if (system("$cmd")) {
if (run_program($cmd, '>', "log/$tname.log")) {
if ($testtype{$tname} eq "CE") {
# Check if the system command core dumped!
if ($? >> 8 & 128) {
@ -186,9 +186,9 @@ sub execute_regression {
$args{$tname} =~ s/-gverilog-ams//g;
$cmd = "iverilog$sfx -o vsim $gen_flag $args{$tname}";
$cmd .= " -s $testmod{$tname}" if ($testmod{$tname} ne "");
$cmd .= " vlog95.v >> log/$tname.log 2>&1";
$cmd .= " vlog95.v";
# print "$cmd\n";
if ($pass_type == 0 and system("$cmd")) {
if ($pass_type == 0 and run_program($cmd, '>>', "log/$tname.log")) {
if ($testtype{$tname} eq "TE") {
# Check if the system command core dumped!
if ($? >> 8 & 128) {
@ -205,9 +205,9 @@ sub execute_regression {
}
}
$cmd = "vvp$sfx vsim $plargs{$tname} >> log/$tname.log 2>&1";
$cmd = "vvp$sfx vsim $plargs{$tname}";
# print "$cmd\n";
if ($pass_type == 0 and system("$cmd")) {
if ($pass_type == 0 and run_program($cmd, '>>', "log/$tname.log")) {
if ($testtype{$tname} eq "RE") {
# Check if the system command core dumped!
if ($? >> 8 & 128) {
@ -275,7 +275,7 @@ sub execute_regression {
} continue {
if ($tname ne "") {
system("rm -f ./vlog95.v ./vsim") and
run_program("rm -f ./vlog95.v ./vsim") and
die "Error: failed to remove temporary file.\n";
}
}

View File

@ -189,17 +189,16 @@ sub execute_regression {
}
$cmd = "iverilog-vpi$sfx --name=$tname $cargs{$tname} " .
"vpi/$ccode{$tname} > vpi_log/$tname.log 2>&1";
if (system("$cmd")) {
"vpi/$ccode{$tname}";
if (run_program($cmd, '>', "vpi_log/$tname.log")) {
print "==> Failed - running iverilog-vpi.\n";
$failed++;
next;
}
$cmd = $with_valg ? "valgrind --trace-children=yes " : "";
$cmd .= "iverilog$sfx $args{$tname} -L . -m $tname -o vsim vpi/$tname.v >> " .
"vpi_log/$tname.log 2>&1";
if (system("$cmd")) {
$cmd .= "iverilog$sfx $args{$tname} -L . -m $tname -o vsim vpi/$tname.v";
if (run_program($cmd, '>>', "vpi_log/$tname.log")) {
print "==> Failed - running iverilog.\n";
$failed++;
next;
@ -207,8 +206,8 @@ sub execute_regression {
$cmd = $with_valg ? "valgrind --leak-check=full " .
"--show-reachable=yes " : "";
$cmd .= "vvp$sfx vsim >> vpi_log/$tname.log 2>&1";
if (system("$cmd")) {
$cmd .= "vvp$sfx vsim";
if (run_program($cmd, '>>', "vpi_log/$tname.log")) {
print "==> Failed - running vvp.\n";
$failed++;
next;
@ -230,7 +229,7 @@ sub execute_regression {
if ($tname ne "" and $ccode{$tname} ne "") {
my $doto = $ccode{$tname};
$doto =~ s/\.(c|cc|cpp)$/.o/;
system("rm -f $doto $tname.vpi vsim") and
run_program("rm -f $doto $tname.vpi vsim") and
die "Error: failed to remove temporary files.\n";
}
}

View File

@ -4,7 +4,7 @@
#
# This script is based on code with the following Copyright.
#
# Copyright (c) 1999-2024 Guy Hutchison (ghutchis@pacbell.net)
# Copyright (c) 1999-2025 Guy Hutchison (ghutchis@pacbell.net)
#
# This source code is free software; you can redistribute it
# and/or modify it in source code form under the terms of the GNU
@ -136,9 +136,9 @@ sub execute_regression {
$cmd .= "iverilog$sfx -o vsim $ivl_args $args{$tname}";
$cmd .= " -s $testmod{$tname}" if ($testmod{$tname} ne "");
$cmd .= " -t null" if ($testtype{$tname} eq "CN");
$cmd .= " ./$srcpath{$tname}/$tname.v > log/$tname.log 2>&1";
$cmd .= " ./$srcpath{$tname}/$tname.v";
# print "$cmd\n";
if (system("$cmd")) {
if (run_program($cmd, '>', "log/$tname.log")) {
if ($testtype{$tname} eq "CE") {
# Check if the system command core dumped!
if ($? >> 8 & 128) {
@ -174,9 +174,9 @@ sub execute_regression {
$cmd = $with_valg ? "valgrind --leak-check=full " .
"--show-reachable=yes " : "";
$cmd .= "vvp$sfx vsim $vvp_args $plargs{$tname} >> log/$tname.log 2>&1";
$cmd .= "vvp$sfx vsim $vvp_args $plargs{$tname}";
# print "$cmd\n";
if ($pass_type == 0 and system("$cmd")) {
if ($pass_type == 0 and run_program($cmd, '>>', "log/$tname.log")) {
if ($testtype{$tname} eq "RE") {
# Check if the system command core dumped!
if ($? >> 8 & 128) {
@ -242,7 +242,7 @@ sub execute_regression {
} continue {
if ($tname ne "") {
system("rm -f ./vsim && rm -rf ivl_vhdl_work") and
run_program("rm -rf ./vsim ivl_vhdl_work") and
die "Error: failed to remove temporary file.\n";
}
}
@ -252,7 +252,7 @@ sub execute_regression {
" Not Implemented=$not_impl, Expected Fail=$expected_fail\n");
# Remove remaining temporary files
system("rm -f *.tmp ivltests/*.tmp");
run_program("rm -f *.tmp ivltests/*.tmp");
return $failed;
}