1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
(use-modules (srfi srfi-1)
(srfi srfi-26))
(load-from-path "env.scm")
(define default-test-directory
(build-filename *abs-top-srcdir* "utils" "update" "tests"))
(define lepton-update
(build-filename *abs-top-builddir*
"utils"
"update"
"lepton-update"))
(test-begin "update-utility")
(test-assert (file-exists? lepton-update))
;;; Test command-line options.
(test-run-success lepton-update)
(test-run-success lepton-update "--help")
(test-run-success lepton-update "-h")
(test-run-success lepton-update "-h" "any-non-existing-file")
(test-grep-stdout "Usage" lepton-update "--help")
(test-run-success lepton-update "--version")
(test-run-success lepton-update "-V")
(test-run-success lepton-update "-V" "any-non-existing-file")
(test-grep-stdout "lepton-update" lepton-update "--version")
(test-end "update-utility")
(define (build-test-filename name)
(build-filename *abs-top-srcdir* "utils" "update" "tests" name))
(define testdir (build-filename (getcwd) "run.update.test"))
;;; Setup/teardown of directories / files needed by tests
(define (config-test-setup)
(mkdir testdir))
(define (config-test-teardown)
(system* "rm" "-rf" testdir))
(define file-does-not-exist? (negate file-exists?))
(define (touch file)
(with-output-to-file file (lambda () (display ""))))
(test-begin "update-files")
(test-group-with-cleanup "update-files"
;; Set up.
(config-test-setup)
;; Test body.
(let* ((test-basenames '("net-attribute.sch" "oldslot.sym" "old_symbol.sym"))
(test-files (map (cut build-test-filename <>) test-basenames))
(test-copies (map (cut build-filename testdir <>) test-basenames))
(golden-files (map (cut string-append <> ".upd") test-files))
(golden-copies (map (cut string-append <> ".upd") test-copies))
(backups (map (cut string-append <> ".bak") test-copies)))
(for-each (cut copy-file <> <>) test-files test-copies)
(for-each (cut copy-file <> <>) golden-files golden-copies)
(test-assert (every file-exists? (append test-copies golden-copies)))
;; There should not be backups yet.
(test-assert (every file-does-not-exist? backups))
(test-eq EXIT_SUCCESS
(status:exit-val
(apply system* lepton-update test-copies)))
(for-each
;; Process each pair separately.
(lambda (test-copy golden-copy)
;; After the update command, test and golden files should
;; not differ excluding, maybe, the version line.
;; Remove the first line in both test and golden files.
;; Please note, "-ibak -e" is required by non-GNU sed. GNU
;; sed works well with just "-i".
(system* "sed" "-ibak" "-e" "1d" test-copy)
(system* "sed" "-ibak" "-e" "1d" golden-copy)
;; For debugging purposes, output the command we run.
(format (current-error-port)
"Test: diff ~A ~A\n" test-copy golden-copy)
;; Diff the result.
(test-run-success "diff" test-copy golden-copy))
;; File lists to process.
test-copies golden-copies)
;; Test that backups have been created.
(test-assert (every file-exists? backups))
;; Test that the backups are identical to the initial files.
(for-each
(lambda (backup test-file)
(test-run-success "diff" backup test-file))
backups test-files)
;; Check that the utility does not fail on files having
;; backups and prompts the user they are skipped.
(test-run-success lepton-update (car test-copies))
(test-grep-stderr "Skipping" lepton-update (car test-copies))
(let ((dir-name (build-filename testdir "dir.sch")))
(mkdir dir-name)
(test-grep-stderr "Skipping" lepton-update dir-name))
(let ((file-name (build-filename testdir (string-append (basename (tmpnam)) ".sym"))))
(touch file-name)
(chmod file-name #o000)
(test-grep-stderr "Skipping" lepton-update file-name))
(test-grep-stderr "Skipping" lepton-update "some-non-existing-schematic-file.sch")
;; File without a proper extension.
(let ((file-name (build-filename testdir (basename (tmpnam))))
(tmp (build-filename testdir (basename (tmpnam)))))
(with-error-to-file tmp
(lambda ()
(test-run-failure lepton-update file-name)
(test-run-success "grep" "type of file" tmp)))))
;; Clean up.
(config-test-teardown))
(test-end "update-files")
|
