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
|
;;
(define (dbr:dbstruct-get-localdb v run-id)
(hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f))
(define (dbr:dbstruct-set-localdb! v run-id db)
(hash-table-set! (dbr:dbstruct-get-locdbs v) run-id db))
(define (make-db:test)(make-vector 20))
(define-inline (db:test-get-id vec) (vector-ref vec 0))
(define-inline (db:test-get-run_id vec) (vector-ref vec 1))
(define-inline (db:test-get-testname vec) (vector-ref vec 2))
(define-inline (db:test-get-state vec) (vector-ref vec 3))
(define-inline (db:test-get-status vec) (vector-ref vec 4))
(define-inline (db:test-get-event_time vec) (vector-ref vec 5))
(define-inline (db:test-get-host vec) (vector-ref vec 6))
(define-inline (db:test-get-cpuload vec) (vector-ref vec 7))
(define-inline (db:test-get-diskfree vec) (vector-ref vec 8))
(define-inline (db:test-get-uname vec) (vector-ref vec 9))
;; (define-inline (db:test-get-rundir vec) (sdb:qry 'getstr (vector-ref vec 10)))
(define-inline (db:test-get-rundir vec) (vector-ref vec 10))
(define-inline (db:test-get-item-path vec) (vector-ref vec 11))
(define-inline (db:test-get-run_duration vec) (vector-ref vec 12))
(define-inline (db:test-get-final_logf vec) (vector-ref vec 13))
(define-inline (db:test-get-comment vec) (vector-ref vec 14))
(define-inline (db:test-get-process_id vec) (vector-ref vec 16))
(define-inline (db:test-get-archived vec) (vector-ref vec 17))
;; (define-inline (db:test-get-pass_count vec) (vector-ref vec 15))
;; (define-inline (db:test-get-fail_count vec) (vector-ref vec 16))
(define-inline (db:test-get-fullname vec)
(conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))
;; replace runs:make-full-test-name with this routine
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
|
|
|
|
|
|
|
|
<
|
|
|
|
|
|
|
|
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
|
;;
(define (dbr:dbstruct-get-localdb v run-id)
(hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f))
(define (dbr:dbstruct-set-localdb! v run-id db)
(hash-table-set! (dbr:dbstruct-get-locdbs v) run-id db))
(require-extension typed-records)
(defstruct db:test-rec ((id -1) : number)
((run_id -1) : number)
((testname "") : string)
((state "") : string)
((status "") : string)
((event_time -1) : number)
((host "") : string)
((cpuload -1) : number)
((diskfree -1) : number)
((uname "") : string)
((rundir "") : string)
((item_path "") : string)
((run_duration -1) : number)
((final_logf "") : string)
((comment "") : string)
((process-id -1) : number)
((archived -1) : number)
((shortdir -1) : number)
((attemptnum -1) : number))
"id" "run_id" "testname" "state" "status" "event_time"
"host" "cpuload" "diskfree" "uname" "rundir" "item_path"
"run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived"
(define (db:qry-gen-alist qrystr listvals)
(define listqry (string-split qrystr ","))
(if (null? listqry)
'()
(let loop ((strhead (car listqry))
(strtail (cdr listqry))
(valhead (car listvals))
(valtail (cdr listvals))
(res '()))
(let* ((slot-val-pair (cons (string->symbol strhead) valhead)))
(if (or (null? strtail)
(null? valtail))
(cons slot-val-pair res);;(print strhead valhead));;(cons (cons (string->symbol strhead) valhead) res))
(loop (car strtail)(cdr strtail)(car valtail)(cdr valtail)(cons slot-val-pair res)))))))
(define (db:test-get-id typed-rec) (db:test-rec-id typed-rec))
(define (db:test-get-run_id typed-rec) (db:test-rec-run_id typed-rec))
(define (db:test-get-testname typed-rec) (db:test-rec-testname typed-rec))
(define (db:test-get-state typed-rec) (db:test-rec-state typed-rec))
(define (db:test-get-status typed-rec) (db:test-rec-status typed-rec))
(define (db:test-get-event_time typed-rec) (db:test-rec-event_time typed-rec))
(define (db:test-get-host typed-rec) (db:test-rec-host typed-rec))
(define (db:test-get-cpuload typed-rec) (db:test-rec-cpuload typed-rec))
(define (db:test-get-diskfree typed-rec) (db:test-rec-diskfree typed-rec))
(define (db:test-get-uname typed-rec) (db:test-rec-uname typed-rec))
(define (db:test-get-rundir typed-rec) (db:test-rec-rundir typed-rec))
(define (db:test-get-item-path typed-rec) (db:test-rec-item_path typed-rec))
(define (db:test-get-run_duration typed-rec) (db:test-rec-run_duration typed-rec))
(define (db:test-get-final_logf typed-rec) (db:test-rec-final_logf typed-rec))
(define (db:test-get-comment typed-rec) (db:test-rec-comment typed-rec))
(define (db:test-get-process_id typed-rec) (db:test-rec-process-id typed-rec))
(define (db:test-get-archived typed-rec) (db:test-rec-archived typed-rec))
;; (define-inline (db:test-get-pass_count vec) (vector-ref vec 15))
;; (define-inline (db:test-get-fail_count vec) (vector-ref vec 16))
(define-inline (db:test-get-fullname vec)
(conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))
;; replace runs:make-full-test-name with this routine
|