Megatest

Check-in [3168e11fa8]
Login
Overview
Comment:Added override ability in remove-runs to optionally not remove the record
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55
Files: files | file ages | folders
SHA1: 3168e11fa83154732602bb933c3e953cfcdbac84
User & Date: matt on 2014-05-29 08:39:19
Other Links: branch diff | manifest | tags
Context
2014-05-30
09:00
Moved call to run-wait to a point after all other likely calls so that run wait can be used with other switches. Added blocking of remove whne a test has sub tests. check-in: 95dcd86380 user: mrwellan tags: v1.55
2014-05-29
08:39
Added override ability in remove-runs to optionally not remove the record check-in: 3168e11fa8 user: matt tags: v1.55
2014-05-22
12:08
Improved dashboard for working in readonly areas check-in: 402ee8e934 user: mrwellan tags: v1.55, v1.5519
Changes

Modified runs.scm from [596fc89645] to [9e72541023].

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))
  (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  ",") '()))







|







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)(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
						   (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 

				      (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))))







>
|







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)))
				      (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))))