Megatest

Diff
Login

Differences From Artifact [d32735ad01]:

To Artifact [22790e3566]:


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
183
184
185
186
187
188
189
190
191
192
193
                              CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));")
    ;; Must do this *after* running patch db !! No more. 
    (db:set-var db "MEGATEST_VERSION" megatest-version)
    ))

;; Create the sqlite db for the individual test(s)
(define (open-test-db testpath) 
  (let* ((dbpath    (conc testpath "/.testdat.db"))
	 (dbexists  (file-exists? dbpath))
	 (db        (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					   (string->number (args:get-arg "-override-timeout"))
					   36000))))
    (debug:print 4 "INFO: test dbpath=" dbpath)
    (sqlite3:set-busy-handler! db handler)
    (if (not dbexists)



	(db:testdb-initialize db))
    (sqlite3:execute db "PRAGMA synchronous = 0;")
    db))

(define (db:testdb-initialize db)
  (for-each
   (lambda (sqlcmd)
     (sqlite3:exectute db sqlcmd))
   (list "CREATE TABLE IF NOT EXISTS test_rundat (
              id INTEGER PRIMARY KEY,
              event_time TIMESTAMP,
              cpuload INTEGER DEFAULT -1,
              uname TEXT DEFAULT '',
              diskfree INTEGER DEFAULT -1,
              diskusage INTGER DEFAULT -1,
              run_duration INTEGER DEFAULT 0);"
	  "CREATE TABLE IF NOT EXISTS test_data (
              id INTEGER PRIMARY KEY,
              test_id INTEGER,
              category TEXT DEFAULT '',
              variable TEXT,
	      value REAL,
	      expected REAL,







|








>
>
>
|






|


|

<

|
<







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
183
184
185

186
187

188
189
190
191
192
193
194
                              CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));")
    ;; Must do this *after* running patch db !! No more. 
    (db:set-var db "MEGATEST_VERSION" megatest-version)
    ))

;; Create the sqlite db for the individual test(s)
(define (open-test-db testpath) 
  (let* ((dbpath    (conc testpath "/testdat.db"))
	 (dbexists  (file-exists? dbpath))
	 (db        (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					   (string->number (args:get-arg "-override-timeout"))
					   36000))))
    (debug:print 4 "INFO: test dbpath=" dbpath)
    (sqlite3:set-busy-handler! db handler)
    (if (not dbexists)
	(begin
	  (sqlite3:execute db "PRAGMA synchronous = FULL;")
	  (debug:print 0 "Initialized test database " dbpath)
	  (db:testdb-initialize db)))
    (sqlite3:execute db "PRAGMA synchronous = 0;")
    db))

(define (db:testdb-initialize db)
  (for-each
   (lambda (sqlcmd)
     (sqlite3:execute db sqlcmd))
   (list "CREATE TABLE IF NOT EXISTS test_rundat (
              id INTEGER PRIMARY KEY,
              update_time TIMESTAMP,
              cpuload INTEGER DEFAULT -1,

              diskfree INTEGER DEFAULT -1,
              diskusage INTGER DEFAULT -1);"

	  "CREATE TABLE IF NOT EXISTS test_data (
              id INTEGER PRIMARY KEY,
              test_id INTEGER,
              category TEXT DEFAULT '',
              variable TEXT,
	      value REAL,
	      expected REAL,
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
     qrystr)
    res))

;;======================================================================
;; QUEUE UP META, TEST STATUS AND STEPS
;;======================================================================

(define (db:updater db)
  (let loop ((start-time (current-time)))
    (thread-sleep! 0.5) ;; move save time around to minimize regular collisions?
    (db:write-cached-data db)
    (loop start-time)))
    
