Megatest

Diff
Login

Differences From Artifact [a59a7c6f2f]:

To Artifact [4cb3a2fdba]:


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)
	  (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)







|







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
	  (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
     ;; 
     ;;  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)
	 ;; (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"







|







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
	 (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
	 #;(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.")
			(exit 1)))))
	      keys)
    (sqlite3:with-transaction
     db
     (lambda ()
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS locks
                                   (id INTEGER PRIMARY KEY,







|







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
			(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
                (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))))
    (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) 
	 `((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 ")" )))
	   ))))))

;;======================================================================







>

|



|
|
|
|
|
|
|
|
|
|







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))))
    (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) 
	 `((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 ")" )))
	   ))))))

;;======================================================================