Overview
Comment: | Fixed annoying 'remove steps on re-run' bug |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
51810ab5ab7786772a0bfe6c0abd2c84 |
User & Date: | mrwellan on 2011-06-16 10:15:15 |
Other Links: | manifest | tags |
Context
2011-06-16
| ||
14:01 | Added switch to set number of rows in a dashboard screen check-in: 4d44659fb3 user: mrwellan tags: trunk | |
10:15 | Fixed annoying 'remove steps on re-run' bug check-in: 51810ab5ab user: mrwellan tags: trunk | |
00:17 | Fixed job killing on remote hosts check-in: 5cefaba81b user: mrwellan tags: trunk, v1.12 | |
Changes
Modified db.scm from [6176618730] to [b22d01852d].
︙ | ︙ | |||
203 204 205 206 207 208 209 | (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res))) db "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? ORDER BY id DESC;" run-id testpatt (if itempatt itempatt "%")) res)) ;; this one is a bit broken BUG FIXME | | | | | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res))) db "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? ORDER BY id DESC;" run-id testpatt (if itempatt itempatt "%")) res)) ;; this one is a bit broken BUG FIXME (define (db:delete-test-step-records db run-id test-name itemdat) (sqlite3:execute db "DELETE FROM test_steps WHERE test_id in (SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?);" run-id test-name (item-list->path itemdat))) ;; (define (db:delete-test-records db test-id) (sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id) (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id)) (define (db:get-count-tests-running db) (let ((res 0)) |
︙ | ︙ | |||
233 234 235 236 237 238 239 | (set! res count)) db "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING') AND run_id=?;" run-id) res)) ;; NB// Sync this with runs:get-test-info (define (db:get-test-info db run-id testname item-path) | | | 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 | (set! res count)) db "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING') AND run_id=?;" run-id) res)) ;; NB// Sync this with runs:get-test-info (define (db:get-test-info db run-id testname item-path) (let ((res #f)) (sqlite3:for-each-row (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment))) db "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path=?;" run-id testname item-path) res)) |
︙ | ︙ |
Modified launch.scm from [9d7ec25b1f] to [f017f54e72].
︙ | ︙ | |||
147 148 149 150 151 152 153 154 155 156 157 158 159 160 | (list 'runscript runscript) (list 'run-id run-id ) (list 'itemdat itemdat ) (list 'megatest remote-megatest) (list 'env-ovrd (hash-table-ref/default *configdat* "env-override" '())) (list 'runname (args:get-arg ":runname")) (list 'mt-bindir-path mt-bindir-path))))))) ;; (string-intersperse keyvallst " ")))) (change-directory work-area) ;; so that log files from the launch process don't clutter the test dir (cond ((and launcher hosts) ;; must be using ssh hostname (set! fullcmd (append launcher (car hosts)(list remote-megatest "-execute" cmdparms)))) (launcher (set! fullcmd (append launcher (list remote-megatest "-execute" cmdparms)))) (else | > > | 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | (list 'runscript runscript) (list 'run-id run-id ) (list 'itemdat itemdat ) (list 'megatest remote-megatest) (list 'env-ovrd (hash-table-ref/default *configdat* "env-override" '())) (list 'runname (args:get-arg ":runname")) (list 'mt-bindir-path mt-bindir-path))))))) ;; (string-intersperse keyvallst " ")))) ;; clean out step records from previous run if they exist (db:delete-test-step-records db run-id test-name itemdat) (change-directory work-area) ;; so that log files from the launch process don't clutter the test dir (cond ((and launcher hosts) ;; must be using ssh hostname (set! fullcmd (append launcher (car hosts)(list remote-megatest "-execute" cmdparms)))) (launcher (set! fullcmd (append launcher (list remote-megatest "-execute" cmdparms)))) (else |
︙ | ︙ |
Modified runs.scm from [980eb376cd] to [60a12faf67].
︙ | ︙ | |||
317 318 319 320 321 322 323 | (if (not (or (not max-concurrent-jobs) (and max-concurrent-jobs (string->number max-concurrent-jobs) (not (>= num-running (string->number max-concurrent-jobs)))))) (print "WARNING: Max running jobs exceeded, current number running: " num-running ", max_concurrent_jobs: " max-concurrent-jobs) (begin | | > > | > | 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 | (if (not (or (not max-concurrent-jobs) (and max-concurrent-jobs (string->number max-concurrent-jobs) (not (>= num-running (string->number max-concurrent-jobs)))))) (print "WARNING: Max running jobs exceeded, current number running: " num-running ", max_concurrent_jobs: " max-concurrent-jobs) (begin (let loop2 ((ts (db:get-test-info db run-id test-name item-path)) ;; #f) (ct 0)) (if (and (not ts) (< ct 10)) (begin (register-test db run-id test-name item-path) (db:test-set-comment db run-id test-name item-path "") ;; (test-set-status! db run-id test-name "NOT_STARTED" "n/a" itemdat "") ;; (db:set-comment-for-test db run-id test-name item-path "") ;; Move the next line into the test exectute code ;; (db:delete-test-step-records db run-id test-name) ;; clean out if this is a re-run (loop2 (db:get-test-info db run-id test-name item-path) (+ ct 1))) (if ts (set! test-status ts) (begin (print "WARNING: Couldn't register test " test-name " with item path " item-path ", skipping") (if (not (null? tal)) |
︙ | ︙ |