| ︙ | | | ︙ | |
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(declare (unit db))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses client))
(declare (uses mt))
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
|
|
|
|
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(declare (unit db))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
;; (declare (uses client))
;; (declare (uses mt))
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
|
| ︙ | | | ︙ | |
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
|
(let* ((keyvals (db:get-key-vals dbstruct run-id))
(thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
thekey))
;; Get run-ids for runs with same target but different runnames and NOT run-id
;;
(define (db:get-prev-run-ids dbstruct run-id)
(let* ((keyvals (rmt:get-key-val-pairs run-id))
(kvalues (map cadr keyvals))
(keys (rmt:get-keys))
(qrystr (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND ")))
(let ((prev-run-ids '()))
(if (null? keyvals)
'()
(begin
(db:with-db dbstruct #f #f ;; #f means work with the zeroth db - i.e. the runs db
(lambda (db)
|
|
|
|
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
|
(let* ((keyvals (db:get-key-vals dbstruct run-id))
(thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
thekey))
;; Get run-ids for runs with same target but different runnames and NOT run-id
;;
(define (db:get-prev-run-ids dbstruct run-id)
(let* ((keyvals (db:get-key-val-pairs run-id))
(kvalues (map cadr keyvals))
(keys (db:get-keys))
(qrystr (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND ")))
(let ((prev-run-ids '()))
(if (null? keyvals)
'()
(begin
(db:with-db dbstruct #f #f ;; #f means work with the zeroth db - i.e. the runs db
(lambda (db)
|
| ︙ | | | ︙ | |
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
|
(sqlite3:execute db qry
(or newstate currstate "NOT_STARTED")
(or newstatus currstate "UNKNOWN")
run-id testname)))
(if test-id
(begin
(set! test-ids (cons test-id test-ids))
(mt:process-triggers dbstruct run-id test-id newstate newstatus)))))
testnames)
test-ids))
;; ;; speed up for common cases with a little logic
;; ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id
;;
;; NOTE: run-id is not used
|
|
>
|
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
|
(sqlite3:execute db qry
(or newstate currstate "NOT_STARTED")
(or newstatus currstate "UNKNOWN")
run-id testname)))
(if test-id
(begin
(set! test-ids (cons test-id test-ids))
#;(mt:process-triggers dbstruct run-id test-id newstate newstatus) ;; WARNING: trigger processing used to happen here!
))))
testnames)
test-ids))
;; ;; speed up for common cases with a little logic
;; ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id
;;
;; NOTE: run-id is not used
|
| ︙ | | | ︙ | |
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
|
((and newstate newstatus)
(sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
(else
(if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id))
(if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id))
(if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment ;; (sdb:qry 'getid newcomment)
test-id))))))
(mt:process-triggers dbstruct run-id test-id newstate newstatus))
;; NEW BEHAVIOR: Count tests running in all runs!
;;
(define (db:get-count-tests-running dbstruct run-id)
(db:with-db
dbstruct
run-id
|
|
>
|
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
|
((and newstate newstatus)
(sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
(else
(if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id))
(if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id))
(if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment ;; (sdb:qry 'getid newcomment)
test-id))))))
#;(mt:process-triggers dbstruct run-id test-id newstate newstatus) ;; WARNING: Trigger processing used to happen here!
)
;; NEW BEHAVIOR: Count tests running in all runs!
;;
(define (db:get-count-tests-running dbstruct run-id)
(db:with-db
dbstruct
run-id
|
| ︙ | | | ︙ | |