Megatest

Diff
Login

Differences From Artifact [a0a9838068]:

To Artifact [ac80fea080]:


89
90
91
92
93
94
95

96
97
98
99
100
101
102

103
104
105
106
107
108
109
89
90
91
92
93
94
95
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110







+






-
+








(define (test-set-status! db run-id test-name state status itemdat-or-path . comment)
  (let ((item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path))))
    (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)
    (if (and (not (equal? item-path "")) ;; need to update the top test record if PASS or FAIL and this is a subtest
	     (or (equal? status "PASS")
		 (equal? status "WARN")
		 (equal? status "FAIL")))
	(begin
	  (sqlite3:execute 
	   db
	   "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status='FAIL'),
                 pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status='PASS')
                 pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND (status='PASS' OR status='WARN'))
             WHERE run_id=? AND testname=? AND item_path='';"
	   run-id test-name run-id test-name run-id test-name)
	  (sqlite3:execute
	   db
	   "UPDATE tests
             SET state='COMPLETED',
                status=CASE WHEN fail_count > 0 THEN 'FAIL' WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' ELSE 'UNKNOWN' END
338
339
340
341
342
343
344

345
346
347
348
349
350
351
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353







+







				  (string->symbol (test:get-state test-status))
				  'failed-to-insert))
		      ((failed-to-insert)
		       (print "ERROR: Failed to insert the record into the db"))
		      ((NOT_STARTED COMPLETED) ;; (cadr status is the row id for the run record)
		       (if (and (equal? (test:get-state test-status)  "COMPLETED")
				(or (equal? (test:get-status test-status) "PASS")
				    (equal? (test:get-status test-status) "WARN")
				    (equal? (test:get-status test-status) "CHECK"))
				(not (args:get-arg "-force")))
			   (print "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status test-status) "\", use -force to override")
			   (let* ((get-prereqs-cmd (lambda ()
						     (db-get-prereqs-not-met db run-id waiton))) ;; check before running ....
				  (launch-cmd      (lambda ()
						     (launch-test db run-id test-conf keyvallst test-name test-path itemdat)))