Megatest

Diff
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Annotate Patch Side-by-side Diff

Differences From Artifact [7ad6d7a9bd]:

To Artifact [7efe9252ff]:

︙
34
35
36
37
38
39
40
41
42
43
44
45
46

47
48
49
50
51
52
53

54
55

56
57
58






59




60

61
62
63
64
65
66
67
68
69
70

71
72
73
74
75





76
77
78
79
80
81
82
83

34
35
36
37
38
39
40






41

42
43
44
45
46
47
48
49
50
51



52
53
54
55
56
57
58
59
60
61
62

63










64





65
66
67
68
69

70
71
72
73
74
75
76








-
-
-
-
-
-
+
-






+


+
-
-
-
+
+
+
+
+
+

+
+
+
+
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
-








(declare (uses filedb))

(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")

;; timestamp type (val1 val2 ...)
;; type: meta-info, step
(define *incoming-writes*      '())
(define *completed-writes*   (make-hash-table))
(define *incoming-last-time* (current-seconds))
(define *incoming-mutex*     (make-mutex))
(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
(define *completed-mutex*    (make-mutex))

;; Get/open a database
;;    if run-id => get run specific db
;;    if #f     => get main db
;;    if db already open - return inmem
;;    if db not open, open inmem, rundb and sync then return inmem
;;    inuse gets set automatically for rundb's
;;
(define (db:get-db dbstruct run-id)
  (mutex-lock! *rundb-mutex*)
  (if run-id
      (db:open-rundb dbstruct run-id)
      (db:open-main dbstruct)))
  (let ((db (if run-id
		(db:open-rundb dbstruct run-id)
		(db:open-main dbstruct))))
    ;; db prunning would go here
    (mutex-unlock! *rundb-mutex*)
    db))

;; mod-read:
;;     'mod   modified data
;;     'read  read data
;;
(define (db:set-sync db)
(define (db:done-with dbstruct run-id mod-read)
  (let* ((syncval  (config-lookup *configdat* "setup"     "synchronous"))
	 (val      (cond   ;; 0 | OFF | 1 | NORMAL | 2 | FULL;
		    ((not syncval) #f)
		    ((string->number syncval)
		     (let ((val (string->number syncval)))
		       (if (member val '(0 1 2)) val #f)))
		    ((string-match (regexp "yes" #t) syncval) 1)
		    ((string-match (regexp "no"  #t) syncval) 0)
		    ((string-match (regexp "(off|normal|full)" #t) syncval) syncval)
		    (else 
  (mutex-lock! *rundb-mutex*)
		     (debug:print 0 "ERROR: synchronous must be 0,1,2,OFF,NORMAL or FULL, you provided: " syncval)
		     #f))))
    (if val
	(begin
	  (debug:print-info 9 "db:set-sync, setting pragma synchronous to " val)
  (if (eq? mod-read 'mod)
      (dbr:dbstruct-set-runvec! dbstruct run-id 'mtime (current-milliseconds))
      (dbr:dbstruct-set-runvec! dbstruct run-id 'rtime (current-milliseconds)))
  (dbr:dbstruct-set-runvec! dbstruct run-id 'inuse #f)
  (mutex-unlock! *rundb-mutex*))
	  (sqlite3:execute db (conc "PRAGMA synchronous = '" val "';"))))))

;;======================================================================
;; K E E P   F I L E D B   I N   dbstruct
;;======================================================================

(define (db:get-filedb dbstruct)
  (let ((db (vector-ref dbstruct 2)))
︙
117
118
119
120
121
122
123


124
125
126
127
128
129
130

110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125








+
+








	  (if write-access
	      (begin
		(sqlite3:set-busy-handler! db handler)
		(sqlite3:execute db "PRAGMA synchronous = 0;")))
	  (if (not dbexists)(db:initialize-run-id-db db run-id))
	  (dbr:dbstruct-set-runvec! dbstruct run-id 'rundb db)
	  (dbr:dbstruct-set-runvec! dbstruct run-id 'inmem inmem)
	  (dbr:dbstruct-set-runvec! dbstruct run-id 'inuse #t)
	  (db:sync-tables db:sync-tests-only db inmem)
	  inmem))))

;; This routine creates the db. It is only called if the db is not already opened
;;
(define (db:open-main dbstruct) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let ((mdb (dbr:dbstruct-get-main dbstruct)))
    (if mdb
︙
145
146
147
148
149
150
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

140
141
142
143
144
145
146
147
148
149
150
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
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233








+
+
+
+
+
+
+
+
+
+
+
+
+
+

















+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+








		(sqlite3:set-busy-handler! db handler)
		(sqlite3:execute db "PRAGMA synchronous = 0;")))
	  (if (not dbexists)
	      (db:initialize-megatest-db db))
	  (dbr:dbstruct-set-main! dbstruct db)
	  db))))

;; sync all touched runs to disk
(define (db:sync-touched dbstruct)
  (for-each
   (lambda (runvec)
     (let ((mtime (vector-ref runvec (dbr:dbstruct-field-name->num 'mtime)))
	   (stime (vector-ref runvec (dbr:dbstruct-field-name->num 'stime)))
	   (rundb (vector-ref runvec (dbr:dbstruct-field-name->num 'rundb)))
	   (inmem (vector-ref runvec (dbr:dbstruct-field-name->num 'inmem))))
       (if (> mtime stime)
	   (begin
	     (db:sync-tables db:sync-tests-only inmem rundb)
	     (vector-set! runvec (dbr:dbstruct-field-name->run 'stime (current-milliseconds)))))))
   (hash-table-values (vector-ref dbstruct 1))))

;; close all opened run-id dbs
(define (db:close-all-db)
  (for-each
   (lambda (db)
     (finalize! db))
   (hash-table-values (vector-ref *open-dbs* 1)))
  (finalize! (vector-ref *open-dbs* 0)))

(define (open-inmem-db)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler   (make-busy-timeout 3600)))
    (db:initialize db)
    (sqlite3:set-busy-handler! db handler)
    (set! sdb:qry (make-sdb:qry)) ;; we open the normalization helpers here
    (set! *fdb*   (filedb:open-db (conc *toppath* "/db/paths.db")))
    db))

;; just tests, test_steps and test_data tables
;; (define (db:sync-table tblname fields fromdb todb)
(define db:sync-tests-only
  (list
   (list "tests" 
	 '("id"             #f)
	 '("run_id"         #f)
	 '("testname"       #f)
	 '("host"           #f)
	 '("cpuload"        #f)
	 '("diskfree"       #f)
	 '("uname"          #f)
	 '("rundir"         #f)
	 '("shortdir"       #f)
	 '("item_path"      #f)
	 '("state"          #f)
	 '("status"         #f)
	 '("attemptnum"     #f)
	 '("final_logf"     #f)
	 '("logdat"         #f)
	 '("run_duration"   #f)
	 '("comment"        #f)
	 '("event_time"     #f)
	 '("fail_count"     #f)
	 '("pass_count"     #f)
	 '("archived"       #f))
   (list "test_steps"
	 '("id"             #f)
	 '("test_id"        #f)
	 '("stepname"       #f)
	 '("state"          #f)
	 '("status"         #f)
	 '("event_time"     #f)
	 '("comment"        #f)
	 '("logfile"        #f))
   (list "test_data"
	 '("id"             #f)
	 '("test_id"        #f)
	 '("category"       #f)
	 '("variable"       #f)
	 '("value"          #f)
	 '("expected"       #f)
	 '("tol"            #f)
	 '("units"          #f)
	 '("comment"        #f)
	 '("status"         #f)
	 '("type"           #f))))

;; needs db to get keys, this is for syncing all tables
;;
(define (db:tbls db)
  (let ((keys  (db:get-keys db)))
    (list
     (list "keys"
	   '("id"        #f)
	   '("fieldname" #f)
	   '("fieldtype" #f))
︙
335
336
337
338
339
340
341
342

343
344
345
346
347
348
349

391
392
393
394
395
396
397

398
399
400
401
402
403
404
405








-
+








;; (define open-run-close 
(define open-run-close (if (debug:debug-mode 2)
			   open-run-close-no-exception-handling
			   open-run-close-exception-handling))

(define (db:initialize-megatest-db db)
  (let* ((configdat (car *configinfo*))  ;; tut tut, global warning...
	 (keys     (keys:configq-get-fields configdat))
	 (keys     (keys:config-get-fields configdat))
	 (havekeys (> (length keys) 0))
	 (keystr   (keys->keystr keys))
	 (fieldstr (keys->key/field keys)))
    (for-each (lambda (key)
		(let ((keyn key))
		  (if (member (string-downcase keyn)
			      (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count"
︙
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442









443
444
445
446
447
448
449

483
484
485
486
487
488
489









490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505








-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+








                               stepname TEXT, 
                               state TEXT DEFAULT 'NOT_STARTED', 
                               status TEXT DEFAULT 'n/a',
                               event_time TIMESTAMP,
                               comment TEXT DEFAULT '',
                               logfile TEXT DEFAULT '',
                               CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));")
  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data 
                              (id          INTEGER PRIMARY KEY,
                                     reviewed    TIMESTAMP DEFAULT (strftime('%s','now')),
                                     iterated    TEXT DEFAULT '',
                                     avg_runtime REAL DEFAULT -1,
                                     avg_disk    REAL DEFAULT -1,
                                     tags        TEXT DEFAULT '',
                                     jobgroup    TEXT DEFAULT 'default',
                                CONSTRAINT test_meta_constraint UNIQUE (testname));")
;;   (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data 
;;                               (id          INTEGER PRIMARY KEY,
;;                                      reviewed    TIMESTAMP DEFAULT (strftime('%s','now')),
;;                                      iterated    TEXT DEFAULT '',
;;                                      avg_runtime REAL DEFAULT -1,
;;                                      avg_disk    REAL DEFAULT -1,
;;                                      tags        TEXT DEFAULT '',
;;                                      jobgroup    TEXT DEFAULT 'default',
;;                                 CONSTRAINT test_meta_constraint UNIQUE (testname));")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY,
                                test_id INTEGER,
                                category TEXT DEFAULT '',
                                variable TEXT,
	                        value REAL,
	                        expected REAL,
	                        tol REAL,
︙
This page was generated in about 0.107s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00