Compare commits

...

15 Commits

Author SHA1 Message Date
Nikolay Puzanov
9b629cd073 Add UTEST_TESTBENCH predefined macro 2022-09-13 15:52:01 +03:00
Nikolay Puzanov
79f9ac5ad6 Add useful "map combinations" macro. See counter example 2022-08-20 16:36:48 +03:00
Nikolay Puzanov
e667b0657d Add verbose output for iverilog and vvp 2022-08-15 16:52:49 +03:00
Nikolay Puzanov
f4fa7c5724 Add usefun functions (combinations list? ...) and (transpose list?) 2022-08-15 12:02:57 +03:00
Nikolay Puzanov
52ad1bbd11 Run tests in one thread is static option specified 2022-08-12 10:49:32 +03:00
Nikolay Puzanov
4f9aec3d2f Add extra parameters for test script 2022-08-09 18:10:57 +03:00
Nikolay Puzanov
b163e585ef Add static work path for initial modules testing 2022-08-09 09:50:11 +03:00
Nikolay Puzanov
02f954d829 Small fix 2022-07-12 19:29:24 +03:00
Nikolay Puzanov
fa1170eb59 Small cosmetic fix - replace 'if' to 'and' 2022-07-12 18:51:40 +03:00
Nikolay Puzanov
2c8c60429c Add VPI examples 2022-07-12 18:47:44 +03:00
Nikolay Puzanov
d298a14bff Add iverilog VPI compiler invocation function 2022-07-12 18:46:43 +03:00
Nikolay Puzanov
8f0849d1cb Functions for getting path relative to base or work dir 2022-07-12 18:44:49 +03:00
Nikolay Puzanov
905ff218f8 Add additional verilog defines UTEST_* 2022-07-12 18:43:38 +03:00
Nikolay Puzanov
b5d2b12863 Return #f from testbench of no test procedures available 2022-07-12 18:40:59 +03:00
Nikolay Puzanov
2cd32319fc Change log file name from test-log.txt to log.txt 2022-07-12 18:39:59 +03:00
13 changed files with 496 additions and 66 deletions

View File

@@ -19,6 +19,7 @@ Options:
-d, --dump Force dump waveforms. -d, --dump Force dump waveforms.
-r, --norestart Do not restart testbench with waveform dump enabled if -r, --norestart Do not restart testbench with waveform dump enabled if
test failed (true by default) test failed (true by default)
-s, --static Use static work dir for initial debug purposes
-n, --nocolor Do not use color for print log -n, --nocolor Do not use color for print log
-j, --jobs NUM Use NUM threads for running testbenches. If <=0 -j, --jobs NUM Use NUM threads for running testbenches. If <=0
use as many threads as there are processors in the system. use as many threads as there are processors in the system.
@@ -208,6 +209,7 @@ UTest об ошибке в симуляции. К сожалению, в Icarus
на файл с входными данными для теста. на файл с входными данными для теста.
- `UTEST_WORK_DIR` - путь ко временной рабочей папке теста. Сюда можно сохранить результаты тестбенча для последующей - `UTEST_WORK_DIR` - путь ко временной рабочей папке теста. Сюда можно сохранить результаты тестбенча для последующей
проверки в коде сценария. проверки в коде сценария.
- `UTEST_TESTBENCH` - флаг для определения того, что код выполняется в среде UTest (`ifdef UTEST_TESTBENCH ...`).
Примеры Примеры
------- -------

View File

@@ -0,0 +1,2 @@
*.o
*.vpi

View File

