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))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
<
|
|
|
|
|
|
|
|
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
|
;;
(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)
((test-name "") : string)
((state "") : string)
((status "") : string)
((event-time -1) : number)
((host "") : string)
((cpu-load -1) : number)
((disk-free -1) : number)
((uname "") : string)
((run-dir "") : string)
((item-path "") : string)
((run-duration -1) : number)
((final-logf "") : string)
((comment "") : string)
((process-id -1) : number)
((archived -1) : number)
((short-dir -1) : number)
((attempt-num -1) : number))
(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-test-name 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-cpu-load typed-rec))
(define (db:test-get-diskfree typed-rec) (db:test-rec-disk-free 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-run-dir 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
|