︙ | | |
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
|
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
|
-
+
|
;;
(define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3))
(if (<= try-num 0)
#f
(handle-exceptions
exn
(begin
(print "Attempt to safely close sqlite3 db failed. Trying again. exn=" exn)
(debug:print 0 *default-log-port* "Attempt to safely close sqlite3 db failed. Trying again. exn=" exn)
(thread-sleep! 3)
(sqlite3:interrupt! db)
(db:safely-close-sqlite3-db db stmt-cache try-num: (- try-num 1)))
(if (sqlite3:database? db)
(let* ((stmts (and stmt-cache (hash-table-ref/default stmt-cache db #f))))
(if stmts (map sqlite3:finalize! (hash-table-values stmts)))
(sqlite3:finalize! db)
|
︙ | | |
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
|
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
|
-
+
|
;;
;; NOPE: apply this same approach to all db files
;;
(else ;; ((equal? fname "megatest.db") ;; this file can be regenerated if needed
(handle-exceptions
exn
(begin
(print "Problems trying to repair the db, exn=" exn)
(debug:print 0 *default-log-port* "Problems trying to repair the db, exn=" exn)
;; (db:move-and-recreate-db dbdat)
(if (> numtries 0)
(db:repair-db dbdat numtries: (- numtries 1))
#f)
(debug:print 0 *default-log-port* "FATAL: file " dbpath " was found corrupted, an attempt to fix has been made but you must start over.")
(debug:print 0 *default-log-port*
" check the following:\n"
|
︙ | | |
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
|
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
|
-
+
|
#;(db (dbr:dbdat-db dbdat)))
(for-each (lambda (key)
(let ((keyn key))
(if (member (string-downcase keyn)
(list "runname" "state" "status" "owner" "event_time" "comment" "fail_count"
"pass_count" "contour"))
(begin
(print "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table, you must remove your megatest.db and <linktree>/.db before trying again.")
(debug:print 0 *default-log-port* "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table, you must remove your megatest.db and <linktree>/.db before trying again.")
(exit 1)))))
keys)
(sqlite3:with-transaction
db
(lambda ()
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS locks
(id INTEGER PRIMARY KEY,
|
︙ | | |
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
|
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
|
+
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
|
(set! result (append (if (null? waiton-tests)(list waitontest-name) waiton-tests) result))))))
waitons)
(delete-duplicates result)))))
;;======================================================================
;; To sync individual run
;;======================================================================
(define (db:get-run-record-ids dbstruct target run keynames test-patt)
(let ((backcons (lambda (lst item)(cons item lst))))
(let ((backcons (lambda (lst item)(cons item lst))))
(db:with-db
dbstruct #f #f
(lambda (db)
(let* ((keystr (string-intersperse
(map (lambda (key val)
(conc key " like '" val "'"))
keynames
(string-split target "/"))
" AND "))
(run-qry (conc "SELECT id FROM runs WHERE " keystr " and runname='" run"'"))
(test-qry (conc "SELECT id FROM tests WHERE run_id in (" run-qry ") and testname like '" test-patt "'")))
(print run-qry)
(print test-qry)
(let* ((keystr (string-intersperse
(map (lambda (key val)
(conc key " like '" val "'"))
keynames
(string-split target "/"))
" AND "))
(run-qry (conc "SELECT id FROM runs WHERE " keystr " and runname='" run"'"))
(test-qry (conc "SELECT id FROM tests WHERE run_id in (" run-qry ") and testname like '" test-patt "'")))
;; (print run-qry)
;; (print test-qry)
`((runs . ,(sqlite3:fold-row backcons '() db run-qry))
(tests . ,(sqlite3:fold-row backcons '() db test-qry))
(test_steps . ,(sqlite3:fold-row backcons '() db (conc "SELECT id FROM test_steps WHERE test_id in (" test-qry ")")))
(test_data . ,(sqlite3:fold-row backcons '() db (conc "SELECT id FROM test_data WHERE test_id in (" test-qry ")" )))
))))))
;;======================================================================
|
︙ | | |