Changes In Branch remove-given-state-status Excluding Merge-Ins
This is equivalent to a diff from c65398ee68 to 3ae695ed4b
|
2012-04-04
| ||
| 19:41 | Merged in the removed based on state and status branch check-in: f38b3dadbd user: mrwellan tags: trunk | |
| 18:07 | Added ability to remove tests based on :state and :status Closed-Leaf check-in: 3ae695ed4b user: mrwellan tags: remove-given-state-status | |
|
2012-03-31
| ||
| 18:38 | Cleaned up ignores and added minimal example to docs check-in: ca3478ee5c user: matt tags: trunk | |
| 18:26 | Experimentally cutting back the open-db/finalize cycle NOTE: This made contention on the db worse and causes failures Closed-Leaf check-in: e01e81f554 user: matt tags: experimental-streamlining | |
|
2012-03-30
| ||
| 00:07 | Fixed reading of runconfigs; chdir to location of .config before reading sub-files; added pattern matching on sections to target; added tests, removed some redundant db accesses check-in: c65398ee68 user: matt tags: trunk | |
|
2012-03-28
| ||
| 20:16 | Removed debug statement check-in: aea23d28f1 user: mrwellan tags: trunk | |
Modified db.scm from [1ae5c33688] to [f62d133081].
| ︙ | ︙ | |||
422 423 424 425 426 427 428 |
;;======================================================================
;; T E S T S
;;======================================================================
;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
;; states and statuses are required to be lists, empty is ok
| > | | | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 |
;;======================================================================
;; T E S T S
;;======================================================================
;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
;; states and statuses are required to be lists, empty is ok
;; not-in #t = above behaviour, #f = must match
(define (db:get-tests-for-run db run-id testpatt itempatt states statuses #!key (not-in #t))
(let* ((res '())
(states-str (conc "('" (string-intersperse states "','") "')"))
(statuses-str (conc "('" (string-intersperse statuses "','") "')"))
(qry (conc "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 ? "
" AND " (if not-in "NOT" "") " (state in " states-str " AND status IN " statuses-str ") "
;; " ORDER BY id DESC;"
" ORDER BY event_time ASC;" ;; POTENTIAL ISSUE! CHECK ME! Does anyting depend on this being sorted by id?
)))
(debug:print 8 "INFO: db:get-tests-for-run qry=" qry)
(sqlite3:for-each-row
(lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
(set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
|
| ︙ | ︙ | |||
1200 1201 1202 1203 1204 1205 1206 |
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:get-runs host port)
runnamepatt numruns startrunoffset keypatts))
(db:get-runs db runnamepatt numruns startrunoffset keypatts)))
| | | | | 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 |
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:get-runs host port)
runnamepatt numruns startrunoffset keypatts))
(db:get-runs db runnamepatt numruns startrunoffset keypatts)))
(define (rdb:get-tests-for-run db run-id testpatt itempatt states statuses #!key (not-in #t))
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:get-tests-for-run host port)
run-id testpatt itempatt states statuses not-in: not-in))
(db:get-tests-for-run db run-id testpatt itempatt states statuses not-in: not-in)))
(define (rdb:get-test-data-by-id db test-id)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rpc:get-test-data-by-id host port)
test-id))
|
| ︙ | ︙ |
Modified megatest.scm from [f3f42fd5f0] to [77a84de5f2].
| ︙ | ︙ | |||
250 251 252 253 254 255 256 | (begin (debug:print 0 "ERROR: Attempted to remove test(s) but run area config file not found") (exit 1)) ;; put test parameters into convenient variables (runs:remove-runs db (args:get-arg ":runname") (args:get-arg "-testpatt") | | > > | 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 |
(begin
(debug:print 0 "ERROR: Attempted to remove test(s) but run area config file not found")
(exit 1))
;; put test parameters into convenient variables
(runs:remove-runs db
(args:get-arg ":runname")
(args:get-arg "-testpatt")
(args:get-arg "-itempatt")
state: (args:get-arg ":state")
status: (args:get-arg ":status")))
(sqlite3:finalize! db)
(set! *didsomething* #t)))))
(if (args:get-arg "-remove-runs")
(general-run-call
"-remove-runs"
"remove runs"
|
| ︙ | ︙ |
Modified runs.scm from [eb30591b86] to [e177dce855].
| ︙ | ︙ | |||
491 492 493 494 495 496 497 |
(let ((dparts (string-split dir "/"))
(count (if (null? params) 1 (car params))))
(conc "/" (string-intersperse
(take dparts (- (length dparts) count))
"/"))))
;; Remove runs
;; fields are passing in through
| | | > > > | | 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 |
(let ((dparts (string-split dir "/"))
(count (if (null? params) 1 (car params))))
(conc "/" (string-intersperse
(take dparts (- (length dparts) count))
"/"))))
;; Remove runs
;; fields are passing in through
(define (runs:remove-runs db runnamepatt testpatt itempatt #!key (state #f)(status #f))
(let* ((keys (rdb:get-keys db))
(rundat (runs:get-runs-by-patt db keys runnamepatt))
(header (vector-ref rundat 0))
(runs (vector-ref rundat 1))
(states (if state (string-split state ",") '()))
(statuses (if status (string-split status ",") '())))
(debug:print 1 "Header: " header)
(for-each
(lambda (run)
(let ((runkey (string-intersperse (map (lambda (k)
(db:get-value-by-header run header (vector-ref k 0))) keys) "/"))
(dirs-to-remove (make-hash-table)))
(let* ((run-id (db:get-value-by-header run header "id") )
;; not-in: switches from the default get-tests-for-run behavior to require a match
(tests (rdb:get-tests-for-run db (db:get-value-by-header run header "id") testpatt itempatt states statuses not-in: #f))
(lasttpath "/does/not/exist/I/hope"))
(if (not (null? tests))
(begin
(debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname"))
(for-each
(lambda (test)
|
| ︙ | ︙ |