@@ -0,0 +1,16 @@
`ifndef UTEST_VERILOG_DEFINES
`define UTEST_VERILOG_DEFINES
// Log level string prefixes for use with $display function.
// Example usage: $display("%sError message", `LOG_ERR);
`define LOG_INFO "INFO#"
`define LOG_WARN "WARN#"
`define LOG_ERR "FAIL#"
// Dirty hacked redefine of $display function. Must be used with two parentheses.
// Example usage: `log_info(("Information message"));
`define log_quiet(msg) begin $display({$sformatf msg}); end
`define log_info(msg) begin $display({`LOG_INFO, $sformatf msg}); end
`define log_warn(msg) begin $display({`LOG_WARN, $sformatf msg}); end
`define log_error(msg) begin $display({`LOG_ERR, $sformatf msg}); end
`endif

View File

@@ -0,0 +1,67 @@
#include <math.h>
#include <stdlib.h>
#include <vpi_user.h>
/* --------------------------- VPI INTERFACE -------------------------------- */
#define MAX_ARGS 8
static int calltf(char *user_data)
{
vpiHandle systfref, arg_iter;
vpiHandle arg_hndl[MAX_ARGS];
struct t_vpi_value argval;
int arg_cnt = 0;
for (int i = 0; i < MAX_ARGS; i++)
arg_hndl[i] = NULL;
systfref = vpi_handle(vpiSysTfCall, NULL);
arg_iter = vpi_iterate(vpiArgument, systfref);
/* ---- Get agruments ---- */
if (arg_iter != NULL)
while (arg_cnt < MAX_ARGS &&
NULL != (arg_hndl[arg_cnt] = vpi_scan(arg_iter)))
arg_cnt++;
// function $log2
if (arg_cnt != 1)
vpi_printf("ERROR: $log2() wrong argument count\n");
else {
double arg, ret;
// get argument
argval.format = vpiRealVal;
vpi_get_value(arg_hndl[0], &argval);
arg = argval.value.real;
ret = log2(arg);
// put return value
argval.format = vpiRealVal;
argval.value.real = ret;
vpi_put_value(systfref, &argval, NULL, vpiNoDelay);
}
for (int i = 0; i < MAX_ARGS; i++)
if (arg_hndl[i]) vpi_free_object(arg_hndl[i]);
return 0;
}
static void register_interface(void)
{
s_vpi_systf_data tf_data;
tf_data.type = vpiSysFunc;
tf_data.sysfunctype = vpiRealFunc;
tf_data.compiletf = 0;
tf_data.sizetf = 0;
tf_data.calltf = calltf;
tf_data.tfname = "$log2";
vpi_register_systf(&tf_data);
}
typedef void (*stfunc)(void);
stfunc vlog_startup_routines[] = {register_interface, 0};

View File

@@ -0,0 +1,22 @@
`timescale 1ps/1ps
`include "utest.vh"
module vpi_log2 #(parameter ARGUMENT = 1.0,
parameter SIGMA = 1e-6);
real dut, gold;
initial begin
gold = $ln(ARGUMENT) / $ln(2);
dut = $log2(ARGUMENT);
`log_info(("Gold: %0f", gold));
`log_info((" DUT: %0f", dut));
if ($abs(gold - dut) > SIGMA)
`log_error(("FAIL"));
$finish;
end
endmodule // vpi_log2

View File

@@ -0,0 +1,23 @@
;; -*- scheme -*-
;; Uses one common VPI module compiled in the testbench base directory
(let ((top "vpi_log2"))
;; compile VPI module in the base directory
(and (utest/iverilog-compile-vpi "vpi_log2.c"
#:output-dir (utest/base-path)
#:name top #:libs "m")
(map
(lambda (arg)
(utest/tb
((format "log2_~a" arg))
(utest/run-simulation-iverilog
"vpi_log2.sv"
top
#:parameters `((ARGUMENT ,arg))
#:vpimods top
;; VPI modules search path
#:vpipaths (utest/base-path))))
(iota 20))))

View File

@@ -0,0 +1,16 @@
`ifndef UTEST_VERILOG_DEFINES
`define UTEST_VERILOG_DEFINES
// Log level string prefixes for use with $display function.
// Example usage: $display("%sError message", `LOG_ERR);
`define LOG_INFO "INFO#"
`define LOG_WARN "WARN#"
`define LOG_ERR "FAIL#"
// Dirty hacked redefine of $display function. Must be used with two parentheses.
// Example usage: `log_info(("Information message"));
`define log_quiet(msg) begin $display({$sformatf msg}); end
`define log_info(msg) begin $display({`LOG_INFO, $sformatf msg}); end
`define log_warn(msg) begin $display({`LOG_WARN, $sformatf msg}); end
`define log_error(msg) begin $display({`LOG_ERR, $sformatf msg}); end
`endif

View File

@@ -0,0 +1,67 @@
#include <math.h>
#include <stdlib.h>
#include <vpi_user.h>
/* --------------------------- VPI INTERFACE -------------------------------- */
#define MAX_ARGS 8
static int calltf(char *user_data)
{
vpiHandle systfref, arg_iter;
vpiHandle arg_hndl[MAX_ARGS];
struct t_vpi_value argval;
int arg_cnt = 0;
for (int i = 0; i < MAX_ARGS; i++)
arg_hndl[i] = NULL;
systfref = vpi_handle(vpiSysTfCall, NULL);
arg_iter = vpi_iterate(vpiArgument, systfref);
/* ---- Get agruments ---- */
if (arg_iter != NULL)
while (arg_cnt < MAX_ARGS &&
NULL != (arg_hndl[arg_cnt] = vpi_scan(arg_iter)))
arg_cnt++;
// function $log2
if (arg_cnt != 1)
vpi_printf("ERROR: $log2() wrong argument count\n");
else {
double arg, ret;
// get argument
argval.format = vpiRealVal;
vpi_get_value(arg_hndl[0], &argval);
arg = argval.value.real;
ret = log2(arg);
// put return value
argval.format = vpiRealVal;
argval.value.real = ret;
vpi_put_value(systfref, &argval, NULL, vpiNoDelay);
}
for (int i = 0; i < MAX_ARGS; i++)
if (arg_hndl[i]) vpi_free_object(arg_hndl[i]);
return 0;
}
static void register_interface(void)
{
s_vpi_systf_data tf_data;
tf_data.type = vpiSysFunc;
tf_data.sysfunctype = vpiRealFunc;
tf_data.compiletf = 0;
tf_data.sizetf = 0;
tf_data.calltf = calltf;
tf_data.tfname = "$log2";
vpi_register_systf(&tf_data);
}
typedef void (*stfunc)(void);
stfunc vlog_startup_routines[] = {register_interface, 0};

View File

@@ -0,0 +1,22 @@
`timescale 1ps/1ps
`include "utest.vh"
module vpi_log2 #(parameter ARGUMENT = 1.0,
parameter SIGMA = 1e-6);
real dut, gold;
initial begin
gold = $ln(ARGUMENT) / $ln(2);
dut = $log2(ARGUMENT);
`log_info(("Gold: %0f", gold));
`log_info((" DUT: %0f", dut));
if ($abs(gold - dut) > SIGMA)
`log_error(("FAIL"));
$finish;
end
endmodule // vpi_log2

View File

@@ -0,0 +1,17 @@
;; -*- scheme -*-
;; Compile VPI module for each test
(let ((top "vpi_log2"))
(map
(lambda (arg)
(utest/tb
((format "log2_~a" arg))
(and (utest/iverilog-compile-vpi "vpi_log2.c" #:name top #:libs "m")
(utest/run-simulation-iverilog
"vpi_log2.sv"
top
#:parameters `((ARGUMENT ,arg))
#:vpimods top))))
(iota 20)))

1
examples/simple-counter/.gitignore vendored Normal file
View File

@@ -0,0 +1 @@
/work

View File

@@ -1,26 +1,8 @@
;; -*- scheme -*- ;; -*- scheme -*-
;;; Make lists combinations
;;; Example: (combinations '(1 2 3) '(a b)) -> '((1 a) (1 b) (2 a) (2 b) (3 a) (3 b))
(define (combinations . lists)
(cond
((null? lists) '())
((null? (cdr lists)) (car lists))
(else
(fold (lambda (comb out)
(append out
(map (lambda (x)
(if (list? comb)
(cons x comb)
(list x comb)))
(car lists))))
'() (apply combinations (cdr lists))))))
;;; Testbenches ;;; Testbenches
(map (utest/map-comb
(lambda (l) (count direction)
(let ((count (car l))
(direction (cadr l)))
(utest/tb (utest/tb
((format "c~a_d~a" count direction) ((format "c~a_d~a" count direction)
"More complex testbench for Simple Counter" "More complex testbench for Simple Counter"
@@ -35,10 +17,8 @@
"simple_counter_tb" "simple_counter_tb"
#:parameters `((COUNT ,count) #:parameters `((COUNT ,count)
(ITERATIONS ,(* count 3)) (ITERATIONS ,(* count 3))
(DIRECTION ,direction)))))) (DIRECTION ,direction))))
(combinations
(append '(10 100 1000 16 64 256) (append '(10 100 1000 16 64 256)
(let ((state (seed->random-state 0))) (let ((state (seed->random-state 0)))
(map (lambda (x) (+ 2 (random 200 state))) (iota 100)))) (map (lambda (x) (+ 2 (random 200 state))) (iota 100))))
'(1 -1 0))) '(1 -1 0))

257
utest.scm
View File

@@ -50,9 +50,11 @@
(define utest/restart-dump (make-parameter #f)) (define utest/restart-dump (make-parameter #f))
(define utest/keep-output (make-parameter #f)) (define utest/keep-output (make-parameter #f))
(define utest/verbose (make-parameter #f)) (define utest/verbose (make-parameter #f))
(define utest/static (make-parameter #f))
(define utest/nocolor (make-parameter #f)) (define utest/nocolor (make-parameter #f))
(define utest/base-path (make-parameter "")) (define utest/base-path (make-parameter ""))
(define utest/work-path (make-parameter "")) (define utest/work-path (make-parameter ""))
(define utest/extra (make-parameter '()))
(define-record-type <log-type> (define-record-type <log-type>
(log-type log-prefix color out-prefix verbose) (log-type log-prefix color out-prefix verbose)
@@ -120,6 +122,27 @@
#\newline)))) #\newline))))
(for-each println strs) #t)) (for-each println strs) #t))
;;; Transpose matrix
;;; Example: (transpose '((1 2) (3 4) (5 6))) -> '((1 3 5) (2 4 6))
(define (transpose l)
(apply map list l))
;;; Make lists combinations
;;; Example: (combinations '(1 2 3) '(a b)) -> '((1 a) (1 b) (2 a) (2 b) (3 a) (3 b))
(define (combinations . lists)
(cond
((null? lists) '())
((null? (cdr lists)) (car lists))
(else
(fold (lambda (comb out)
(append out
(map (lambda (x)
(if (list? comb)
(cons x comb)
(list x comb)))
(car lists))))
'() (apply combinations (cdr lists))))))
;;; ;;;
;;; Colorize text ;;; Colorize text
;;; ;;;
@@ -359,12 +382,32 @@
follow-symlink)) follow-symlink))
;;; ;;;
;;; Find files in testbench base directory ;;; Get path relative to base
(define* (utest/find-files rx #:key (base "") (follow-symlink #f)) ;;;
(let* ((base (path->absolute (define (utest/base-rel path)
(if (string-null? base) (if (absolute-file-name? path)
path
(path->absolute
(if (string-null? path)
(utest/base-path) (utest/base-path)
(format "~a/~a" (utest/base-path) base)))) (string-append (utest/base-path) "/" path)))))
;;;
;;; Get path relative to work
;;;
(define (utest/work-rel path)
(if (absolute-file-name? path)
path
(path->absolute
(if (string-null? path)
(utest/work-path)
(string-append (utest/work-path) "/" path)))))
;;;
;;; Find files in testbench base directory
;;;
(define* (utest/find-files rx #:key (base "") (follow-symlink #f))
(let* ((base (utest/base-rel base))
(ls (list-dir base))) (ls (list-dir base)))
(filter (lambda (f) (filter (lambda (f)
(and (not (string=? f ".")) (and (not (string=? f "."))
@@ -410,8 +453,9 @@
;;; ;;;
;;; Execute system command and capture stdout and stderr to string list ;;; Execute system command and capture stdout and stderr to string list
;;; ;;;
(define (system-to-string-list cmd) (define* (system-to-string-list cmd #:key (pwd #f))
(let* ((cmd (string-append cmd " 2>&1;")) (let* ((cmd (string-append cmd " 2>&1"))
(cmd (if pwd (format "cd ~a; ~a" pwd cmd) cmd))
(p (open-input-pipe cmd)) (p (open-input-pipe cmd))
(out (get-string-all p))) (out (get-string-all p)))
(values (values
@@ -439,6 +483,7 @@
(warnings "all") ; -W (warnings "all") ; -W
(defines '()) ; -D=X (defines '()) ; -D=X
(parameters '()) ; -P=X (parameters '()) ; -P=X
(verbose #f)
(other '())) (other '()))
(define (string-or-num-param x) (define (string-or-num-param x)
@@ -450,6 +495,7 @@
(cons (cons
iverilog-executable iverilog-executable
(append (append
(if verbose '("-v") '())
(if lang (list (format "-g~a" lang)) '()) (if lang (list (format "-g~a" lang)) '())
(if output (list "-o" output) '()) (if output (list "-o" output) '())
(if separate '("-u") '()) (if separate '("-u") '())
@@ -492,11 +538,13 @@
(vpipaths '()) ; -M (vpipaths '()) ; -M
(vpimods '()) ; -m (vpimods '()) ; -m
(dumpformat 'fst) (dumpformat 'fst)
(plusargs '())) (plusargs '())
(verbose #f))
(let ((opts (let ((opts
(cons (cons
vvp-executable vvp-executable
(append (append
(if verbose '("-v") '())
(map (lambda (x) (format "-M~a" x)) (arg-to-list vpipaths)) (map (lambda (x) (format "-M~a" x)) (arg-to-list vpipaths))
(map (lambda (x) (format "-m~a" x)) (arg-to-list vpimods)) (map (lambda (x) (format "-m~a" x)) (arg-to-list vpimods))
(list "-N" vvp-binary) ; $finish on CTRL-C (list "-N" vvp-binary) ; $finish on CTRL-C
@@ -517,6 +565,74 @@
(if (find (lambda (x) (string-prefix? "VCD Error: " x)) output) -1 status))) (if (find (lambda (x) (string-prefix? "VCD Error: " x)) output) -1 status)))
(values (= status 0) cmdline output)))))) (values (= status 0) cmdline output))))))
;;;
;;; Call iverilog-vpi tool
;;;
(define* (iverilog-compile-vpi sources
#:key
(iverilog-vpi-executable "iverilog-vpi")
(output-dir #f)
(name #f) ; --name
(libs '()) ; -l
(libdirs '()) ; -L
(includes '()) ; -I
(defines '())) ; -D
(define (string-or-num-param x)
(if (number? x)
(format "~a" x)
(format "'\"~a\"'" x)))
(let ((opts
(cons
iverilog-vpi-executable
(append
(if (and name (not (string-null? name))) (list (format "--name=~a" name)))
(map (lambda (x) (format "-l~a" x)) (arg-to-list libs))
(map (lambda (x) (format "-L~a" x)) (arg-to-list libdirs))
(map (lambda (x) (format "-I~a" x)) (arg-to-list includes))
(map (lambda (x)
(if (list? x)
(format "-D~a=~a" (car x) (string-or-num-param (cadr x)))
(format "-D~a" x)))
defines)
(arg-to-list sources)))))
(let* ((cmdline (fold (lambda (x s) (string-append s x " ")) "" opts)))
(let-values (((status output)
(system-to-string-list cmdline #:pwd output-dir)))
(values (= status 0) cmdline output)))))
;;;
;;; VPI compiler wrapper for run inside tests
;;;
(define* (utest/iverilog-compile-vpi sources
#:key
(iverilog-vpi-executable "iverilog-vpi")
(output-dir #f)
(name #f)
(libs '())
(libdirs '())
(includes '())
(defines '()))
(let ((base-path (utest/base-path))
(work-path (utest/work-path)))
(let ((sources (map (lambda (x) (path->absolute x base-path)) (arg-to-list sources)))
(libdirs (map (lambda (x) (path->absolute x base-path)) (arg-to-list libdirs)))
(includes (map (lambda (x) (path->absolute x base-path)) (arg-to-list includes))))
(let-values (((succ cmdl output)
(iverilog-compile-vpi sources
#:iverilog-vpi-executable iverilog-vpi-executable
#:output-dir (if output-dir output-dir work-path)
#:name name
#:libs libs
#:libdirs libdirs
#:includes includes
#:defines defines)))
;; Print command line and output
(printf "$ ~a\n" cmdl)
(for-each println output)
succ))))
;;; ;;;
;;; Check log for errors or warnings ;;; Check log for errors or warnings
;;; ;;;
@@ -528,6 +644,25 @@
((find (lambda (x) (string-prefix? sim-warn-prefix x)) log) 'warning) ((find (lambda (x) (string-prefix? sim-warn-prefix x)) log) 'warning)
(else #t)))) (else #t))))
;;;
;;; Return list of UTEST_* defines
;;;
(define (utest-verilog-defines)
(append
`(UTEST_TESTBENCH
(UTEST_BASE_DIR ,(format "'\"~a\"'" (utest/base-path)))
(UTEST_WORK_DIR ,(format "'\"~a\"'" (utest/work-path))))
(fold (lambda (x l)
(if (car x)
(append l (cdr x))
l))
'()
`((,(utest/verbose) UTEST_VERBOSE)
(,(utest/force-dump) UTEST_FORCE_DUMP)
(,(utest/keep-output) UTEST_KEEP_OUTPUT)
(,(utest/restart-dump) UTEST_RESTART_DUMP)))))
;;; ;;;
;;; Run compile and simulation with Icarus Verilog ;;; Run compile and simulation with Icarus Verilog
;;; ;;;
@@ -564,16 +699,13 @@
(let ((sources (append (map (lambda (x) (path->absolute x base-path)) (let ((sources (append (map (lambda (x) (path->absolute x base-path))
(arg-to-list sources)) (arg-to-list sources))
(list timeout-module dump-module))) (list timeout-module dump-module)))
(defines (append defines (utest-verilog-defines)))
(defines (append defines
`((UTEST_BASE_DIR ,(format "'\"~a\"'" base-path))
(UTEST_WORK_DIR ,(format "'\"~a\"'" work-path)))))
(includes (append (map (lambda (x) (path->absolute x base-path)) (arg-to-list includes)) (includes (append (map (lambda (x) (path->absolute x base-path)) (arg-to-list includes))
(list base-path))) (list base-path)))
(modpaths (map (lambda (x) (path->absolute x base-path)) (arg-to-list modpaths))) (modpaths (map (lambda (x) (path->absolute x base-path)) (arg-to-list modpaths)))
(vpipaths (map (lambda (x) (path->absolute x base-path)) (arg-to-list vpipaths))) (vpipaths (map (lambda (x) (path->absolute x base-path))
(let ((vpipaths (arg-to-list vpipaths)))
(if (null? vpipaths) (list work-path) vpipaths))))
(execfile (format "~a/~a.vvp" work-path top))) (execfile (format "~a/~a.vvp" work-path top)))
(let ((succ (let ((succ
@@ -586,7 +718,7 @@
#:top top #:other `("-s" ,TIMEOUT_MODULE_NAME "-s" ,DUMP_MODULE_NAME) #:top top #:other `("-s" ,TIMEOUT_MODULE_NAME "-s" ,DUMP_MODULE_NAME)
#:output execfile #:lang lang #:features features #:vpipaths vpipaths #:output execfile #:lang lang #:features features #:vpipaths vpipaths
#:vpimods vpimods #:separate separate #:warnings warnings #:defines defines #:vpimods vpimods #:separate separate #:warnings warnings #:defines defines
#:parameters parameters))) #:parameters parameters #:verbose (utest/verbose))))
;; Print iverilog command line and output ;; Print iverilog command line and output
(printf "$ ~a\n" cmdl) (printf "$ ~a\n" cmdl)
@@ -601,7 +733,7 @@
(iverilog-run execfile (iverilog-run execfile
#:vvp-executable vvp-executable #:vpipaths vpipaths #:vvp-executable vvp-executable #:vpipaths vpipaths
#:vpimods vpimods #:dumpformat (if dump dumpformat 'none) #:vpimods vpimods #:dumpformat (if dump dumpformat 'none)
#:plusargs plusargs))) #:plusargs plusargs #:verbose (utest/verbose))))
(let ((succ (if succ (check-log outp) succ))) (let ((succ (if succ (check-log outp) succ)))
(if (or succ dump (not (utest/restart-dump))) (if (or succ dump (not (utest/restart-dump)))
(begin (begin
@@ -620,12 +752,23 @@
(define (collect-test-procs files) (define (collect-test-procs files)
(fold (fold
(lambda (f procs) (lambda (f procs)
(let ((f (path->absolute f))) (let* ((f (path->absolute f))
(base (dirname f)))
(append (append
procs procs
(map (lambda (proc) (list proc (dirname f) (basename f))) (filter
(let ((procs (load f))) car
(if (list? procs) procs (list procs))))))) (map (lambda (proc) (list proc base (basename f)))
(let ((procs
(parameterize ((utest/base-path base)
(utest/work-path #f))
(load f))))
(if procs
(if (list? procs) procs
(if (procedure? procs)
(list procs)
'(#f)))
'(#f))))))))
'() files)) '() files))
;;; ;;;
@@ -687,12 +830,21 @@
(makefile-name (caddr test))) (makefile-name (caddr test)))
(let* ((name (proc 'name)) (let* ((name (proc 'name))
(name (if name name "noname")) (name (if name name "noname"))
(work (mkdtemp (format "~a/~a~a-~a-~a-XXXXXX" (work
(if (utest/static)
(let ((dir-name
(format "~a/~a~a-static"
base WORK_DIR_PREFIX
makefile-name)))
(when (not (access? dir-name W_OK))
(mkdir dir-name))
dir-name)
(mkdtemp (format "~a/~a~a-~a-~a-XXXXXX"
base WORK_DIR_PREFIX base WORK_DIR_PREFIX
makefile-name makefile-name
(string-map (lambda (c) (if (char-whitespace? c) #\_ c)) (string-map (lambda (c) (if (char-whitespace? c) #\_ c))
(string-downcase name)) (string-downcase name))
(current-time))))) (current-time))))))
;; Execute test ;; Execute test
(let* ((p #f) (let* ((p #f)
(o (with-output-to-string (o (with-output-to-string
@@ -708,7 +860,7 @@
(not (eq? pass #t)))) (not (eq? pass #t))))
;; Save log ;; Save log
(with-output-to-file (format "~a/test-log.txt" work) (with-output-to-file (format "~a/log.txt" work)
(lambda () (print-log log #:colorize #f #:verbose #t))) (lambda () (print-log log #:colorize #f #:verbose #t)))
;; Delete work dir if test pass and no need to keep directory ;; Delete work dir if test pass and no need to keep directory
@@ -729,11 +881,11 @@
(define (execute-tests tests) (define (execute-tests tests)
(let ((test-count (length tests)) (let ((test-count (length tests))
(pass-count (pass-count
(fold (lambda (test cnt) (apply + (map (lambda (test)
(let-values (((pass out) (execute-test test))) (let-values (((pass out) (execute-test test)))
(println out) (println out)
(+ cnt (if pass 1 0)))) (if pass 1 0)))
0 tests))) tests))))
(printf "PASSED ~a/~a\n\n" pass-count test-count))) (printf "PASSED ~a/~a\n\n" pass-count test-count)))
;;; ;;;
@@ -816,6 +968,18 @@
((_ () body ...) ((_ () body ...)
(utest/tb (#f) body ...)))) (utest/tb (#f) body ...))))
;;;
;;; Map combinations macro
;;;
(define-syntax utest/map-comb
(syntax-rules ()
((_ (args ...) (body ...) lists ...)
(apply
map
(lambda (args ...) (body ...))
(transpose
(combinations lists ...))))))
;;; ;;;
;;; Delete working folders ;;; Delete working folders
;;; ;;;
@@ -825,9 +989,13 @@
(find-paths-rec (find-paths-rec
(lambda (p t) (lambda (p t)
(and (eq? t 'directory) (and (eq? t 'directory)
(or
(string-match (string-match
(format "^~a.*-[0-9]{10}-.{6}$" WORK_DIR_PREFIX) (format "^~a.*-[0-9]{10}-.{6}$" WORK_DIR_PREFIX)
(basename p)))) (basename p))
(string-match
(format "^~a.*-static$" WORK_DIR_PREFIX)
(basename p)))))
base) base)
(fold (fold
(lambda (makefile work-dirs) (lambda (makefile work-dirs)
@@ -836,9 +1004,13 @@
(find-paths-rec (find-paths-rec
(lambda (p t) (lambda (p t)
(and (eq? t 'directory) (and (eq? t 'directory)
(or
(string-match (string-match
(format "^~a~a.*-[0-9]{10}-.{6}$" WORK_DIR_PREFIX (basename makefile)) (format "^~a~a.*-[0-9]{10}-.{6}$" WORK_DIR_PREFIX (basename makefile))
(basename p)))) (basename p))
(string-match
(format "^~a~a.*-static$" WORK_DIR_PREFIX (basename makefile))
(basename p)))))
(dirname makefile)))) (dirname makefile))))
'() (find-files-rec-regexp MAKEFILE_NAME_REGEXP base))))) '() (find-files-rec-regexp MAKEFILE_NAME_REGEXP base)))))
(if (null? work-dirs) (if (null? work-dirs)
@@ -849,6 +1021,24 @@
(delete-recursive dir)) (delete-recursive dir))
work-dirs)))) work-dirs))))
;;;
;;; Parse extra parameters
;;;
(define (parse-extra-param-string str)
(map (lambda (param)
(let ((s (string-split param #\=)))
(if (= 1 (length s))
(cons (car s) #t)
(cons (car s) (if (string-null? (cadr s)) #t (cadr s))))))
(string-split str #\,)))
;;;
;;; Retrive extra parameter
;;;
(define (utest/extra-param key)
(let ((val (assoc key (utest/extra))))
(if (pair? val) (cdr val) val)))
;;; ;;;
;;; Print log level verilog defines ;;; Print log level verilog defines
;;; ;;;
@@ -884,12 +1074,14 @@
(* " -d, --dump Force dump waveforms.") (* " -d, --dump Force dump waveforms.")
(* " -r, --norestart Do not restart testbench with waveform dump enabled if") (* " -r, --norestart Do not restart testbench with waveform dump enabled if")
(* " test failed (true by default)") (* " test failed (true by default)")
(* " -s, --static Use static work dir for initial debug purposes")
(* " -n, --nocolor Do not use color for print log") (* " -n, --nocolor Do not use color for print log")
(* " -j, --jobs NUM Use NUM threads for running testbenches. If <=0") (* " -j, --jobs NUM Use NUM threads for running testbenches. If <=0")
(* " use as many threads as there are processors in the system.") (* " use as many threads as there are processors in the system.")
(* " -f, --defines Print useful Verilog defines") (* " -f, --defines Print useful Verilog defines")
(* " -c, --clean Delete work folders that have a corresponding makefile.") (* " -c, --clean Delete work folders that have a corresponding makefile.")
(* " --force-clean Delete all work folders regardless of the presence of a makefile.") (* " --force-clean Delete all work folders regardless of the presence of a makefile.")
(* " -x, --extra P[=V] Add parameter P with optional value V for test script")
(* " -v, --verbose Verbose output") (* " -v, --verbose Verbose output")
(* " -V, --version Print version") (* " -V, --version Print version")
(* " -h, --help Print this message and exit") (* " -h, --help Print this message and exit")
@@ -910,9 +1102,11 @@
(let* ((optspec `((keep (single-char #\k)) (let* ((optspec `((keep (single-char #\k))
(dump (single-char #\d) (value #f)) (dump (single-char #\d) (value #f))
(norestart (single-char #\r) (value #f)) (norestart (single-char #\r) (value #f))
(static (single-char #\s) (value #f))
(nocolor (single-char #\n) (value #f)) (nocolor (single-char #\n) (value #f))
(verbose (single-char #\v) (value #f)) (verbose (single-char #\v) (value #f))
(jobs (single-char #\j) (value #t) (predicate ,string->number)) (jobs (single-char #\j) (value #t) (predicate ,string->number))
(extra (single-char #\x) (value #t))
(help (single-char #\h) (value #f)) (help (single-char #\h) (value #f))
(version (single-char #\V) (value #f)) (version (single-char #\V) (value #f))
(clean (single-char #\c) (value #f)) (clean (single-char #\c) (value #f))
@@ -931,19 +1125,20 @@
((option-ref options 'defines #f) (print-verilog-defines)) ((option-ref options 'defines #f) (print-verilog-defines))
((option-ref options 'clean #f) (delete-work-dirs path #f)) ((option-ref options 'clean #f) (delete-work-dirs path #f))
((option-ref options 'force-clean #f) (delete-work-dirs path #t)) ((option-ref options 'force-clean #f) (delete-work-dirs path #t))
(else (else
(utest/keep-output (option-ref options 'keep #f)) (utest/keep-output (option-ref options 'keep #f))
(utest/force-dump (option-ref options 'dump #f)) (utest/force-dump (option-ref options 'dump #f))
(utest/restart-dump (not (option-ref options 'norestart #f))) (utest/restart-dump (not (option-ref options 'norestart #f)))
(utest/static (option-ref options 'static #f))
(utest/nocolor (option-ref options 'nocolor #f)) (utest/nocolor (option-ref options 'nocolor #f))
(utest/verbose (option-ref options 'verbose #f)) (utest/verbose (option-ref options 'verbose #f))
(utest/extra (parse-extra-param-string (option-ref options 'extra "")))
(let ((makefiles (let ((makefiles
(if (eq? 'regular (stat:type (stat path))) (if (eq? 'regular (stat:type (stat path)))
(list path) (list path)
(find-files-rec-regexp MAKEFILE_NAME_REGEXP path)))) (find-files-rec-regexp MAKEFILE_NAME_REGEXP path))))
(if (<= jobs 1) (if (or (<= jobs 1) (utest/static))
(execute-tests (collect-test-procs makefiles)) (execute-tests (collect-test-procs makefiles))
(execute-tests-parallel (collect-test-procs makefiles) jobs))))))) (execute-tests-parallel (collect-test-procs makefiles) jobs)))))))