486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
|
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
|
-
+
-
+
+
+
+
+
|
(define (db:test-set-comment db run-id test-name item-path comment)
(sqlite3:execute
db
"UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;"
comment run-id test-name item-path))
;;
(define (db:test-set-rundir! db run-id testname item-path rundir)
(define (db:test-set-rundir! db run-id test-name item-path rundir)
(sqlite3:execute
db
"UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;"
rundir run-id testname item-path))
rundir run-id test-name item-path))
(define (db:test-set-log! db run-id test-name item-path logf)
(sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path=?;"
logf run-id test-name item-path))
;;======================================================================
;; Misc. test related queries
;;======================================================================
(define (db:test-get-paths-matching db keynames target)
(let* ((res '())
|
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
|
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
|
-
-
-
+
+
+
+
-
-
-
+
|
(sqlite3:for-each-row
(lambda (p)
(set! res (cons p res)))
db
qrystr)
res))
(define (db:test-update-meta-info db run-id testname item-path minutes cpuload diskfree tmpfree)
(if (not item-path)(begin (debug:print 0 "WARNING: ITEMPATH not set.") (set! item-path "")))
;; (let ((testinfo (db:get-test-info db run-id testname item-path)))
(define (db:test-update-meta-info db run-id test-name item-path minutes cpuload diskfree tmpfree)
(if (not item-path)
(begin (debug:print 0 "WARNING: ITEMPATH not set.")
(set! item-path "")))
;; (if (and (not (equal? (db:test-get-status testinfo) "COMPLETED"))
;; (not (equal? (db:test-get-status testinfo) "KILLREQ"))
testname
test-name
item-path))
(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
(if (and (not (equal? item-path ""))
(or (equal? status "PASS")
(equal? status "WARN")
(equal? status "FAIL")
|
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
|
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
|
-
+
-
-
+
+
|
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:teststep-set-status! host port)
run-id test-name teststep-name state-in status-in item-path comment logfile))
(db:teststep-set-status! db run-id test-name teststep-name state-in status-in item-path comment logfile))))
(define (rdb:test-update-meta-info db run-id testname itemdat minutes cpuload diskfree tmpfree)
(define (rdb:test-update-meta-info db run-id test-name itemdat minutes cpuload diskfree tmpfree)
(let ((item-path (item-list->path itemdat)))
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:test-update-meta-info host port)
run-id testname itemdat minutes cpuload diskfree tmpfree))
(db:test-update-meta-info db run-id testname item-path minutes cpuload diskfree tmpfree))))
run-id test-name item-path minutes cpuload diskfree tmpfree))
(db:test-update-meta-info db run-id test-name item-path minutes cpuload diskfree tmpfree))))
(define (rdb:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:test-set-state-status-by-run-id-testname host port)
run-id test-name item-path status state))
|
1104
1105
1106
1107
1108
1109
1110
|
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
|
+
+
+
+
+
+
+
+
|
(define (rdb:test-set-comment db run-id test-name item-path comment)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:test-set-comment host port)
run-id test-name item-path comment))
(db:test-set-comment db run-id test-name item-path comment)))
(define (rdb:test-set-log! db run-id test-name item-path logf)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rpc:test-set-log! host port)
run-id test-name item-path logf))
(db:test-set-log! db run-id test-name item-path logf)))
|