1(use-modules (srfi srfi-64)
2             (srfi srfi-26))
3
4(load-from-path "env.scm")
5
6(define-syntax test-name
7  (lambda (x)
8    (syntax-case x ()
9      ((_ <schematic> <backend>)
10       #'(string-append <schematic> "-" <backend>)))))
11
12(define default-test-directory
13  (build-filename *abs-top-srcdir* "utils" "netlist" "tests"))
14
15(define backend-directory
16  (build-filename *abs-top-srcdir* "utils" "netlist" "scheme" "backend"))
17
18(define default-symbol-directory
19  (build-filename default-test-directory "symcache"))
20
21(define* (test-netlist schematic
22                       backend
23                       #:key
24                       (schematics #f)
25                       (testdir #f)
26                       (golden #f)
27                       (complib #f))
28  (let* ((test-directory (or testdir default-test-directory))
29         (cwd (getcwd))
30         (schematic-filenames (map (cut build-filename test-directory <>)
31                                   (or schematics
32                                       (list schematic))))
33         (base (string-drop-right schematic 4))
34         (golden (or golden (string-append base "-" backend ".out")))
35         (golden-out (build-filename test-directory golden))
36         (test-out (tmpnam)))
37
38    (for-each
39     (lambda (sch)
40       (test-assert (file-exists? sch)))
41     schematic-filenames)
42
43    (test-assert (file-exists? golden-out))
44
45    (when testdir (chdir testdir))
46
47    (test-eq EXIT_SUCCESS
48      (status:exit-val
49       (apply system*
50              *netlister*
51              "-L" backend-directory
52              "-c" (string-append "(component-library \""
53                                  (or complib default-symbol-directory)
54                                  "\")")
55              "-g" backend
56              "-o" test-out
57              schematic-filenames)))
58
59    (when testdir (chdir cwd))
60
61    (test-eq EXIT_SUCCESS
62      (status:exit-val (system* "diff" test-out golden-out)))
63
64    (when (file-exists? test-out) (delete-file test-out))))
65
66
67(define-syntax test-schematic
68  (lambda (stx)
69    (syntax-case stx ()
70      ((_ <schematic> <backend> <args> ...)
71       #'(begin
72           (test-begin (test-name <schematic> <backend>))
73           (test-netlist <schematic> <backend> <args> ...)
74           (test-end (test-name <schematic> <backend>)))))))
75
76(test-begin "netlister")
77
78(test-assert (file-exists? *netlister*))
79(test-eq EXIT_SUCCESS
80  (status:exit-val (system* *netlister* "--help")))
81
82(test-end "netlister")
83
84
85(test-schematic "stack-torture.sch" "geda")
86(test-schematic "stack_1.sch" "geda")
87
88(define switcap-example-dir
89  (build-filename *abs-top-srcdir*
90                  "utils"
91                  "netlist"
92                  "examples"
93                  "switcap"))
94
95(define switcap-example-symbol-dir
96  (build-filename switcap-example-dir "cache"))
97
98(test-schematic "switcap.sch"
99                "switcap"
100                #:schematics '("ckt.sch" "clocks.sch" "analysis.sch")
101                #:testdir switcap-example-dir
102                #:golden "example.scn"
103                #:complib switcap-example-symbol-dir)
104
105(test-schematic "utf8.sch" "geda")
106