Check-in [5411a1be29]
Not logged in
Overview
SHA1 Hash:5411a1be298579a2392674c68171bafc3e323597
Date: 2011-05-11 13:32:16
User: mrwellan
Comment:Added blanking out the comment on reseting a test
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | manifest
Tags And Properties
Changes

Modified db.scm from [5decf9595d0597e9] to [3bc7d64bed1848d7].

228 (lambda (id run-id testname state status event-time host cpuload diskfree u 228 (lambda (id run-id testname state status event-time host cpuload diskfree u 229 (set! res (vector id run-id testname state status event-time host cpuload 229 (set! res (vector id run-id testname state status event-time host cpuload 230 db 230 db 231 "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,un 231 "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,un 232 run-id testname item-path) 232 run-id testname item-path) 233 res)) 233 res)) 234 234 > 235 ;; > 236 (define (db:test-set-comment db run-id testname item-path comment) > 237 (sqlite3:execute > 238 db > 239 "UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;" > 240 comment run-id testname item-path)) > 241 235 ;; Steps 242 ;; Steps 236 ;; Run steps 243 ;; Run steps 237 ;; make-vector-record "Run steps" db step id test_id stepname step_complete step 244 ;; make-vector-record "Run steps" db step id test_id stepname step_complete step 238 (define (make-db:step)(make-vector 6)) 245 (define (make-db:step)(make-vector 6)) 239 (define-inline (db:step-get-id vec) (vector-ref vec 0)) 246 (define-inline (db:step-get-id vec) (vector-ref vec 0)) 240 (define-inline (db:step-get-test_id vec) (vector-ref vec 1)) 247 (define-inline (db:step-get-test_id vec) (vector-ref vec 1)) 241 (define-inline (db:step-get-stepname vec) (vector-ref vec 2)) 248 (define-inline (db:step-get-stepname vec) (vector-ref vec 2))

Modified megatest.scm from [2b3fb13636279dab] to [1850c2555e594724].

105 (include "configf.scm") 105 (include "configf.scm") 106 (include "process.scm") 106 (include "process.scm") 107 (include "launch.scm") 107 (include "launch.scm") 108 (include "runs.scm") 108 (include "runs.scm") 109 ;; (include "gui.scm") 109 ;; (include "gui.scm") 110 110 111 (define *didsomething* #f) 111 (define *didsomething* #f) > 112 > 113 ;;====================================================================== > 114 ;; Remove old run(s) > 115 ;;====================================================================== > 116 > 117 (define (remove-runs) > 118 (cond > 119 ((not (args:get-arg ":runname")) > 120 (print "ERROR: Missing required parameter for -remove-runs, you must specify > 121 (exit 2)) > 122 ((not (args:get-arg "-testpatt")) > 123 (print "ERROR: Missing required parameter for -remove-runs, you must specify > 124 (exit 3)) > 125 ((not (args:get-arg "-itempatt")) > 126 (print "ERROR: Missing required parameter for -remove-runs, you must specify > 127 (exit 4)) > 128 ((let ((db #f)) > 129 (if (not (setup-for-run)) > 130 (begin > 131 (print "Failed to setup, exiting") > 132 (exit 1))) > 133 (set! db (open-db)) > 134 (if (not (car *configinfo*)) > 135 (begin > 136 (print "ERROR: Attempted to remove test(s) but run area config file > 137 (exit 1)) > 138 ;; put test parameters into convenient variables > 139 (runs:remove-runs db > 140 (args:get-arg ":runname") > 141 (args:get-arg "-testpatt") > 142 (args:get-arg "-itempatt"))) > 143 (sqlite3:finalize! db) > 144 (set! *didsomething* #t))))) > 145 > 146 (if (args:get-arg "-remove-runs") > 147 (remove-runs)) 112 148 113 ;;====================================================================== 149 ;;====================================================================== 114 ;; Query runs 150 ;; Query runs 115 ;;====================================================================== 151 ;;====================================================================== 116 152 117 (if (args:get-arg "-list-runs") 153 (if (args:get-arg "-list-runs") 118 (let* ((db (begin 154 (let* ((db (begin ................................................................................................................................................................................ 260 (sqlite3:finalize! db) 296 (sqlite3:finalize! db) 261 (run-waiting-tests #f) 297 (run-waiting-tests #f) 262 (set! *didsomething* #t)))) 298 (set! *didsomething* #t)))) 263 299 264 (if (args:get-arg "-runtests") 300 (if (args:get-arg "-runtests") 265 (runtests)) 301 (runtests)) 266 302 267 ;;====================================================================== < 268 ;; Remove old run(s) < 269 ;;====================================================================== < 270 < 271 (define (remove-runs) < 272 (cond < 273 ((not (args:get-arg ":runname")) < 274 (print "ERROR: Missing required parameter for -remove-runs, you must specify < 275 (exit 2)) < 276 ((not (args:get-arg "-testpatt")) < 277 (print "ERROR: Missing required parameter for -remove-runs, you must specify < 278 (exit 3)) < 279 ((not (args:get-arg "-itempatt")) < 280 (print "ERROR: Missing required parameter for -remove-runs, you must specify < 281 (exit 4)) < 282 ((let ((db #f)) < 283 (if (not (setup-for-run)) < 284 (begin < 285 (print "Failed to setup, exiting") < 286 (exit 1))) < 287 (set! db (open-db)) < 288 (if (not (car *configinfo*)) < 289 (begin < 290 (print "ERROR: Attempted to remove test(s) but run area config file < 291 (exit 1)) < 292 ;; put test parameters into convenient variables < 293 (runs:remove-runs db < 294 (args:get-arg ":runname") < 295 (args:get-arg "-testpatt") < 296 (args:get-arg "-itempatt"))) < 297 (sqlite3:finalize! db) < 298 (set! *didsomething* #t))))) < 299 < 300 (if (args:get-arg "-remove-runs") < 301 (remove-runs)) < 302 < 303 ;;====================================================================== 303 ;;====================================================================== 304 ;; execute the test 304 ;; execute the test 305 ;; - gets called on remote host 305 ;; - gets called on remote host 306 ;; - receives info from the -execute param 306 ;; - receives info from the -execute param 307 ;; - passes info to steps via MT_CMDINFO env var (future is to use a dot file 307 ;; - passes info to steps via MT_CMDINFO env var (future is to use a dot file 308 ;; - gathers host info and 308 ;; - gathers host info and 309 ;;====================================================================== 309 ;;======================================================================

Modified runs.scm from [32dfecc25c901bab] to [243bc1392b4d2faa].

46 ;; runs:get-runs-by-patt 46 ;; runs:get-runs-by-patt 47 ;; get runs by list of criteria 47 ;; get runs by list of criteria 48 ;; register a test run with the db 48 ;; register a test run with the db 49 ;; 49 ;; 50 ;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-row runinfo)) 50 ;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-row runinfo)) 51 ;; to extract info from the structure returned 51 ;; to extract info from the structure returned 52 ;; 52 ;; 53 (define (runs:get-runs-by-patt db keys runnamepatt) ;; test-name) | 53 (define (runs:get-runs-by-patt db keys runnamepatt . params) ;; test-name) 54 (let* ((keyvallst (keys->vallist keys)) 54 (let* ((keyvallst (keys->vallist keys)) 55 (tmp (runs:get-std-run-fields keys '("id" "runname" "state" "statu 55 (tmp (runs:get-std-run-fields keys '("id" "runname" "state" "statu 56 (keystr (car tmp)) 56 (keystr (car tmp)) 57 (header (cadr tmp)) 57 (header (cadr tmp)) 58 (res '()) 58 (res '()) 59 (key-patt "")) 59 (key-patt "")) 60 (for-each (lambda (keyval) 60 (for-each (lambda (keyval) ................................................................................................................................................................................ 273 (begin 273 (begin 274 (let loop2 ((ts #f) 274 (let loop2 ((ts #f) 275 (ct 0)) 275 (ct 0)) 276 (if (and (not ts) 276 (if (and (not ts) 277 (< ct 10)) 277 (< ct 10)) 278 (begin 278 (begin 279 (register-test db run-id test-name item-path) 279 (register-test db run-id test-name item-path) > 280 (db:test-set-comment db run-id test-name item-path " > 281 ;; (test-set-status! db run-id test-name "NOT_STARTE > 282 ;; (db:set-comment-for-test db run-id test-name item 280 (db:delete-test-step-records db run-id test-name) ;; 283 (db:delete-test-step-records db run-id test-name) ;; 281 (loop2 (db:get-test-info db run-id test-name item-pa 284 (loop2 (db:get-test-info db run-id test-name item-pa 282 (+ ct 1))) 285 (+ ct 1))) 283 (if ts 286 (if ts 284 (set! test-status ts) 287 (set! test-status ts) 285 (begin 288 (begin 286 (print "WARNING: Couldn't register test " test-n 289 (print "WARNING: Couldn't register test " test-n ................................................................................................................................................................................ 374 (print "Header: " header) 377 (print "Header: " header) 375 (for-each 378 (for-each 376 (lambda (run) 379 (lambda (run) 377 (let ((runkey (string-intersperse (map (lambda (k) 380 (let ((runkey (string-intersperse (map (lambda (k) 378 (db-get-value-by-header run head 381 (db-get-value-by-header run head 379 (let* ((run-id (db-get-value-by-header run header "id") ) 382 (let* ((run-id (db-get-value-by-header run header "id") ) 380 (tests (db-get-tests-for-run db (db-get-value-by-header run hea 383 (tests (db-get-tests-for-run db (db-get-value-by-header run hea 381 (lasttpath #f)) | 384 (lasttpath "/does/not/exist/I/hope")) 382 (if (not (null? tests)) 385 (if (not (null? tests)) 383 (begin 386 (begin 384 (print "Removing tests for run: " runkey " " (db-get-value-by-h 387 (print "Removing tests for run: " runkey " " (db-get-value-by-h 385 (for-each 388 (for-each 386 (lambda (test) 389 (lambda (test) 387 (print " " (db:test-get-testname test) " id: " (db:test-get 390 (print " " (db:test-get-testname test) " id: " (db:test-get 388 (db:delete-test-records db (db:test-get-id test)) 391 (db:delete-test-records db (db:test-get-id test))