Check-in [346d7c3282]
Not logged in
Overview
SHA1 Hash:346d7c3282fa03c606091b62c2e1208c0e36fbb7
Date: 2011-11-26 10:13:58
User: matt
Comment:Tidied up start test messages a little
Timelines: family | ancestors | reorg-runs-code
Diffs: root of this branch
Downloads: Tarball | ZIP archive
Other Links: files | file ages | manifest
Tags And Properties
Changes

Modified items.scm from [c4333570bf5a4c5c] to [d370c880ec95b9d4].

127 item #f) 127 item #f) 128 item))) 128 item))) 129 129 130 (define (items:get-items-from-config tconfig) 130 (define (items:get-items-from-config tconfig) 131 (let* (;; db is always at *toppath*/db/megatest.db 131 (let* (;; db is always at *toppath*/db/megatest.db 132 (items (hash-table-ref/default tconfig "items" '())) 132 (items (hash-table-ref/default tconfig "items" '())) 133 (itemstable (hash-table-ref/default tconfig "itemstable" '()))) 133 (itemstable (hash-table-ref/default tconfig "itemstable" '()))) > 134 (debug:print 5 "items: " items " itemstable: " itemstable) > 135 (set! items (map (lambda (item) 134 (if (procedure? items) | 136 (if (procedure? (cadr item)) > 137 (list (car item)((cadr item))) > 138 item)) 135 (set! items (items))) | 139 items)) > 140 (set! itemstable (map (lambda (item) 136 (if (procedure? itemstable) | 141 (if (procedure? (cadr item)) > 142 (list (car item)((cadr item))) > 143 item)) 137 (set! itemstable (itemstable))) | 144 itemstable)) 138 (if (or (not (null? items))(not (null? itemstable))) 145 (if (or (not (null? items))(not (null? itemstable))) 139 (append (item-assoc->item-list items) 146 (append (item-assoc->item-list items) 140 (item-table->item-list itemstable)) 147 (item-table->item-list itemstable)) 141 '(())))) 148 '(())))) 142 149 143 ;; (pp (item-assoc->item-list itemdat)) 150 ;; (pp (item-assoc->item-list itemdat)) 144 151 145 152 146 153

Modified runs.scm from [41259c2446f957fe] to [ec19d61978fa0140].

263 (let* ((test-record (hash-table-ref test-records hed)) 263 (let* ((test-record (hash-table-ref test-records hed)) 264 (tconfig (tests:testqueue-get-testconfig test-record)) 264 (tconfig (tests:testqueue-get-testconfig test-record)) 265 (waitons (tests:testqueue-get-waitons test-record)) 265 (waitons (tests:testqueue-get-waitons test-record)) 266 (priority (tests:testqueue-get-priority test-record)) 266 (priority (tests:testqueue-get-priority test-record)) 267 (itemdat (tests:testqueue-get-itemdat test-record)) 267 (itemdat (tests:testqueue-get-itemdat test-record)) 268 (items (tests:testqueue-get-items test-record)) 268 (items (tests:testqueue-get-items test-record)) 269 (item-path (item-list->path itemdat))) 269 (item-path (item-list->path itemdat))) 270 (debug:print 0 "WHERE TO DO: (items:get-items-from-config config)") < 271 (debug:print 6 270 (debug:print 6 272 "itemdat: " itemdat 271 "itemdat: " itemdat 273 "\n items: " items 272 "\n items: " items 274 "\n item-path: " item-path) 273 "\n item-path: " item-path) 275 (cond 274 (cond 276 ((not items) ;; when false the test is ok to be handed off to launch (b 275 ((not items) ;; when false the test is ok to be handed off to launch (b 277 (let ((have-resources (runs:can-run-more-tests db test-record)) ;; lo 276 (let ((have-resources (runs:can-run-more-tests db test-record)) ;; lo ................................................................................................................................................................................ 353 (let* ((test-name (tests:testqueue-get-testname test-record)) 352 (let* ((test-name (tests:testqueue-get-testname test-record)) 354 (test-waitons (tests:testqueue-get-waitons test-record)) 353 (test-waitons (tests:testqueue-get-waitons test-record)) 355 (test-conf (tests:testqueue-get-testconfig test-record)) 354 (test-conf (tests:testqueue-get-testconfig test-record)) 356 (itemdat (tests:testqueue-get-itemdat test-record)) 355 (itemdat (tests:testqueue-get-itemdat test-record)) 357 (test-path (conc *toppath* "/tests/" test-name)) ;; could use test:g 356 (test-path (conc *toppath* "/tests/" test-name)) ;; could use test:g 358 (force (hash-table-ref/default flags "-force" #f)) 357 (force (hash-table-ref/default flags "-force" #f)) 359 (rerun (hash-table-ref/default flags "-rerun" #f)) 358 (rerun (hash-table-ref/default flags "-rerun" #f)) 360 (keepgoing (hash-table-ref/default flags "-keepgoing" #f))) | 359 (keepgoing (hash-table-ref/default flags "-keepgoing" #f)) 361 (debug:print 1 "Launching test " test-name) | 360 (item-path "")) 362 (debug:print 5 361 (debug:print 5 363 "test-config: " (hash-table->alist test-conf) 362 "test-config: " (hash-table->alist test-conf) 364 "\n itemdat: " itemdat 363 "\n itemdat: " itemdat 365 ) 364 ) 366 ;; setting itemdat to a list if it is #f 365 ;; setting itemdat to a list if it is #f 367 (if (not itemdat)(set! itemdat '())) 366 (if (not itemdat)(set! itemdat '())) > 367 (set! item-path (item-list->path itemdat)) > 368 (debug:print 1 "Attempting to launch test " test-name "/" item-path) 368 (setenv "MT_TEST_NAME" test-name) ;; 369 (setenv "MT_TEST_NAME" test-name) ;; 369 (setenv "MT_RUNNAME" runname) 370 (setenv "MT_RUNNAME" runname) 370 (set-megatest-env-vars db run-id) ;; these may be needed by the launching pr 371 (set-megatest-env-vars db run-id) ;; these may be needed by the launching pr 371 (change-directory *toppath*) 372 (change-directory *toppath*) 372 373 373 ;; Here is where the test_meta table is best updated 374 ;; Here is where the test_meta table is best updated 374 (runs:update-test_meta db test-name test-conf) 375 (runs:update-test_meta db test-name test-conf) 375 376 376 ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season 377 ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season 377 (let* ((item-path (item-list->path itemdat)) ;; (string-intersperse (map < 378 (new-test-path (string-intersperse (cons test-path (map cadr itemdat) | 378 (let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat) 379 (new-test-name (if (equal? item-path "") test-name (conc test-name "/ 379 (new-test-name (if (equal? item-path "") test-name (conc test-name "/ 380 (testdat (db:get-test-info db run-id test-name item-path))) 380 (testdat (db:get-test-info db run-id test-name item-path))) 381 (if (not testdat) 381 (if (not testdat) 382 (begin 382 (begin 383 (register-test db run-id test-name item-path) 383 (register-test db run-id test-name item-path) 384 (set! testdat (db:get-test-info db run-id test-name item-path)))) 384 (set! testdat (db:get-test-info db run-id test-name item-path)))) 385 (change-directory test-path) 385 (change-directory test-path)