Megatest

Diff
Login

Differences From Artifact [e2a9d896d7]:

To Artifact [002df5e7fd]:


497
498
499
500
501
502
503



504
505
506
507
508
509
510
	       (take dparts (- (length dparts) count))
	       "/"))))
;; Remove runs
;; fields are passing in through 
;; action:
;;    'remove-runs
;;    'set-state-status



(define (runs:operate-on db action runnamepatt testpatt itempatt #!key (state #f)(status #f)(new-state-status #f))
  (let* ((keys         (rdb:get-keys db))
	 (rundat       (runs:get-runs-by-patt db keys runnamepatt))
	 (header       (vector-ref rundat 0))
	 (runs         (vector-ref rundat 1))
	 (states       (if state  (string-split state  ",") '()))
	 (statuses     (if status (string-split status ",") '()))







>
>
>







497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
	       (take dparts (- (length dparts) count))
	       "/"))))
;; Remove runs
;; fields are passing in through 
;; action:
;;    'remove-runs
;;    'set-state-status
;;
;; NB// should pass in keys?
;;
(define (runs:operate-on db action runnamepatt testpatt itempatt #!key (state #f)(status #f)(new-state-status #f))
  (let* ((keys         (rdb:get-keys db))
	 (rundat       (runs:get-runs-by-patt db keys runnamepatt))
	 (header       (vector-ref rundat 0))
	 (runs         (vector-ref rundat 1))
	 (states       (if state  (string-split state  ",") '()))
	 (statuses     (if status (string-split status ",") '()))
642
643
644
645
646
647
648


















649
650
651
652
653
654
655
	    (let* ((keynames   (map key:get-fieldname keys))
		   (keyvallst  (keys->vallist keys #t)))
	      (proc db target runname keys keynames keyvallst)))
	(if th1 (thread-join! th1))
	(sqlite3:finalize! db)
	(set! *didsomething* #t))))))



















;;======================================================================
;; Rollup runs
;;======================================================================

;; Update the test_meta table for this test
(define (runs:update-test_meta db test-name test-conf)
  (let ((currrecord (db:testmeta-get-record db test-name)))







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
	    (let* ((keynames   (map key:get-fieldname keys))
		   (keyvallst  (keys->vallist keys #t)))
	      (proc db target runname keys keynames keyvallst)))
	(if th1 (thread-join! th1))
	(sqlite3:finalize! db)
	(set! *didsomething* #t))))))

;;======================================================================
;; Lock/unlock runs
;;======================================================================

(define (runs:handle-locking db target keys runname lock unlock user)
  (let* ((rundat   (runs:get-runs-by-patt db keys runname))
	 (header   (vector-ref rundat 0))
	 (runs     (vector-ref rundat 1)))
    (for-each (lambda (run)
		(let ((run-id (db:get-value-by-header run header "id")))
		  (if (or lock
			  (and unlock
			       (begin
				 (print "Do you really wish to unlock run " run-id "?\n   y/n: ")
				 (equal? "y" (read-line)))))
		      (db:lock/unlock-run db run-id lock unlock user)
		      (debug:print 0 "INFO: Skipping lock/unlock on " run-id))))
	      runs)))
;;======================================================================
;; Rollup runs
;;======================================================================

;; Update the test_meta table for this test
(define (runs:update-test_meta db test-name test-conf)
  (let ((currrecord (db:testmeta-get-record db test-name)))