434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
|
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
|
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
|
run-id
(if testpatt testpatt "%")
(if itempatt itempatt "%"))
res))
;; this one is a bit broken BUG FIXME
(define (db:delete-test-step-records db run-id test-name itemdat)
;; Breaking it into two queries for better file access interleaving
(let ((ids '()))
(sqlite3:for-each-row (lambda (id)
(set! ids (cons id ids)))
db
(sqlite3:execute db "DELETE FROM test_steps WHERE test_id in (SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?);"
run-id test-name (item-list->path itemdat)))
"SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
run-id test-name (item-list->path itemdat))
(for-each (lambda (id)
(sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" id)
(thread-sleep! 0.1)) ;; give others access to the db
ids)))
;;"DELETE FROM test_steps WHERE test_id in (SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?);"
;;
(define (db:delete-test-records db test-id)
(sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id)
(sqlite3:execute db "DELETE FROM test_data WHERE test_id=?;" test-id)
(sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id))
;; set tests with state currstate and status currstatus to newstate and newstatus
|
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
|
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
|
-
+
|
;;======================================================================
;; QUEUE UP META, TEST STATUS AND STEPS
;;======================================================================
(define (db:updater db)
(let loop ((start-time (current-time)))
(thread-sleep! (+ 2 (random 10))) ;; move save time around to minimize regular collisions
(thread-sleep! 0.5) ;; move save time around to minimize regular collisions?
(db:write-cached-data db)
(loop start-time)))
(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 "")))
|
980
981
982
983
984
985
986
987
988
989
990
991
992
993
|
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
|
+
|
(mutex-lock! *incoming-mutex*)
(set! *incoming-data* (cons (vector 'step-status
(current-seconds)
;; FIXME - this should not update the logfile unless it is specified.
(list test-id teststep-name state-in status-in (current-seconds) (if comment comment "") (if logfile logfile "")))
*incoming-data*))
(mutex-unlock! *incoming-mutex*)
(if (not *cache-on*)(db:write-cached-data db))
#t)
(debug:print 0 "ERROR: Can't update " test-name " for run " run-id " -> no such test in db"))))
;;======================================================================
;; Extract ods file from the db
;;======================================================================
|