Megatest

Diff
Login

Differences From Artifact [596fc89645]:

To Artifact [9e72541023]:


1308
1309
1310
1311
1312
1313
1314
1315

1316
1317
1318
1319
1320
1321
1322
1308
1309
1310
1311
1312
1313
1314

1315
1316
1317
1318
1319
1320
1321
1322







-
+







;; fields are passing in through 
;; action:
;;    'remove-runs
;;    'set-state-status
;;
;; NB// should pass in keys?
;;
(define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f))
(define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)(remove-data-only #f))
  (common:clear-caches) ;; clear all caches
  (let* ((db           #f)
	 (keys         (cdb:remote-run db:get-keys db))
	 (rundat       (mt:get-runs-by-patt keys runnamepatt target))
	 (header       (vector-ref rundat 0))
	 (runs         (vector-ref rundat 1))
	 (states       (if state  (string-split state  ",") '()))
1437
1438
1439
1440
1441
1442
1443

1444

1445
1446
1447
1448
1449
1450
1451
1437
1438
1439
1440
1441
1442
1443
1444

1445
1446
1447
1448
1449
1450
1451
1452







+
-
+







						   (debug:print 0 "ERROR:  Failed to remove directory " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue")
						   (delete-directory run-dir)))
					      (if run-dir
						  (debug:print 0 "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink")
						  (debug:print 0 "NOTE: the run dir for this test is undefined. Test may have already been deleted."))
					      ))
				      ;; Only delete the records *after* removing the directory. If things fail we have a record 
				      (if (not remove-data-only)
				      (cdb:remote-run db:delete-test-records db #f (db:test-get-id test))
				          (cdb:remote-run db:delete-test-records db #f (db:test-get-id test)))
				      (if (not (null? tal))
					  (loop (car tal)(cdr tal))))))
			       ((set-state-status)
				(debug:print-info 2 "new state " (car state-status) ", new status " (cadr state-status))
				(mt:test-set-state-status-by-id (db:test-get-id test) (car state-status)(cadr state-status) #f)
				(if (not (null? tal))
				    (loop (car tal)(cdr tal))))