1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
|
(run-dir ;;(filedb:get-path *fdb*
;; (rmt:sdb-qry 'getid
(db:test-get-rundir new-test-dat)) ;; ) ;; run dir is from the link tree
(test-state (db:test-get-state new-test-dat))
(test-fulln (db:test-get-fullname new-test-dat))
(uname (db:test-get-uname new-test-dat))
(toplevel-with-children (and (db:test-get-is-toplevel test)
(> (cdb:remote-run db:test-toplevel-num-items db run-id test-name) 0))))
(case action
((remove-runs)
;; if the test is a toplevel-with-children issue an error and do not remove
(if toplevel-with-children
(begin
(debug:print 0 "WARNING: skipping removal of " test-fulln " with run-id " run-id " as it has sub tests")
(hash-table-set! toplevel-retries test-fulln (+ (hash-table-ref/default toplevel-retries test-fulln 0) 1))
|
|
|
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
|
(run-dir ;;(filedb:get-path *fdb*
;; (rmt:sdb-qry 'getid
(db:test-get-rundir new-test-dat)) ;; ) ;; run dir is from the link tree
(test-state (db:test-get-state new-test-dat))
(test-fulln (db:test-get-fullname new-test-dat))
(uname (db:test-get-uname new-test-dat))
(toplevel-with-children (and (db:test-get-is-toplevel test)
(> (rmt:test-toplevel-num-items run-id test-name) 0))))
(case action
((remove-runs)
;; if the test is a toplevel-with-children issue an error and do not remove
(if toplevel-with-children
(begin
(debug:print 0 "WARNING: skipping removal of " test-fulln " with run-id " run-id " as it has sub tests")
(hash-table-set! toplevel-retries test-fulln (+ (hash-table-ref/default toplevel-retries test-fulln 0) 1))
|
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
|
(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)))))
;;======================================================================
;; Routines for manipulating runs
;;======================================================================
;; Since many calls to a run require pretty much the same setup
;; this wrapper is used to reduce the replication of code
|
|
|
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
|
(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)
(rmt:delete-test-records (db:test-get-run_id test) (db:test-get-id test)))))
;;======================================================================
;; Routines for manipulating runs
;;======================================================================
;; Since many calls to a run require pretty much the same setup
;; this wrapper is used to reduce the replication of code
|