Megatest

Changes On Branch 3ee9f5dc73302f9b
Login

Changes In Branch waiver-propagation Through [3ee9f5dc73] Excluding Merge-Ins

This is equivalent to a diff from b2e635cc07 to 3ee9f5dc73

2011-08-30
22:59
Merged WAIVER propagation into trunk and bumped version check-in: 39d81114d3 user: matt tags: trunk
22:44
Completed WAIVER propagation check-in: 018b99afd8 user: matt tags: waiver-propagation
00:22
Implemented WAIVER propagation, but not debugged check-in: 3ee9f5dc73 user: matt tags: waiver-propagation
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
13:37
Cleaned up the test steps display a bit more check-in: 55d1298d58 user: mrwellan tags: trunk

Modified db.scm from [9f0642f78d] to [fd4588d610].

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







|







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

160
161
162
163
164
165

166
167

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

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



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








>
>
>
>
>

>
|
|
|
|
|
|
>
|

>







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 [8cd804b0f7].

85
86
87
88
89
90
91

92




























93
94
95

96
97

















98
99
100
101
102
103
104
			run-id 
			test-name
			pth 
			;; (conc "," (string-intersperse tags ",") ",")
			))
     item-paths )))


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

















    ;; 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)))







>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|


>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
			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-records 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))
    ;; first look up the key values from the run selected by run-id
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! keyvals (cons a b)))
     db
     (conc "SELECT " selstr " FROM runs WHERE run_id=? ORDER BY event_time DESC;"))
    (if (not keyvals)
	#f
	(let ((prev-run-ids '()))
	  (apply sqlite3:for-each-row
		 (lambda (id)
		   (set! prev-run-ids (cons id prev-run-ids)))
		 db
		 (conc "SELECT run_id FROM runs WHERE " qrystr ";"))
	  ;; for each run starting with the most recent look to see if there is a matching test
	  ;; if found then return that matching test record
	  (if (null? prev-run-ids) #f
	      (let loop ((hed (car prev-run-ids))
			 (tal (cdr prev-run-ids)))
		(let ((results (db-get-tests-for-run db test-name item-path)))
		  (if (and (null? results)
			   (not (null? tal)))
		      (loop (car tal)(cdr tal))
		      (car results)))))))))
    

(define (test-set-status! db run-id test-name state status itemdat-or-path comment dat)
  (let ((real-status status)
	(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 ((prev-test (test:get-previous-test-run-records db run-id test-name item-path)))
			(if (and prev-test (not (null? prev-test))) ;; true if we found a previous test in this run series
			    (let ((prev-status (db:test-get-status   prev-test))
				  (prev-state  (db:test-get-state    prev-test))
				  (prev-comment (db:test-get-comment prev-test)))
			      (if (and (equal? prev-status "COMPLETED")
				       (equal? prev-state  "WAIVED"))
				  prev-comment ;; waived is either the comment or #f
				  #f))
			    #f))
		      #f)))

    (if waived (set! real-status "WAIVED"))

    ;; 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)))
146
147
148
149
150
151
152
153
154

155
156
157
158
159
160
161
162
163
	   "UPDATE tests
             SET state=CASE WHEN (SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND state in ('RUNNING','NOT_STARTED')) > 0 THEN 
                          'RUNNING'
                       ELSE 'COMPLETED' END,
                status=CASE WHEN fail_count > 0 THEN 'FAIL' WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' ELSE 'UNKNOWN' END
             WHERE run_id=? AND testname=? AND item_path='';"
	   run-id test-name run-id test-name)))
    (if (and (string? comment)
	     (string-match (regexp "\\S+") comment))

	(sqlite3:execute db "UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;"
			 (car comment) run-id test-name item-path))
    ))

(define (test-set-log! db run-id test-name itemdat logf) 
  (let ((item-path (item-list->path itemdat)))
    (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path=?;" 
		     logf run-id test-name item-path)))








|
|
>

|







193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
	   "UPDATE tests
             SET state=CASE WHEN (SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND state in ('RUNNING','NOT_STARTED')) > 0 THEN 
                          'RUNNING'
                       ELSE 'COMPLETED' END,
                status=CASE WHEN fail_count > 0 THEN 'FAIL' WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' ELSE 'UNKNOWN' END
             WHERE run_id=? AND testname=? AND item_path='';"
	   run-id test-name run-id test-name)))
    (if (or (and (string? comment)
		 (string-match (regexp "\\S+") comment))
	    waived)
	(sqlite3:execute db "UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;"
			 (if waived waived comment) run-id test-name item-path))
    ))

(define (test-set-log! db run-id test-name itemdat logf) 
  (let ((item-path (item-list->path itemdat)))
    (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path=?;" 
		     logf run-id test-name item-path)))

572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
		       (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"))
			   (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)







|







620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
		       (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)