Megatest

Check-in [3ee9f5dc73]
Login
Overview
Comment:Implemented WAIVER propagation, but not debugged
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | waiver-propagation
Files: files | file ages | folders
SHA1: 3ee9f5dc73302f9bc5bbf591fe5445ff868b80ae
User & Date: matt on 2011-08-30 00:22:01
Other Links: branch diff | manifest | tags
Context
2011-08-30
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
Changes

Modified runs.scm from [9050f708b7] to [8cd804b0f7].

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



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







>
|















>
>







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
		  (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
190
191
192
193
194
195
196
197
198

199
200
201
202
203
204
205
206
207
	   "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)))