232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
-
+
|
(loop (car tal)(cdr tal)))
#f))))))
(pop-directory)
result)))
;; Do not rpc this one, do the underlying calls!!!
(define (tests:test-set-status! test-id state status comment dat)
(define (tests:test-set-status! test-id state status comment dat #!key (work-area #f))
(debug:print-info 4 "tests:test-set-status! test-id=" test-id ", state=" state ", status=" status ", dat=" dat)
(let* ((db #f)
(real-status status)
(otherdat (if dat dat (make-hash-table)))
(testdat (cdb:get-test-info-by-id *runremote* test-id))
(run-id (db:test-get-run_id testdat))
(test-name (db:test-get-testname testdat))
|
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
|
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
|
-
+
|
;; update the primary record IF state AND status are defined
(if (and state status)
(cdb:test-set-status-state *runremote* test-id real-status state (if waived waived comment)))
;; if status is "AUTO" then call rollup (note, this one modifies data in test
;; run area, it does remote calls under the hood.
(if (and test-id state status (equal? status "AUTO"))
(db:test-data-rollup #f test-id status))
(db:test-data-rollup #f test-id status work-area: work-area))
;; add metadata (need to do this way to avoid SQL injection issues)
;; :first_err
;; (let ((val (hash-table-ref/default otherdat ":first_err" #f)))
;; (if val
;; (sqlite3:execute db "UPDATE tests SET first_err=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
|
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
|
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
|
+
-
+
|
variable ","
value ","
expected ","
tol ","
units ","
dcomment ",," ;; extra comma for status
type )))
;; This was run remote, don't think that makes sense.
(cdb:remote-run db:csv->test-data #f test-id
(db:csv->test-data #f test-id
dat))))
;; need to update the top test record if PASS or FAIL and this is a subtest
(if (not (equal? item-path ""))
(cdb:roll-up-pass-fail-counts *runremote* run-id test-name item-path status))
(if (or (and (string? comment)
|
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
|
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
|
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
-
+
-
+
-
+
+
|
(lambda (count)
(set! res count))
tdb
"SELECT count(id) FROM test_rundat;")
res))
0)
(define (db:update-central-meta-info db test-id cpuload diskfree minutes num-records uname hostname)
(sqlite3:execute db "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;"
cpuload
diskfree
test-id)
(if minutes (sqlite3:execute db "UPDATE tests SET run_duration=? WHERE id=?;" minutes test-id))
(if (eq? num-records 0)
(sqlite3:execute db "UPDATE tests SET uname=?,host=? WHERE id=?;"
(define (tests:update-central-meta-info test-id cpuload diskfree minutes num-records uname hostname)
;; This is a good candidate for threading the requests to enable
;; transactionized write at the server
(cdb:tests-update-cpuload-diskfree *runremote* test-id cpuload diskfree)
;; (let ((db (open-db)))
;; (sqlite3:execute db "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;"
;; cpuload
;; diskfree
;; test-id)
(if minutes
(cdb:tests-update-run-duration *runremote* test-id minutes))
;; (sqlite3:execute db "UPDATE tests SET run_duration=? WHERE id=?;" minutes test-id))
(if (eq? num-records 0)
(cdb:tests-update-uname-host *runremote* test-id uname hostname))
;;(sqlite3:execute db "UPDATE tests SET uname=?,host=? WHERE id=?;" uname hostname test-id))
uname hostname test-id)))
(define (test-set-meta-info db test-id run-id testname itemdat minutes)
(let* ((tdb (db:open-test-db-by-test-id db test-id))
(let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))
(num-records (test:tdb-get-rundat-count tdb))
(cpuload (get-cpu-load))
(diskfree (get-df (current-directory))))
(if (eq? (modulo num-records 10) 0) ;; every ten records update central
(let ((uname (get-uname "-srvpio"))
(hostname (get-host-name)))
(cdb:remote-run db:update-central-meta-info db test-id cpuload diskfree minutes num-records uname hostname)))
(tests:update-central-meta-info test-id cpuload diskfree minutes num-records uname hostname)))
(sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);"
cpuload diskfree minutes)))
cpuload diskfree minutes)
(sqlite3:finalize! tdb)))
;;======================================================================
;; A R C H I V I N G
;;======================================================================
(define (test:archive db test-id)
#f)
(define (test:archive-tests db keynames target)
#f)
|