Megatest

Diff
Login

Differences From Artifact [0bae73b2af]:

To Artifact [2b681408f6]:


269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
;;     ;;; (mutex-unlock! *rundb-mutex*) ;;; why did we need a mutex on opening db's?
;;     (db:sync-tables db:sync-tests-only *megatest-db* db)
;;     db))

;; This routine creates the db if not already present. It is only called if the db is not already opened
;;
(define (db:open-db dbstruct #!key (areapath #f))
  (print (db:open-megatest-db path: (db:dbfile-path)))
  (let ((tmpdb (dbr:dbstruct-tmpdb dbstruct))) ;; RA => Returns the first reference in dbstruct
    (if tmpdb
	tmpdb
        ;; (mutex-lock! *rundb-mutex*)
        (let* ((dbpath       (db:dbfile-path)) ;;  0))
               (dbexists     (file-exists? dbpath))
	       (dbfexists    (file-exists? (conc dbpath "/megatest.db")))







<







269
270
271
272
273
274
275

276
277
278
279
280
281
282
;;     ;;; (mutex-unlock! *rundb-mutex*) ;;; why did we need a mutex on opening db's?
;;     (db:sync-tables db:sync-tests-only *megatest-db* db)
;;     db))

;; This routine creates the db if not already present. It is only called if the db is not already opened
;;
(define (db:open-db dbstruct #!key (areapath #f))

  (let ((tmpdb (dbr:dbstruct-tmpdb dbstruct))) ;; RA => Returns the first reference in dbstruct
    (if tmpdb
	tmpdb
        ;; (mutex-lock! *rundb-mutex*)
        (let* ((dbpath       (db:dbfile-path)) ;;  0))
               (dbexists     (file-exists? dbpath))
	       (dbfexists    (file-exists? (conc dbpath "/megatest.db")))
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
;; M E T A   G E T   A N D   S E T   V A R S
;;======================================================================

;; returns number if string->number is successful, string otherwise
;; also updates *global-delta*
;;
(define (db:get-var dbstruct var)
  (print dbstruct var)
  (let* ((res      #f)
	 (dbdat    (db:get-db dbstruct #f))
	 (db       (db:dbdat-get-db dbdat)))
    (dbi:for-each-row
     (lambda (val)
       (set! res (vector-ref val 0)))
     db







<







1673
1674
1675
1676
1677
1678
1679

1680
1681
1682
1683
1684
1685
1686
;; M E T A   G E T   A N D   S E T   V A R S
;;======================================================================

;; returns number if string->number is successful, string otherwise
;; also updates *global-delta*
;;
(define (db:get-var dbstruct var)

  (let* ((res      #f)
	 (dbdat    (db:get-db dbstruct #f))
	 (db       (db:dbdat-get-db dbdat)))
    (dbi:for-each-row
     (lambda (val)
       (set! res (vector-ref val 0)))
     db
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
;; re-read the db over and over again for the keys since they never
;; change

;; why get the keys from the db? why not get from the *configdat*
;; using keys:config-get-fields?

(define (db:get-keys dbstruct)
  (print dbstruct)
  (if *db-keys* *db-keys* 
      (let ((res '()))
	(db:with-db dbstruct #f #f
		    (lambda (db)
		      (dbi:for-each-row 
		       (lambda (key)
			 (set! res (cons (vector-ref key 0) res)))







<







1718
1719
1720
1721
1722
1723
1724

1725
1726
1727
1728
1729
1730
1731
;; re-read the db over and over again for the keys since they never
;; change

;; why get the keys from the db? why not get from the *configdat*
;; using keys:config-get-fields?

(define (db:get-keys dbstruct)

  (if *db-keys* *db-keys* 
      (let ((res '()))
	(db:with-db dbstruct #f #f
		    (lambda (db)
		      (dbi:for-each-row 
		       (lambda (key)
			 (set! res (cons (vector-ref key 0) res)))
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
   dbstruct
   #f ;; this is for the main runs db
   #f ;; does not modify db
   (lambda (db)
     (let ((res #f))
       (dbi:for-each-row
	(lambda (runname)
    (print runname)
	  (set! res runname))
	db
	"SELECT runname FROM runs WHERE id=?;"
	run-id)
       res))))

(define (db:get-run-key-val dbstruct run-id key)
  (db:with-db
   dbstruct
   #f
   #f
   (lambda (db)
     (let ((res #f))
       (dbi:for-each-row
	(lambda (val)
    (print val)
	  (set! res val))
	db
	(conc "SELECT " key " FROM runs WHERE id=?;")
	run-id)
       res))))

;; keys list to key1,key2,key3 ...







<















<







1759
1760
1761
1762
1763
1764
1765

1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780

1781
1782
1783
1784
1785
1786
1787
   dbstruct
   #f ;; this is for the main runs db
   #f ;; does not modify db
   (lambda (db)
     (let ((res #f))
       (dbi:for-each-row
	(lambda (runname)

	  (set! res runname))
	db
	"SELECT runname FROM runs WHERE id=?;"
	run-id)
       res))))

(define (db:get-run-key-val dbstruct run-id key)
  (db:with-db
   dbstruct
   #f
   #f
   (lambda (db)
     (let ((res #f))
       (dbi:for-each-row
	(lambda (val)

	  (set! res val))
	db
	(conc "SELECT " key " FROM runs WHERE id=?;")
	run-id)
       res))))

;; keys list to key1,key2,key3 ...
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
;;    ;; 	    ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))
;;    ;; 	    ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
;;    ;; 	    ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
;;    ;; 	  #f)
;;    ;; 	)))

(define (db:get-all-state-status-counts-for-test db run-id test-name item-path)
  (sqlite3:map-row
   (lambda (state status count)
     (make-dbr:counts state: state status: status count: count))
   db
   "SELECT state,status,count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND item_path !=? GROUP BY state,status;"
   run-id test-name item-path))


(define (db:get-all-item-states db run-id test-name)
  (sqlite3:map-row 
   (lambda (a) a)
   db
   "SELECT DISTINCT state FROM tests WHERE item_path != '' AND state != 'DELETED' AND run_id=? AND testname=?"
   run-id test-name))

(define (db:get-all-item-statuses db run-id test-name)
  (sqlite3:map-row 
   (lambda (a) a)
   db
   "SELECT DISTINCT status FROM tests WHERE item_path != '' AND state != 'DELETED' AND state='COMPLETED' AND run_id=? AND testname=?"
   run-id test-name))

(define (db:test-get-logfile-info dbstruct run-id test-name)
  (db:with-db







|








|






|







3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
;;    ;; 	    ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))
;;    ;; 	    ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
;;    ;; 	    ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
;;    ;; 	  #f)
;;    ;; 	)))

(define (db:get-all-state-status-counts-for-test db run-id test-name item-path)
  (dbi:map-row
   (lambda (state status count)
     (make-dbr:counts state: state status: status count: count))
   db
   "SELECT state,status,count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND item_path !=? GROUP BY state,status;"
   run-id test-name item-path))


(define (db:get-all-item-states db run-id test-name)
  (dbi:map-row 
   (lambda (a) a)
   db
   "SELECT DISTINCT state FROM tests WHERE item_path != '' AND state != 'DELETED' AND run_id=? AND testname=?"
   run-id test-name))

(define (db:get-all-item-statuses db run-id test-name)
  (dbi:map-row 
   (lambda (a) a)
   db
   "SELECT DISTINCT status FROM tests WHERE item_path != '' AND state != 'DELETED' AND state='COMPLETED' AND run_id=? AND testname=?"
   run-id test-name))

(define (db:test-get-logfile-info dbstruct run-id test-name)
  (db:with-db