Megatest

Check-in [b94b060f8d]
Login
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: b94b060f8d88b8da11c3d31da701afead2f863ba
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
112

113
114
115
116
117
118
119
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.20)
     (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

160
161
162
163
164
165
166








167

168
169
170
171
172
173
174
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;")
    res))
      (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






92
93



94
95
96
97






98
99
100
101
102
103
104
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 db (open-db))
;;  (test-set-status! db 2 "runfirst" "COMPLETED" "PASS" "summer")
	 
    
    

(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))))
	(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
579

580
581
582
583
584
585
586
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"))
			     (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)