2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
|
;; Here is where the test_meta table is best updated
;; Yes, another use of a global for caching. Need a better way?
;;
;; There is now a single call to runs:update-all-test_meta and this
;; per-test call is not needed. Given the delicacy of the move to
;; v1.55 this code is being left in place for the time being.
;;
(if (not (hash-table-ref/default *test-meta-updated* test-name #f))
(begin
(hash-table-set! *test-meta-updated* test-name #t)
(runs:update-test_meta test-name test-conf)))
;; itemdat => ((ripeness "overripe") (temperature "cool") (season "summer"))
(let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
(test-id (rmt:get-test-id run-id test-name item-path))
|
|
|
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
|
;; Here is where the test_meta table is best updated
;; Yes, another use of a global for caching. Need a better way?
;;
;; There is now a single call to runs:update-all-test_meta and this
;; per-test call is not needed. Given the delicacy of the move to
;; v1.55 this code is being left in place for the time being.
;;
(if (not (hash-table-exists? *test-meta-updated* test-name))
(begin
(hash-table-set! *test-meta-updated* test-name #t)
(runs:update-test_meta test-name test-conf)))
;; itemdat => ((ripeness "overripe") (temperature "cool") (season "summer"))
(let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
(test-id (rmt:get-test-id run-id test-name item-path))
|
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
|
(begin
(case action
((kill-runs)
(tasks:kill-runner target run-name "%")
(debug:print 1 *default-log-port* "Killing tests for run: " runkey " " (db:get-value-by-header run header "runname"))
)
((remove-runs)
;; (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
;; seek and kill in flight -runtests with % as testpatt here
;; (if (equal? testpatt "%")
(tasks:kill-runner target run-name testpatt)
;; (debug:print 0 *default-log-port* "not attempting to kill any run launcher processes as testpatt is " testpatt))
(debug:print 1 *default-log-port* "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
((set-state-status)
|
>
>
|
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
|
(begin
(case action
((kill-runs)
(tasks:kill-runner target run-name "%")
(debug:print 1 *default-log-port* "Killing tests for run: " runkey " " (db:get-value-by-header run header "runname"))
)
((remove-runs)
;; use this location to cleanup old DELETED records? No. See below for same call
;; (rmt:delete-old-deleted-test-records run-id)
;; (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
;; seek and kill in flight -runtests with % as testpatt here
;; (if (equal? testpatt "%")
(tasks:kill-runner target run-name testpatt)
;; (debug:print 0 *default-log-port* "not attempting to kill any run launcher processes as testpatt is " testpatt))
(debug:print 1 *default-log-port* "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
((set-state-status)
|
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
|
(debug:print 2 *default-log-port* "run-paths-hash: " (hash-table-keys run-paths-hash))
(debug:print 1 *default-log-port* "Removing target " target "run: " run-name)
(if (not keep-records)
(begin
(debug:print 1 *default-log-port* "Removing DB records for the run.")
(rmt:delete-run run-id)
(rmt:delete-old-deleted-test-records))
)
(if (not (equal? linkspath "/does/not/exist/I"))
(begin
(debug:print 1 *default-log-port* "Recursively removing links dir " linkspath)
(runs:recursive-delete-with-error-msg linkspath)))
(for-each (lambda(runpath)
|
|
|
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
|
(debug:print 2 *default-log-port* "run-paths-hash: " (hash-table-keys run-paths-hash))
(debug:print 1 *default-log-port* "Removing target " target "run: " run-name)
(if (not keep-records)
(begin
(debug:print 1 *default-log-port* "Removing DB records for the run.")
(rmt:delete-run run-id)
(rmt:delete-old-deleted-test-records run-id))
)
(if (not (equal? linkspath "/does/not/exist/I"))
(begin
(debug:print 1 *default-log-port* "Recursively removing links dir " linkspath)
(runs:recursive-delete-with-error-msg linkspath)))
(for-each (lambda(runpath)
|