Overview
Comment: | Partial implemenation of WAIVER propagation |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | waiver-propagation |
Files: | files | file ages | folders |
SHA1: |
b94b060f8d88b8da11c3d31da701afea |
User & Date: | matt on 2011-08-29 08:38:22 |
Other Links: | branch diff | manifest | tags |
Context
2011-08-30
| ||
00:09 | Wrote routine to get previous tests in the current run suite check-in: 6054963abb user: matt tags: waiver-propagation | |
2011-08-29
| ||
08:38 | Partial implemenation of WAIVER propagation check-in: b94b060f8d user: matt tags: waiver-propagation | |
2011-08-24
| ||
16:08 | Added :units to display on dashboard check-in: b2e635cc07 user: mrwellan tags: trunk, v1.22 | |
Changes
Modified db.scm from [9f0642f78d] to [fd4588d610].
︙ | ︙ | |||
105 106 107 108 109 110 111 | (begin (print "Adding megatest-version to metadata") (sqlite3:execute db (db:set-var db "MEGATEST_VERSION" megatest-version)))) ;; (if (< mver 1.18) ;; (begin ;; (print "Adding tags column to tests table") ;; (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT '';"))) | | | 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | (begin (print "Adding megatest-version to metadata") (sqlite3:execute db (db:set-var db "MEGATEST_VERSION" megatest-version)))) ;; (if (< mver 1.18) ;; (begin ;; (print "Adding tags column to tests table") ;; (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT '';"))) (if (< mver 1.21) (begin (sqlite3:execute db "CREATE TABLE test_meta (id INTEGER PRIMARY KEY, testname TEXT DEFAULT '', author TEXT DEFAULT '', owner TEXT DEFAULT '', description TEXT DEFAULT '', reviewed TIMESTAMP, |
︙ | ︙ | |||
151 152 153 154 155 156 157 158 159 | (if (string? res) (let ((valnum (string->number res))) (if valnum valnum res)) res))) (define (db:set-var db var val) (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)) (define (db-get-keys db) | > > > > > > | | | | | | > | > | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | (if (string? res) (let ((valnum (string->number res))) (if valnum valnum res)) res))) (define (db:set-var db var val) (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)) ;; use a global for some primitive caching, it is just silly to re-read the db ;; over and over again for the keys since they never change (define *db-keys* #f) (define (db-get-keys db) (if *db-keys* *db-keys* (let ((res '())) (sqlite3:for-each-row (lambda (key keytype) (set! res (cons (vector key keytype) res))) db "SELECT fieldname,fieldtype FROM keys ORDER BY id DESC;") (set! *db-keys* res) res))) (define db:get-keys db-get-keys) (define-inline (db:get-header vec)(vector-ref vec 0)) (define-inline (db:get-rows vec)(vector-ref vec 1)) (define (db:get-value-by-header row header field) (if (null? header) #f (let loop ((hed (car header)) |
︙ | ︙ |
Modified runs.scm from [19e8e11b2f] to [d357f22eb6].
︙ | ︙ | |||
85 86 87 88 89 90 91 | run-id test-name pth ;; (conc "," (string-intersperse tags ",") ",") )) item-paths ))) | > > > > > > | | > | > > > > > | 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | run-id test-name pth ;; (conc "," (string-intersperse tags ",") ",") )) item-paths ))) ;; get the previous record for when this test was run where all keys match but runname (define (test:get-previous-test-run-record db run-id test-name item-path) (let* ((keys (db:get-keys db)) (selstr (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ",")) (qrystr (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND ")) (keyvals #f) (define (test-set-status! db run-id test-name state status itemdat-or-path comment dat) (let ((item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path))) (otherdat (if dat dat (make-hash-table))) ;; before proceeding we must find out if the previous test (where all keys matched except runname) ;; was WAIVED if this test is FAIL (waived (if (equal? status "FAIL") (let (( ;; update the primary record IF state AND status are defined (if (and state status) (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;" state status run-id test-name item-path)) ;; add metadata (need to do this way to avoid SQL injection issues) ;; :value (let ((val (hash-table-ref/default otherdat ":value" #f))) |
︙ | ︙ | |||
572 573 574 575 576 577 578 | (debug:print 1 "NOTE: " new-test-name " is already running or was explictly killed, use -force to launch it.")) ((LAUNCHED REMOTEHOSTSTART RUNNING) (if (> (- (current-seconds)(+ (db:test-get-event_time testdat) (db:test-get-run_duration testdat))) 100) ;; i.e. no update for more than 100 seconds (begin (debug:print 0 "WARNING: Test " test-name " appears to be dead. Forcing it to state INCOMPLETE and status STUCK/DEAD") | | | 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 | (debug:print 1 "NOTE: " new-test-name " is already running or was explictly killed, use -force to launch it.")) ((LAUNCHED REMOTEHOSTSTART RUNNING) (if (> (- (current-seconds)(+ (db:test-get-event_time testdat) (db:test-get-run_duration testdat))) 100) ;; i.e. no update for more than 100 seconds (begin (debug:print 0 "WARNING: Test " test-name " appears to be dead. Forcing it to state INCOMPLETE and status STUCK/DEAD") (test-set-status! db run-id test-name "INCOMPLETE" "STUCK/DEAD" itemdat "Test is stuck or dead" #f)) (debug:print 2 "NOTE: " test-name " is already running"))) (else (debug:print 0 "ERROR: Failed to launch test " new-test-name ". Unrecognised state " (test:get-state testdat)))))) (if (not (null? tal)) (loop (car tal)(cdr tal))))))))) (define (run-waiting-tests db) (let ((numtries 0) |
︙ | ︙ |