(define (db:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
  (mutex-lock! *incoming-mutex*)
  (set! *incoming-data* (cons (vector 'meta-info
				      (current-seconds)
				      (list cpuload
					    diskfree
					    minutes
					    test-id)) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) 
			      *incoming-data*))
  (mutex-unlock! *incoming-mutex*)
  (if *cache-on*
      (debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write as part of test-update-meta-info")
      (db:write-cached-data db)))

(define (db:write-cached-data db)
  (let ((meta-stmt (sqlite3:prepare db "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE id=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');"))
	(step-stmt (sqlite3:prepare db "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);")) ;; strftime('%s','now')#f)
	(data (sort *incoming-data* (lambda (a b)(< (vector-ref a 1)(vector-ref b 1))))))
    (if (> (length data) 0)
	(debug:print 4 "Writing cached data " data))
    (mutex-lock! *incoming-mutex*)
    (sqlite3:with-transaction 
     db
     (lambda ()
       (for-each (lambda (entry)
		   (case (vector-ref entry 0)
		     ((meta-info)
		      (apply sqlite3:execute meta-stmt (vector-ref entry 2)))
		     ((step-status)
		      (apply sqlite3:execute step-stmt (vector-ref entry 2)))
		     (else
		      (debug:print 0 "ERROR: Queued entry not recognised " entry))))
		 data)))
    (sqlite3:finalize! meta-stmt) ;; sqlite is the bottleneck, clear the statements asap?
    (sqlite3:finalize! step-stmt)
    (set! *incoming-data* '())
    (mutex-unlock! *incoming-mutex*)))

(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (or (equal? status "PASS")
	       (equal? status "WARN")
	       (equal? status "FAIL")
	       (equal? status "WAIVED")







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
     qrystr)
    res))

;;======================================================================
;; QUEUE UP META, TEST STATUS AND STEPS
;;======================================================================

;; (define (db:updater db)
;;   (let loop ((start-time (current-time)))
;;     (thread-sleep! 0.5) ;; move save time around to minimize regular collisions?
;;     (db:write-cached-data db)
;;     (loop start-time)))
;;     
;; (define (db:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
;;   (mutex-lock! *incoming-mutex*)
;;   (set! *incoming-data* (cons (vector 'meta-info
;; 				      (current-seconds)
;; 				      (list cpuload
;; 					    diskfree
;; 					    minutes
;; 					    test-id)) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) 
;; 			      *incoming-data*))
;;   (mutex-unlock! *incoming-mutex*)
;;   (if *cache-on*
;;       (debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write as part of test-update-meta-info")
;;       (db:write-cached-data db)))
;; 
;; (define (db:write-cached-data db)
;;   (let ((meta-stmt (sqlite3:prepare db "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE id=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');"))
;; 	(step-stmt (sqlite3:prepare db "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);")) ;; strftime('%s','now')#f)
;; 	(data (sort *incoming-data* (lambda (a b)(< (vector-ref a 1)(vector-ref b 1))))))
;;     (if (> (length data) 0)
;; 	(debug:print 4 "Writing cached data " data))
;;     (mutex-lock! *incoming-mutex*)
;;     (sqlite3:with-transaction 
;;      db
;;      (lambda ()
;;        (for-each (lambda (entry)
;; 		   (case (vector-ref entry 0)
;; 		     ((meta-info)
;; 		      (apply sqlite3:execute meta-stmt (vector-ref entry 2)))
;; 		     ((step-status)
;; 		      (apply sqlite3:execute step-stmt (vector-ref entry 2)))
;; 		     (else
;; 		      (debug:print 0 "ERROR: Queued entry not recognised " entry))))
;; 		 data)))
;;     (sqlite3:finalize! meta-stmt) ;; sqlite is the bottleneck, clear the statements asap?
;;     (sqlite3:finalize! step-stmt)
;;     (set! *incoming-data* '())
;;     (mutex-unlock! *incoming-mutex*)))

(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (or (equal? status "PASS")
	       (equal? status "WARN")
	       (equal? status "FAIL")
	       (equal? status "WAIVED")