91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
+
-
+
|
;;======================================================================
;; T R I G G E R S
;;======================================================================
(define (mt:process-triggers test-id newstate newstatus)
(let* ((test-dat (mt:lazy-get-test-info-by-id test-id))
(test-rundir (db:test-get-rundir test-dat))
(test-name (db:test-get-testname test-dat))
(tconfig #f)
(state (if newstate newstate (db:test-get-state test-dat)))
(status (if newstatus newstatus (db:test-get-status test-dat))))
(if (and (file-exists? test-rundir)
(directory? test-rundir))
(begin
(push-directory test-rundir)
(set! tconfig (mt:lazy-read-test-config test-dat))
(set! tconfig (mt:lazy-read-test-config test-name))
(pop-directory)
(for-each (lambda (trigger)
(let ((cmd (configf:lookup tconfig "triggers" trigger))
(logf (conc test-rundir "/last-trigger.log")))
(if cmd
(let ((fullcmd (conc "(" cmd " " test-id " " test-rundir " " trigger ") >> " logf " 2>&1")))
(debug:print-info 0 "TRIGGERED on " trigger ", running command " fullcmd)
|
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(let* ((tdat (hash-table-ref/default *test-info* test-id #f)))
(if (and tdat
(< (current-seconds)(+ (vector-ref tdat 0) 10)))
(vector-ref tdat 1)
;; no need to update *test-info* as that is done in cdb:get-test-info-by-id
(cdb:get-test-info-by-id *runremote* test-id))))
(define (mt:lazy-read-test-config test-dat)
(define (mt:lazy-read-test-config test-name)
(let* ((test-id (db:test-get-id test-dat))
(test-rundir (db:test-get-rundir test-dat))
(tconfig (hash-table-ref/default *testconfigs* test-id #f)))
(if tconfig
tconfig
(let ((newtcfg (read-config (conc test-rundir "/testconfig") #f #f))) ;; NOTE: Does NOT run [system ...]
(hash-table-set! *testconfigs* test-id newtcfg)
newtcfg))))
|