Overview
Comment: | minor improvements to server mode |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
29dd5464142c05cbb2c19a4c341b6427 |
User & Date: | mrwellan on 2012-02-29 17:56:50 |
Other Links: | manifest | tags |
Context
2012-03-13
| ||
06:59 | Merged servermode to trunk check-in: 3e2cee87de user: matt tags: trunk | |
2012-03-01
| ||
22:49 | Run server mode as part of -run* check-in: b06b51df8d user: matt tags: servermode | |
2012-02-29
| ||
17:56 | minor improvements to server mode check-in: 29dd546414 user: mrwellan tags: trunk | |
2012-02-27
| ||
09:52 | Partial fix for -rerun check-in: 0e00d7e0c2 user: matt tags: trunk | |
Changes
Modified dashboard.scm from [3650032959] to [56cfd810b6].
︙ | ︙ | |||
74 75 76 77 78 79 80 81 82 83 84 85 | (if (not (setup-for-run)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) (define *db* (open-db)) ;; (server:client-setup *db*) (define toplevel #f) (define dlg #f) (define max-test-num 0) | > > > | | | | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | (if (not (setup-for-run)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) (define *db* (open-db)) ;; HACK ALERT: this is a hack, please fix. (define *read-only* (file-read-access? (conc *toppath* "/megatest.db"))) ;; (server:client-setup *db*) (define toplevel #f) (define dlg #f) (define max-test-num 0) (define *keys* (rdb:get-keys *db*)) ;; (define *keys* (db:get-keys *db*)) (define *dbkeys* (map (lambda (x)(vector-ref x 0)) (append *keys* (list (vector "runname" "blah"))))) (define *header* #f) (define *allruns* '()) (define *buttondat* (make-hash-table)) ;; <run-id color text test run-key> (define *alltestnamelst* '()) (define *searchpatts* (make-hash-table)) (define *num-runs* 8) (define *tot-run-count* (rdb:get-num-runs *db* "%")) ;; (define *tot-run-count* (db:get-num-runs *db* "%")) (define *last-update* (current-seconds)) (define *num-tests* 15) (define *start-run-offset* 0) (define *start-test-offset* 0) (define *examine-test-dat* (make-hash-table)) (define *exit-started* #f) (define *status-ignore-hash* (make-hash-table)) |
︙ | ︙ |
Modified db.scm from [f1afc66bda] to [72acdb1ad4].
︙ | ︙ | |||
1219 1220 1221 1222 1223 1224 1225 | test-id)) (db:get-test-data-by-id db test-id))) (define (rdb:get-keys db) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) | > | > > | 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 | test-id)) (db:get-test-data-by-id db test-id))) (define (rdb:get-keys db) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) (if *db-keys* *db-keys* (let ((keys ((rpc:procedure 'rdb:get-keys host port)))) (set! *db-keys* keys) keys))) (db:get-keys db))) (define (rdb:get-num-runs db runpatt) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) ((rpc:procedure 'rdb:get-num-runs host port) runpatt)) |
︙ | ︙ |
Modified launch.scm from [fc84969590] to [e033088d6b].
︙ | ︙ | |||
220 221 222 223 224 225 226 227 228 229 230 231 232 233 | (else 'fail)))) (debug:print 4 "Exit value received: " (vector-ref exit-info 2) " logpro-used: " logpro-used " this-step-status: " this-step-status " overall-status: " overall-status " next-status: " next-status " rollup-status: " rollup-status) (case next-status ((warn) (set! rollup-status 2) (test-set-status! db run-id test-name "RUNNING" "WARN" itemdat (if (eq? this-step-status 'warn) "Logpro warning found" #f) #f)) ((pass) (test-set-status! db run-id test-name "RUNNING" "PASS" itemdat #f #f)) (else ;; 'fail (set! rollup-status 1) ;; force fail | > | 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 | (else 'fail)))) (debug:print 4 "Exit value received: " (vector-ref exit-info 2) " logpro-used: " logpro-used " this-step-status: " this-step-status " overall-status: " overall-status " next-status: " next-status " rollup-status: " rollup-status) (case next-status ((warn) (set! rollup-status 2) ;; NB// test-set-status! does rdb calls under the hood (test-set-status! db run-id test-name "RUNNING" "WARN" itemdat (if (eq? this-step-status 'warn) "Logpro warning found" #f) #f)) ((pass) (test-set-status! db run-id test-name "RUNNING" "PASS" itemdat #f #f)) (else ;; 'fail (set! rollup-status 1) ;; force fail |
︙ | ︙ | |||
282 283 284 285 286 287 288 | (test-set-status! db run-id test-name "KILLED" "FAIL" itemdat (args:get-arg "-m") #f) (sqlite3:finalize! db) (exit 1)))) (set! kill-tries (+ 1 kill-tries)) (mutex-unlock! m))) (sqlite3:finalize! db) | | | 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 | (test-set-status! db run-id test-name "KILLED" "FAIL" itemdat (args:get-arg "-m") #f) (sqlite3:finalize! db) (exit 1)))) (set! kill-tries (+ 1 kill-tries)) (mutex-unlock! m))) (sqlite3:finalize! db) (thread-sleep! (+ 10 (random 10))) ;; add some jitter to the call home time to spread out the db accesses (loop (calc-minutes))))))) (th1 (make-thread monitorjob)) (th2 (make-thread runit))) (set! job-thread th2) (thread-start! th1) (thread-start! th2) (thread-join! th2) |
︙ | ︙ |
Modified runs.scm from [8dbca061f3] to [25e1315b1d].
︙ | ︙ | |||
395 396 397 398 399 400 401 | ;; Here is where the test_meta table is best updated (runs:update-test_meta db test-name test-conf) ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer")) (let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/")) (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique | | | | 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 | ;; Here is where the test_meta table is best updated (runs:update-test_meta db test-name test-conf) ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer")) (let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/")) (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique (testdat (db:get-test-info db run-id test-name item-path))) (if (not testdat) (begin ;; ensure that the path exists before registering the test ;; NOPE: Cannot! Don't know yet which disk area will be assigned.... ;; (system (conc "mkdir -p " new-test-path)) (rtests:register-test db run-id test-name item-path) (set! testdat (db:get-test-info db run-id test-name item-path)))) (change-directory test-path) (case (if force ;; (args:get-arg "-force") 'NOT_STARTED (if testdat (string->symbol (test:get-state testdat)) 'failed-to-insert)) ((failed-to-insert) |
︙ | ︙ |
Modified tests.scm from [70b97ad27c] to [536da07661].
︙ | ︙ | |||
19 20 21 22 23 24 25 | (list item-path) (list item-path "")))) (for-each (lambda (pth) (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');" run-id test-name | | < < | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | (list item-path) (list item-path "")))) (for-each (lambda (pth) (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');" run-id test-name pth)) item-paths ))) ;; get the previous record for when this test was run where all keys match but runname ;; returns #f if no such test found, returns a single test record if found (define (test:get-previous-test-run-record db run-id test-name item-path) (let* ((keys (db:get-keys db)) (selstr (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ",")) |
︙ | ︙ |