| ︙ | | |
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
-
+
|
(hash-table-set! tests-hash full-testname testdat))))
results)
(if (null? tal)
(map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
(loop (car tal)(cdr tal))))))))))
;;
(define (test-set-status! db test-id state status comment dat)
(define (tests:test-set-status! db test-id state status comment dat)
(let* ((real-status status)
(otherdat (if dat dat (make-hash-table)))
(testdat (db:get-test-info-by-id db test-id))
(run-id (db:test-get-run_id testdat))
(test-name (db:test-get-testname testdat))
(item-path (db:test-get-item-path testdat))
;; before proceeding we must find out if the previous test (where all keys matched except runname)
|
| ︙ | | |
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
-
+
|
(if (or (and (string? comment)
(string-match (regexp "\\S+") comment))
waived)
(let ((cmt (if waived waived comment)))
(db:test-set-comment db test-id cmt)))
))
(define (test-set-toplog! db run-id test-name logf)
(define (tests:test-set-toplog! db run-id test-name logf)
(sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';"
logf run-id test-name))
(define (tests:summarize-items db run-id test-name force)
;; if not force then only update the record if one of these is true:
;; 1. logf is "log/final.log
;; 2. logf is same as outputfilename
|
| ︙ | | |
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
|
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
|
-
+
|
(print "<table cellspacing=\"0\" border=\"1\">"
"<tr><td>Item</td><td>State</td><td>Status</td><td>Comment</td>"
outtxt "</table></body></html>")
(release-dot-lock outputfilename)))
(close-output-port oup)
(change-directory orig-dir)
(test-set-toplog! db run-id test-name outputfilename)
(tests:test-set-toplog! db run-id test-name outputfilename)
)))))
(define (get-all-legal-tests)
(let* ((tests (glob (conc *toppath* "/tests/*")))
(res '()))
(debug:print 4 "INFO: Looking at tests " (string-intersperse tests ","))
(for-each (lambda (testpath)
|
| ︙ | | |
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
|
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
|
-
+
-
+
|
(tests:register-test db run-id test-name item-path)))
(define (rtests:test-set-status! db test-id state status comment dat)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rtests:test-set-status! host port) test-id state status comment dat))
(test-set-status! db test-id state status comment dat)))
(tests:test-set-status! db test-id state status comment dat)))
(define (rtests:test-set-toplog! db run-id test-name logf)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rtests:test-set-toplog! host port) run-id test-name logf))
(test-set-toplog! db run-id test-name logf)))
(tests:test-set-toplog! db run-id test-name logf)))
|