1
2
3
4
5
6
7
|
(define (run:test-internal run-id run-info keyvals runname test-record flags parent-test test-registry test-path)
;; all-tests-registry - used to determine test path
;; All these vars might be referenced by the testconfig file reader
;; flags are a hash of k/v pairs that could become commandline switches to a standalone version
(let* ((test-name (tests:testqueue-get-testname test-record))
(test-waitons (tests:testqueue-get-waitons test-record))
(test-conf (tests:testqueue-get-testconfig test-record))
|
>
>
|
1
2
3
4
5
6
7
8
9
|
(define (run:test-internal run-id run-info keyvals runname test-record flags parent-test test-registry test-path)
;; all-tests-registry - used to determine test path
;; All these vars might be referenced by the testconfig file reader
;; flags are a hash of k/v pairs that could become commandline switches to a standalone version
(let* ((test-name (tests:testqueue-get-testname test-record))
(test-waitons (tests:testqueue-get-waitons test-record))
(test-conf (tests:testqueue-get-testconfig test-record))
|
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
(debug:print 2 *default-log-port* "Attempting to launch test " full-test-name)
;; (setenv "MT_TEST_NAME" test-name) ;;
;; (setenv "MT_ITEMPATH" item-path)
;; (setenv "MT_RUNNAME" runname)
(runs:set-megatest-env-vars run-id inrunname: runname testname: test-name itempath: item-path) ;; these may be needed by the launching process
(change-directory *toppath*)
;; 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)) ;; ?? necessary?
(testdat (if test-id (rmt:get-test-info-by-id run-id test-id) #f)))
(if (not testdat)
(let loop ()
|
>
|
|
|
|
|
|
|
|
|
|
|
|
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
(debug:print 2 *default-log-port* "Attempting to launch test " full-test-name)
;; (setenv "MT_TEST_NAME" test-name) ;;
;; (setenv "MT_ITEMPATH" item-path)
;; (setenv "MT_RUNNAME" runname)
(runs:set-megatest-env-vars run-id inrunname: runname testname: test-name itempath: item-path) ;; these may be needed by the launching process
(change-directory *toppath*)
;; BB - dropping *test-meta-updated* processing; comment mentioned handling happened but left in just-in-case. Exercising option now.
;; ;; 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)) ;; ?? necessary?
(testdat (if test-id (rmt:get-test-info-by-id run-id test-id) #f)))
(if (not testdat)
(let loop ()
|