1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
;; Copyright 2006-2011, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; (include "common.scm")
;; (include "megatest-version.scm")
(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))
|
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
;; Copyright 2006-2011, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; (include "common.scm")
;; (include "megatest-version.scm")
(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 format)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))
|
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
|
(debug:print 2 "Run: "
(string-intersperse (map (lambda (x)
(db:get-value-by-header run header x))
keynames) "/")
"/"
(db:get-value-by-header run header "runname"))
(let ((run-id (db:get-value-by-header run header "id")))
(let ((tests (db-get-tests-for-run db run-id testpatt itempatt #f #f)))
;; Each test
(for-each
(lambda (test)
(format #t
" Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
(conc (db:test-get-testname test)
(if (equal? (db:test-get-item-path test) "")
|
|
|
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
|
(debug:print 2 "Run: "
(string-intersperse (map (lambda (x)
(db:get-value-by-header run header x))
keynames) "/")
"/"
(db:get-value-by-header run header "runname"))
(let ((run-id (db:get-value-by-header run header "id")))
(let ((tests (db-get-tests-for-run db run-id testpatt itempatt '() '())))
;; Each test
(for-each
(lambda (test)
(format #t
" Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
(conc (db:test-get-testname test)
(if (equal? (db:test-get-item-path test) "")
|