Megatest

Diff
Login

Differences From Artifact [e7de2918f8]:

To Artifact [a7b6fe1509]:


257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
	     (dbexists  (file-exists? dbpath))
	     (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					       (string->number (args:get-arg "-override-timeout"))
					       136000))))
	(handle-exceptions
	 exn
	 (begin
	   (debug:print 0 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
			((condition-property-accessor 'exn 'message) exn))
	   (set! db (sqlite3:open-database ":memory:"))) ;; open an in-memory db to allow readonly access 
	 (set! db (sqlite3:open-database dbpath)))
	(sqlite3:set-busy-handler! db handler)
	(if (not dbexists)
	    (begin
	      (sqlite3:execute db "PRAGMA synchronous = FULL;")







|







257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
	     (dbexists  (file-exists? dbpath))
	     (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					       (string->number (args:get-arg "-override-timeout"))
					       136000))))
	(handle-exceptions
	 exn
	 (begin
	   (debug:print 2 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
			((condition-property-accessor 'exn 'message) exn))
	   (set! db (sqlite3:open-database ":memory:"))) ;; open an in-memory db to allow readonly access 
	 (set! db (sqlite3:open-database dbpath)))
	(sqlite3:set-busy-handler! db handler)
	(if (not dbexists)
	    (begin
	      (sqlite3:execute db "PRAGMA synchronous = FULL;")
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
		(sqlite3:prepare db stmt))
	      (list
	       ;; delete all tests that belong to runs that are 'deleted'
	       "DELETE FROM tests WHERE run_id in (SELECT id FROM runs WHERE state='deleted');"
	       ;; delete all tests that are 'DELETED'
	       "DELETE FROM tests WHERE state='DELETED';"
	       ;; delete all tests that have no run
	       "DELETE FROM tests WHERE run_id NOT IN (SELECT DISTINCT run_id FROM runs);"
	       ;; delete all runs that are state='deleted'
	       "DELETE FROM runs WHERE state='deleted';"
	       ;; delete empty runs
	       "DELETE FROM runs WHERE id NOT IN (SELECT DISTINCT r.id FROM runs AS r INNER JOIN tests AS t ON t.run_id=r.id);"
	       ))))
    (sqlite3:with-transaction 
     db







|







480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
		(sqlite3:prepare db stmt))
	      (list
	       ;; delete all tests that belong to runs that are 'deleted'
	       "DELETE FROM tests WHERE run_id in (SELECT id FROM runs WHERE state='deleted');"
	       ;; delete all tests that are 'DELETED'
	       "DELETE FROM tests WHERE state='DELETED';"
	       ;; delete all tests that have no run
	       "DELETE FROM tests WHERE run_id NOT IN (SELECT DISTINCT id FROM runs);"
	       ;; delete all runs that are state='deleted'
	       "DELETE FROM runs WHERE state='deleted';"
	       ;; delete empty runs
	       "DELETE FROM runs WHERE id NOT IN (SELECT DISTINCT r.id FROM runs AS r INNER JOIN tests AS t ON t.run_id=r.id);"
	       ))))
    (sqlite3:with-transaction 
     db
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
		 (lambda (id)
		   (set! res id))
		 db
		 (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");")))
					;(debug:print 4 "qry: " qry) 
		   qry)
		 qryvals)
	  (sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=?;" state status res)
	  res) 
	(begin
	  (debug:print 0 "ERROR: Called without all necessary keys")
	  #f))))


;; replace header and keystr with a call to runs:get-std-run-fields







|







643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
		 (lambda (id)
		   (set! res id))
		 db
		 (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");")))
					;(debug:print 4 "qry: " qry) 
		   qry)
		 qryvals)
	  (sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=? AND state='deleted';" state status res)
	  res) 
	(begin
	  (debug:print 0 "ERROR: Called without all necessary keys")
	  #f))))


;; replace header and keystr with a call to runs:get-std-run-fields
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
  (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id)
  (debug:print-info 11 "db:set-comment-for-run END run-id: " run-id " comment: " comment))

