Add UTEST_TESTBENCH predefined macro

README.md

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

examples/log2-vpi-common-vpi/vpi_log2.utest

@@ -4,22 +4,20 @@
 
 (let ((top "vpi_log2"))
   ;; compile VPI module in the base directory
-  (if (utest/iverilog-compile-vpi "vpi_log2.c"
+  (and (utest/iverilog-compile-vpi "vpi_log2.c"
-                                  #:output-dir (utest/base-path)
+                                   #:output-dir (utest/base-path)
-                                  #:name top #:libs "m")
+                                   #:name top #:libs "m")
-      (map
+       (map
-       (lambda (arg)
+        (lambda (arg)
-         (utest/tb
+          (utest/tb
-          ((format "log2_~a" arg))
+           ((format "log2_~a" arg))
 
-          (utest/run-simulation-iverilog
+           (utest/run-simulation-iverilog
-           "vpi_log2.sv"
+            "vpi_log2.sv"
-           top
+            top
 
-           #:parameters          `((ARGUMENT ,arg))
+            #:parameters `((ARGUMENT ,arg))
-           #:vpimods             top
+            #:vpimods    top
-           ;; VPI modules search path
+            ;; VPI modules search path
-           #:vpipaths            (utest/base-path))))
+            #:vpipaths   (utest/base-path))))
-       (iota 20))
+        (iota 20))))
-
-      #f))

examples/log2-vpi/vpi_log2.utest

@@ -8,12 +8,10 @@
      (utest/tb
       ((format "log2_~a" arg))
 
-      (if (utest/iverilog-compile-vpi "vpi_log2.c" #:name top #:libs "m")
+      (and (utest/iverilog-compile-vpi "vpi_log2.c" #:name top #:libs "m")
-          (utest/run-simulation-iverilog
+           (utest/run-simulation-iverilog
-           "vpi_log2.sv"
+            "vpi_log2.sv"
-           top
+            top
-           #:parameters          `((ARGUMENT ,arg))
+            #:parameters `((ARGUMENT ,arg))
-           #:vpimods             top)
+            #:vpimods    top))))
-
-          #f)))
    (iota 20)))

examples/simple-counter/simple_counter_tb.utest

@@ -1,27 +1,9 @@
 ;; -*- 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
-(map
+(utest/map-comb
- (lambda (l)
+ (count direction)
-   (let ((count (car l))
+ (utest/tb
-         (direction (cadr l)))
-     (utest/tb
       ((format "c~a_d~a" count direction)
        "More complex testbench for Simple Counter"
        (format "COUNT=~a\tDIRECTION=~a" count direction))
@@ -35,10 +17,8 @@
        "simple_counter_tb"
        #:parameters `((COUNT      ,count)
                       (ITERATIONS ,(* count 3))
-                      (DIRECTION  ,direction))))))
+                      (DIRECTION  ,direction))))
-
+ (append '(10 100 1000 16 64 256)
- (combinations
-  (append '(10 100 1000 16 64 256)
           (let ((state (seed->random-state 0)))
             (map (lambda (x) (+ 2 (random 200 state))) (iota 100))))
-  '(1 -1 0)))
+ '(1 -1 0))

utest.scm

@@ -50,9 +50,11 @@
 (define utest/restart-dump  (make-parameter #f))
 (define utest/keep-output   (make-parameter #f))
 (define utest/verbose       (make-parameter #f))
+(define utest/static        (make-parameter #f))
 (define utest/nocolor       (make-parameter #f))
 (define utest/base-path     (make-parameter ""))
 (define utest/work-path     (make-parameter ""))
+(define utest/extra         (make-parameter '()))
 
 (define-record-type <log-type>
   (log-type log-prefix color out-prefix verbose)
@@ -120,6 +122,27 @@
                 #\newline))))
     (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
 ;;;
@@ -460,6 +483,7 @@
                            (warnings "all")         ; -W
                            (defines '())            ; -D=X
                            (parameters '())         ; -P=X
+                           (verbose #f)
                            (other '()))
 
   (define (string-or-num-param x)
@@ -471,6 +495,7 @@
          (cons
           iverilog-executable
           (append
+           (if verbose '("-v") '())
            (if lang (list (format "-g~a" lang)) '())
            (if output (list "-o" output) '())
            (if separate '("-u") '())
@@ -513,11 +538,13 @@
                        (vpipaths '())           ; -M
                        (vpimods '())            ; -m
                        (dumpformat 'fst)
-                       (plusargs '()))
+                       (plusargs '())
+                       (verbose #f))
   (let ((opts
          (cons
           vvp-executable
           (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 vpimods))
            (list "-N" vvp-binary)   ; $finish on CTRL-C
@@ -622,7 +649,8 @@
 ;;;
 (define (utest-verilog-defines)
   (append
-   `((UTEST_BASE_DIR ,(format "'\"~a\"'" (utest/base-path)))
+   `(UTEST_TESTBENCH
+     (UTEST_BASE_DIR ,(format "'\"~a\"'" (utest/base-path)))
      (UTEST_WORK_DIR ,(format "'\"~a\"'" (utest/work-path))))
 
    (fold (lambda (x l)
@@ -690,7 +718,7 @@
                                        #:top top #:other `("-s" ,TIMEOUT_MODULE_NAME "-s" ,DUMP_MODULE_NAME)
                                        #:output execfile #:lang lang #:features features #:vpipaths vpipaths
                                        #:vpimods vpimods #:separate separate #:warnings warnings #:defines defines
-                                       #:parameters parameters)))
+                                       #:parameters parameters #:verbose (utest/verbose))))
 
                  ;; Print iverilog command line and output
                  (printf "$ ~a\n" cmdl)
@@ -705,7 +733,7 @@
                              (iverilog-run execfile
                                            #:vvp-executable vvp-executable #:vpipaths vpipaths
                                            #:vpimods vpimods #:dumpformat (if dump dumpformat 'none)
-                                           #:plusargs plusargs)))
+                                           #:plusargs plusargs #:verbose (utest/verbose))))
                          (let ((succ (if succ (check-log outp) succ)))
                            (if (or succ dump (not (utest/restart-dump)))
                                (begin
@@ -802,12 +830,21 @@
         (makefile-name (caddr test)))
     (let* ((name (proc 'name))
            (name (if name name "noname"))
-           (work (mkdtemp (format "~a/~a~a-~a-~a-XXXXXX"
+           (work
-                                  base WORK_DIR_PREFIX
+            (if (utest/static)
-                                  makefile-name
+                (let ((dir-name
-                                  (string-map (lambda (c) (if (char-whitespace? c) #\_ c))
+                       (format "~a/~a~a-static"
-                                              (string-downcase name))
+                               base WORK_DIR_PREFIX
-                                  (current-time)))))
+                               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
+                                 makefile-name
+                                 (string-map (lambda (c) (if (char-whitespace? c) #\_ c))
+                                             (string-downcase name))
+                                 (current-time))))))
       ;; Execute test
       (let* ((p #f)
              (o (with-output-to-string
@@ -844,11 +881,11 @@
 (define (execute-tests tests)
   (let ((test-count (length tests))
         (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)))
 
 ;;;
@@ -931,6 +968,18 @@
     ((_ () 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
 ;;;
@@ -940,9 +989,13 @@
              (find-paths-rec
               (lambda (p t)
                 (and (eq? t 'directory)
-                     (string-match
+                     (or
-                      (format "^~a.*-[0-9]{10}-.{6}$" WORK_DIR_PREFIX)
+                      (string-match
-                      (basename p))))
+                       (format "^~a.*-[0-9]{10}-.{6}$" WORK_DIR_PREFIX)
+                       (basename p))
+                      (string-match
+                       (format "^~a.*-static$" WORK_DIR_PREFIX)
+                       (basename p)))))
               base)
              (fold
               (lambda (makefile work-dirs)
@@ -951,9 +1004,13 @@
                  (find-paths-rec
                   (lambda (p t)
                     (and (eq? t 'directory)
-                         (string-match
+                         (or
-                          (format "^~a~a.*-[0-9]{10}-.{6}$" WORK_DIR_PREFIX (basename makefile))
+                          (string-match
-                          (basename p))))
+                           (format "^~a~a.*-[0-9]{10}-.{6}$" WORK_DIR_PREFIX (basename makefile))
+                           (basename p))
+                          (string-match
+                           (format "^~a~a.*-static$" WORK_DIR_PREFIX (basename makefile))
+                           (basename p)))))
                   (dirname makefile))))
               '() (find-files-rec-regexp MAKEFILE_NAME_REGEXP base)))))
     (if (null? work-dirs)
@@ -964,6 +1021,24 @@
            (delete-recursive dir))
          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
 ;;;
@@ -999,12 +1074,14 @@
   (* "  -d, --dump           Force dump waveforms.")
   (* "  -r, --norestart      Do not restart testbench with waveform dump enabled if")
   (* "                       test failed (true by default)")
+  (* "  -s, --static         Use static work dir for initial debug purposes")
   (* "  -n, --nocolor        Do not use color for print log")
   (* "  -j, --jobs NUM       Use NUM threads for running testbenches. If <=0")
   (* "                       use as many threads as there are processors in the system.")
   (* "  -f, --defines        Print useful Verilog defines")
   (* "  -c, --clean          Delete work folders that have a corresponding 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, --version        Print version")
   (* "  -h, --help           Print this message and exit")
@@ -1025,9 +1102,11 @@
   (let* ((optspec `((keep (single-char #\k))
                     (dump (single-char #\d) (value #f))
                     (norestart (single-char #\r) (value #f))
+                    (static (single-char #\s) (value #f))
                     (nocolor (single-char #\n) (value #f))
                     (verbose (single-char #\v) (value #f))
                     (jobs (single-char #\j) (value #t) (predicate ,string->number))
+                    (extra (single-char #\x) (value #t))
                     (help (single-char #\h) (value #f))
                     (version (single-char #\V) (value #f))
                     (clean (single-char #\c) (value #f))
@@ -1046,19 +1125,20 @@
      ((option-ref options 'defines #f)     (print-verilog-defines))
      ((option-ref options 'clean #f)       (delete-work-dirs path #f))
      ((option-ref options 'force-clean #f) (delete-work-dirs path #t))
-
      (else
       (utest/keep-output  (option-ref options 'keep #f))
       (utest/force-dump   (option-ref options 'dump #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/verbose      (option-ref options 'verbose #f))
+      (utest/extra        (parse-extra-param-string (option-ref options 'extra "")))
 
       (let ((makefiles
              (if (eq? 'regular (stat:type (stat path)))
                  (list 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-parallel (collect-test-procs makefiles) jobs)))))))