Megatest

;; WARNING: SQL injection risk
(define (db:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus)
  (for-each (lambda (testname)
	      (let ((qry (conc "UPDATE tests SET state=?,status=? WHERE "
					(if currstate  (conc "state='" currstate "' AND ") "")
					(if currstatus (conc "status='" currstatus "' AND ") "")
					" testname=? AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
		;;(print "QRY: " qry)
		;;(debug:print 0 "QRY: " qry)
		(sqlite3:execute db qry newstate newstatus testname testname)))
	    testnames))
	      ;; "('" (string-intersperse tests "','") "')")

(define (db:delete-tests-in-state db run-id state)
  (sqlite3:execute db "DELETE FROM tests WHERE state=? AND run_id=?;" state run-id))

(define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
  (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 test-id)))

(define (db:get-count-tests-running db)

;;  	     ;;   		      tests))
;;  	     (completed-tests (let ((non-completed (make-hash-table)))
;;  				(for-each (lambda (x)
;;  					    ;; could add check for PASS here
;;  					    (if (not (and (equal? (db:test-get-state x) "COMPLETED")
;;  							  (equal? (db:test-get-status x) "PASS")))
;;  						(hash-table-set! non-completed (db:test-get-testname x) x)))
;;  					    ;; (print "Completed: " (db:test-get-testname x))))
;;  					    ;; (debug:print 0 "Completed: " (db:test-get-testname x))))
;;  					  tests)
;;  				(filter (lambda (x)
;;  					  (not (hash-table-ref/default non-completed (db:test-get-testname x) #f)))
;;  					tests)))
;;  	     (pre-dep-names   (map db:test-get-testname completed-tests))
;;  	     (result          (lset-difference string=? waiton pre-dep-names)))
;;  	(print "pre-dep-names: " pre-dep-names " waiton: " waiton " result: " result)