;; does not (obviously!) removed dependent data. But why not!!?
(define (db:delete-run db run-id)
  (common:clear-caches) ;; don't trust caches after doing any deletion
  ;; First set any related tests to DELETED
  (let ((stmt1 (sqlite3:prepare db "UPDATE tests SET state='DELETED' WHERE run_id=?;"))
	(stmt2 (sqlite3:prepare db "UPDATE runs SET state='deleted' WHERE id=?;")))
    (sqlite3:with-transaction
     db (lambda ()
	  (sqlite3:execute stmt1 run-id)
	  (sqlite3:execute stmt2 run-id)))
    (sqlite3:finalize! stmt1)
    (sqlite3:finalize! stmt2)))
;;  (sqlite3:execute db "DELETE FROM runs WHERE id=?;" run-id))







|
|







816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
  (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id)
  (debug:print-info 11 "db:set-comment-for-run END run-id: " run-id " comment: " comment))

;; does not (obviously!) removed dependent data. But why not!!?
(define (db:delete-run db run-id)
  (common:clear-caches) ;; don't trust caches after doing any deletion
  ;; First set any related tests to DELETED
  (let ((stmt1 (sqlite3:prepare db "UPDATE tests SET state='DELETED',comment='' WHERE run_id=?;"))
	(stmt2 (sqlite3:prepare db "UPDATE runs SET state='deleted',comment='' WHERE id=?;")))
    (sqlite3:with-transaction
     db (lambda ()
	  (sqlite3:execute stmt1 run-id)
	  (sqlite3:execute stmt2 run-id)))
    (sqlite3:finalize! stmt1)
    (sqlite3:finalize! stmt2)))
;;  (sqlite3:execute db "DELETE FROM runs WHERE id=?;" run-id))
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
  ;; (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id))
  (if db 
      (begin
	(sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id)
	(sqlite3:execute db "DELETE FROM test_data  WHERE test_id=?;" test-id)
	(if force
	    (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id)
	    (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a' WHERE id=?;" test-id)))))

(define (db:delete-tests-for-run db run-id)
  (common:clear-caches)
  (sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id))

(define (db:delete-old-deleted-test-records db)
  (common:clear-caches)







|







1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
  ;; (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id))
  (if db 
      (begin
	(sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id)
	(sqlite3:execute db "DELETE FROM test_data  WHERE test_id=?;" test-id)
	(if force
	    (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id)
	    (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id)))))

(define (db:delete-tests-for-run db run-id)
  (common:clear-caches)
  (sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id))

(define (db:delete-old-deleted-test-records db)
  (common:clear-caches)
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
      0 ;; 
      (let ((res 0))
	(sqlite3:for-each-row
	 (lambda (count)
	   (set! res count))
	 db
	 "SELECT count(id) FROM tests WHERE state = 'RUNNING' OR state = 'LAUNCHED' OR state = 'REMOTEHOSTSTART'
             AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?;"
	 jobgroup)
	res)))

;; done with run when:
;;   0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining db run-id)
  (let ((res 0))







|







1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
      0 ;; 
      (let ((res 0))
	(sqlite3:for-each-row
	 (lambda (count)
	   (set! res count))
	 db
	 "SELECT count(id) FROM tests WHERE state = 'RUNNING' OR state = 'LAUNCHED' OR state = 'REMOTEHOSTSTART'
             AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?);"
	 jobgroup)
	res)))

;; done with run when:
;;   0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining db run-id)
  (let ((res 0))
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
             WHERE run_id=? AND testname=? AND item_path='';")
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE run_id=? AND testname=? AND item_path='';")
	'(top-test-set-per-pf-counts "UPDATE tests
                       SET state=CASE 
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE run_id=? AND testname=?
                                                     AND item_path != '' 
                                                     AND state in ('RUNNING','NOT_STARTED')) > 0 THEN 'RUNNING'
                                   ELSE 'COMPLETED' END,
                            status=CASE 
                                  WHEN fail_count > 0 THEN 'FAIL' 
                                  WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE run_id=? AND testname=?
                                              AND item_path != ''







|







1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
             WHERE run_id=? AND testname=? AND item_path='';")
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE run_id=? AND testname=? AND item_path='';")
	'(top-test-set-per-pf-counts "UPDATE tests
                       SET state=CASE 
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE run_id=? AND testname=?
                                                     AND item_path != '' 
                                                     AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'RUNNING'
                                   ELSE 'COMPLETED' END,
                            status=CASE 
                                  WHEN fail_count > 0 THEN 'FAIL' 
                                  WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE run_id=? AND testname=?
                                              AND item_path != ''