Overview
Comment: | Merged in the removed based on state and status branch |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
f38b3dadbdc3bf1bbd7626a4b1935ff7 |
User & Date: | mrwellan on 2012-04-04 19:41:50 |
Other Links: | manifest | tags |
Context
2012-04-09
| ||
15:45 | Fixed issue with remove-runs so default is to remove all if :state and :status are not specified, fixed pattern match due to glob wierdness issue with running tests based on itempatt check-in: 2dca8d8f9a user: mrwellan tags: trunk | |
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 | |
17:30 | Pulled in the beginings of multi-filter code check-in: 3e1180bef3 user: mrwellan tags: trunk | |
Changes
Modified db.scm from [a8d45b3634] to [41c48e20a6].
︙ | ︙ | |||
428 429 430 431 432 433 434 | ;;====================================================================== ;; 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 | > | | | 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 | ;;====================================================================== ;; 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))) |
︙ | ︙ | |||
1206 1207 1208 1209 1210 1211 1212 | (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))) | | | | | 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 | (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 [ff47085649] to [0ed2270785].
︙ | ︙ | |||
253 254 255 256 257 258 259 | (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") | | > > | 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 | (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 [f5e1ed9051] to [3b1178542b].
1 |
| | | 1 2 3 4 5 6 7 8 9 | ;; Copyright 2006-2011, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. |
︙ | ︙ | |||
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 521 522 523 524 | (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")) (run-state (db:get-value-by-header run header "state")) (tests (if (not (equal? run-state "locked")) (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) (let* ((item-path (db:test-get-item-path test)) (test-name (db:test-get-testname test)) |
︙ | ︙ | |||
572 573 574 575 576 577 578 | (db:delete-run db run-id) ;; need to figure out the path to the run dir and remove it if empty ;; (if (null? (glob (conc runpath "/*"))) ;; (begin ;; (debug:print 1 "Removing run dir " runpath) ;; (system (conc "rmdir -p " runpath)))) )))) | | | 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 | (db:delete-run db run-id) ;; need to figure out the path to the run dir and remove it if empty ;; (if (null? (glob (conc runpath "/*"))) ;; (begin ;; (debug:print 1 "Removing run dir " runpath) ;; (system (conc "rmdir -p " runpath)))) )))) )) runs))) ;;====================================================================== ;; Routines for manipulating runs ;;====================================================================== ;; Since many calls to a run require pretty much the same setup |
︙ | ︙ |