Overview
Comment: | Fixed command line -runall borked by the monitor stuff |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
fa52f9444ddea8af11483acbd886430b |
User & Date: | mrwellan on 2011-10-25 20:12:02 |
Other Links: | manifest | tags |
Context
2011-10-26
| ||
14:03 | Merged guitweaks (includes stuff from private branches check-in: bb8b14dea5 user: mrwellan tags: trunk | |
09:15 | Sprucing up the gui a bit. check-in: 9b2128dd16 user: mrwellan tags: guitweaks | |
2011-10-25
| ||
20:12 | Fixed command line -runall borked by the monitor stuff check-in: fa52f9444d user: mrwellan tags: trunk | |
2011-10-24
| ||
23:14 | Removed transaction from snag task - works much better but needs to be proven no collisions check-in: f03dbc0c69 user: matt tags: trunk | |
Changes
Modified dashboard-guimonitor.scm from [2a8d79b5c8] to [2fac0110eb].
︙ | |||
67 68 69 70 71 72 73 | 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 | - + + + + + + + + | #:expand "HORIZONTAL" #:action (lambda (obj) (tasks:add-from-params tdb "run" keys key-params var-params) (print "Launch Run"))) (iup:button "Remove" #:expand "HORIZONTAL" #:action (lambda (obj) |
︙ | |||
124 125 126 127 128 129 130 | 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | - - - - + + + + + | (set! topdialog (iup:dialog #:close_cb (lambda (a)(exit)) #:title "Run Controls" (iup:vbox (iup:hbox keyentries othervars) controls (let ((tabtop (iup:tabs |
︙ |
Modified keys.scm from [99bd692b48] to [e7ee3ab27e].
︙ | |||
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | + + - + + + + + | (numtarg (length targlist)) (targtweaked (if (> numkeys numtarg) (append targlist (make-list (- numkeys numtarg) "")) targlist))) (map (lambda (key targ) (list (vector-ref key 0) targ)) keys targtweaked))) ;;====================================================================== ;; key <=> args routines ;;====================================================================== ;; Using the keys pulled from the database (initially set from the megatest.config file) ;; look for the equivalent value on the command line and add it to a list, or #f if not found. ;; default => (val1 val2 val3 ...) ;; withkey => (:key1 val1 :key2 val2 :key3 val3 ...) (define (keys->vallist keys . withkey) ;; ORDERING IS VERY IMPORTANT, KEEP PROPER ORDER HERE! (let* ((keynames (map key:get-fieldname keys)) (argkeys (map (lambda (k)(conc ":" k)) keynames)) (withkey (not (null? withkey))) (newremargs (args:get-args |
︙ |
Modified launch.scm from [3863edda57] to [c53eb8cfe9].
︙ | |||
367 368 369 370 371 372 373 | 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 | - + | (hosts (config-lookup *configdat* "jobtools" "workhosts")) (remote-megatest (config-lookup *configdat* "setup" "executable")) ;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to ;; allow running from dashboard (local-megatest (let* ((lm (car (argv))) (dir (pathname-directory lm)) (exe (pathname-strip-directory lm))) |
︙ |
Modified megatest.scm from [510b81566b] to [751b469169].
︙ | |||
334 335 336 337 338 339 340 | 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 | - + + + + + | ;; Rollup into a run ;;====================================================================== (if (args:get-arg "-rollup") (general-run-call "-rollup" "rollup tests" (lambda (db keys keynames keyvallst) |
︙ |
Modified runs.scm from [cff48b30cc] to [a0af6ccbb4].
︙ | |||
777 778 779 780 781 782 783 784 785 786 787 788 789 790 | 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 | + | ;; New methodology. These routines will replace the above in time. For ;; now the code is duplicated. This stuff is initially used in the monitor ;; based code. ;;====================================================================== ;; register a test run with the db (define (runs:register-run db keys keyvallst runname state status user) (debug:print 3 "runs:register-run, keys: " keys " keyvallst: " keyvallst " runname: " runname " state: " state " status: " status " user: " user) (let* ((keystr (keys->keystr keys)) (comma (if (> (length keys) 0) "," "")) (andstr (if (> (length keys) 0) " AND " "")) (valslots (keys->valslots keys)) ;; ?,?,? ... (keyvals (map cadr keyvallst)) (allvals (append (list runname state status user) keyvals)) (qryvals (append (list runname) keyvals)) |
︙ | |||
1215 1216 1217 1218 1219 1220 1221 | 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 | - + - - + + + + | (let* ((test-path (conc *toppath* "/tests/" test-name)) (test-configf (conc test-path "/testconfig")) (testexists (and (file-exists? test-configf)(file-read-access? test-configf))) ;; read configs with tricks turned off (i.e. no system) (test-conf (if testexists (read-config test-configf #f #f)(make-hash-table)))) (runs:update-test_meta db test-name test-conf))) test-names))) |
︙ |
Modified tasks.scm from [0c91ba49cf] to [0bafc39e74].
︙ | |||
193 194 195 196 197 198 199 | 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 | - + | (tasks:monitors-update tdb) (loop (+ count 1)(+ (current-seconds) 240))) (loop (+ count 1) next-touch))))))) (define (tasks:process-queue db tdb) (let* ((task (tasks:snag-a-task tdb)) (action (if task (tasks:task-get-action task) #f))) |
︙ | |||
271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 | 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 | + + + + + + + + + + + + + + + + + + + + + | (get-host-name))) (define (tasks:set-state tdb task-id state) (sqlite3:execute tdb "UPDATE tasks_queue SET state=? WHERE id=?;" state task-id)) ;;====================================================================== ;; The routines to process tasks ;;====================================================================== ;; NOTE: It might be good to add one more layer of checking to ensure ;; that no task gets run in parallel. (define (tasks:start-run db tdb task) (let ((flags (make-hash-table))) (hash-table-set! flags "-rerun" "NOT_STARTED") (print "Starting run " task) ;; sillyness, just call the damn routine with the task vector and be done with it. FIXME SOMEDAY (runs:run-tests db (tasks:task-get-target task) (tasks:task-get-name task) (tasks:task-get-test task) (tasks:task-get-item task) (tasks:task-get-owner task) flags) (tasks:set-state tdb (tasks:task-get-id task) "waiting"))) (define (tasks:rollup-runs db tdb task) (let* ((flags (make-hash-table)) (keys (db:get-keys db)) (keyvallst (keys:target->keyval keys (tasks:task-get-target task)))) ;; (hash-table-set! flags "-rerun" "NOT_STARTED") (print "Starting rollup " task) ;; sillyness, just call the damn routine with the task vector and be done with it. FIXME SOMEDAY (runs:rollup-run db keys keyvallst (tasks:task-get-name task) (tasks:task-get-owner task)) (tasks:set-state tdb (tasks:task-get-id task) "waiting"))) |