Overview
| Comment: | Converted some open-run-close calls to cdb:remote-run |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.54 |
| Files: | files | file ages | folders |
| SHA1: |
13cd0c805dbe975209455ad0c8d5949e |
| User & Date: | matt on 2013-04-27 16:52:14 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-04-27
| ||
| 16:59 | Incrementing towards the threaded test registration code. tests-register-tests converted to cdb:tests-register-test check-in: db3b39bb04 user: matt tags: v1.54 | |
| 16:52 | Converted some open-run-close calls to cdb:remote-run check-in: 13cd0c805d user: matt tags: v1.54 | |
| 14:54 | Fixed some remote run issues in tests:update-central-meta. Corrected issue with redirecting output to mt_launch.log check-in: c32ae5e108 user: matt tags: v1.54 | |
Changes
Modified http-transport.scm from [fbf8e06be1] to [ebc2f5cd40].
| ︙ | ︙ | |||
186 187 188 189 190 191 192 |
(define (http-transport:client-connect iface port)
(let* ((login-res #f)
(serverdat (list iface port)))
(set! login-res (client:login serverdat))
(if (and (not (null? login-res))
(car login-res))
(begin
| | | 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 |
(define (http-transport:client-connect iface port)
(let* ((login-res #f)
(serverdat (list iface port)))
(set! login-res (client:login serverdat))
(if (and (not (null? login-res))
(car login-res))
(begin
(debug:print-info 2 "Logged in and connected to " iface ":" port)
(set! *runremote* serverdat)
serverdat)
(begin
(debug:print-info 0 "Failed to login or connect to " iface ":" port)
(set! *runremote* #f)
(set! *transport-type* 'fs)
#f))))
|
| ︙ | ︙ |
Modified runs.scm from [8784d8fdbf] to [dc8fb13ea9].
| ︙ | ︙ | |||
373 374 375 376 377 378 379 | (if (member test-name waitons) (begin (debug:print 0 "ERROR: test " test-name " has listed itself as a waiton, please correct this!") (set! waiton (filter (lambda (x)(not (equal? x hed))) waitons)))) (cond ;; OUTER COND ((not items) ;; when false the test is ok to be handed off to launch (but not before) | | | | 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 | (if (member test-name waitons) (begin (debug:print 0 "ERROR: test " test-name " has listed itself as a waiton, please correct this!") (set! waiton (filter (lambda (x)(not (equal? x hed))) waitons)))) (cond ;; OUTER COND ((not items) ;; when false the test is ok to be handed off to launch (but not before) (let* ((run-limits-info (runs:can-run-more-tests test-record)) ;; look at the test jobgroup and tot jobs running (have-resources (car run-limits-info)) (num-running (list-ref run-limits-info 1)) (num-running-in-jobgroup (list-ref run-limits-info 2)) (max-concurrent-jobs (list-ref run-limits-info 3)) (job-group-limit (list-ref run-limits-info 4)) (prereqs-not-met (cdb:remote-run db:get-prereqs-not-met #f run-id waitons item-path mode: testmode)) (fails (runs:calc-fails prereqs-not-met)) (non-completed (runs:calc-not-completed prereqs-not-met))) (debug:print-info 8 "have-resources: " have-resources " prereqs-not-met: " (string-intersperse (map (lambda (t) (if (vector? t) (conc (db:test-get-state t) "/" (db:test-get-status t)) |
| ︙ | ︙ | |||
407 408 409 410 411 412 413 | ;; (thread-sleep! *global-delta*) (if (not (null? tal)) (loop (car tal)(cdr tal) reruns))) ( ;; (and (not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f)) ;; (and max-concurrent-jobs (> (- max-concurrent-jobs num-running) 5))) (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" ) | | | 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 | ;; (thread-sleep! *global-delta*) (if (not (null? tal)) (loop (car tal)(cdr tal) reruns))) ( ;; (and (not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f)) ;; (and max-concurrent-jobs (> (- max-concurrent-jobs num-running) 5))) (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" ) (db:tests-register-test run-id test-name item-path) (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) #t) ;; (thread-sleep! *global-delta*) (runs:shrink-can-run-more-tests-delay) (loop (car newtal)(cdr newtal) reruns)) ((not have-resources) ;; simply try again after waiting a second (debug:print-info 1 "no resources to run new tests, waiting ...") ;; (thread-sleep! (+ 2 *global-delta*)) |
| ︙ | ︙ | |||
926 927 928 929 930 931 932 | runs))) ;;====================================================================== ;; Rollup runs ;;====================================================================== ;; Update the test_meta table for this test (define (runs:update-test_meta db test-name test-conf) | | | | | 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 |
runs)))
;;======================================================================
;; Rollup runs
;;======================================================================
;; Update the test_meta table for this test
(define (runs:update-test_meta db test-name test-conf)
(let ((currrecord (cdb:remote-run db:testmeta-get-record db test-name)))
(if (not currrecord)
(begin
(set! currrecord (make-vector 10 #f))
(cdb:remote-run db:testmeta-add-record db test-name)))
(for-each
(lambda (key)
(let* ((idx (cadr key))
(fld (car key))
(val (config-lookup test-conf "test_meta" fld)))
;; (debug:print 5 "idx: " idx " fld: " fld " val: " val)
(if (and val (not (equal? (vector-ref currrecord idx) val)))
(begin
(print "Updating " test-name " " fld " to " val)
(cdb:remote-run db:testmeta-update-field db test-name fld val)))))
'(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9)))))
;; Update test_meta for all tests
(define (runs:update-all-test_meta db)
(let ((test-names (get-all-legal-tests)))
(for-each
(lambda (test-name)
|
| ︙ | ︙ |