Megatest

Check-in [b055e5fd1b]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Removed unneeded opening of main.db in each server. Reworked run stats
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | megatest.db-sync
Files: files | file ages | folders
SHA1: b055e5fd1b3dc64aa0a89ca130ce90b10efb1806
User & Date: matt on 2014-03-18 23:57:44
Other Links: branch diff | manifest | tags
Context
2014-03-19
10:21
Merge db-sync to the v1.60 check-in: f5a9d4250c user: mrwellan tags: v1.60
2014-03-18
23:57
Removed unneeded opening of main.db in each server. Reworked run stats Closed-Leaf check-in: b055e5fd1b user: matt tags: megatest.db-sync
17:31
Fixed typo check-in: 1911dc98ed user: mrwellan tags: megatest.db-sync
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [5f0bb87ad0] to [1cc2ae8b79].

︙
199
200
201
202
203
204
205

206

207
208
209
210
211
212
213

199
200
201
202
203
204
205
206

207
208
209
210
211
212
213
214








+
-
+








	  db))))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup run-id #!key (local #f))
  (let* ((dbdir    (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
	 (dbstruct (make-dbr:dbstruct path: dbdir local: local)))
    ;; isn't this a hold-over from the multi-db in one process? Commenting it out for now ....
    (db:get-db dbstruct #f) ;; force one call to main
    ;; (db:get-db dbstruct #f) ;; force one call to main
    dbstruct))

;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)
  (let* ((dbpath       (conc *toppath* "/megatest.db"))
	 (dbexists     (file-exists? dbpath))
︙
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254

223
224
225
226
227
228
229



















230
231
232
233
234
235
236








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








	  (sqlite3:execute db "PRAGMA synchronous = 0;")))
    (if (not dbexists)
	(begin
	  (db:initialize-main-db db)
	  (db:initialize-run-id-db db)))
    db))

;; ;; sync all touched runs to disk
;; ;;
;; (define (db:sync-touched dbstruct #!key (force-sync #f))
;;   (let ((tot-synced 0))
;;     (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)))
;; 	     (refdb (vector-ref runvec (dbr:dbstruct-field-name->num 'refdb)))
;; 	     (slave (vector-ref runvec (dbr:dbstruct-field-name->num 'slavedb))))
;; 	 (if (or (> mtime stime) force-sync)
;; 	     (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb)))
;; 	       (set! tot-synced (+ tot-synced num-synced))
;; 	       (vector-set! runvec (dbr:dbstruct-field-name->num 'stime) (current-milliseconds))))))
;;      (hash-table-values (vector-ref dbstruct 1)))
;;     tot-synced))

;; sync run to disk if touched
;;
(define (db:sync-touched dbstruct #!key (force-sync #f))
  (let ((mtime (dbr:dbstruct-get-mtime dbstruct))
	(stime (dbr:dbstruct-get-stime dbstruct))
	(rundb (dbr:dbstruct-get-rundb dbstruct))
	(inmem (dbr:dbstruct-get-inmem dbstruct))
︙
1042
1043
1044
1045
1046
1047
1048

1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059

1060
1061
1062
1063
1064



1065
1066
1067
1068



1069
1070
1071
1072
1073
1074






1075



1076
1077
1078
1079
1080
1081
1082

1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046


1047
1048
1049




1050
1051
1052
1053





1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070








+











+



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

-
-
-
-
-
+
+
+
+
+
+

+
+
+









;; get some basic run stats
;;
;; ( (runname (( state  count ) ... ))
;;   (   ...  
(define (db:get-run-stats dbstruct)
  (let ((totals       (make-hash-table))
	(curr         (make-hash-table))
	(res          '())
	(runs-info    '()))
    ;; First get all the runname/run-ids
    (sqlite3:for-each-row
     (lambda (run-id runname)
       (set! runs-info (cons (list run-id runname) runs-info)))
     (db:get-db dbstruct #f)
     "SELECT id,runname FROM runs WHERE state != 'deleted';")
    ;; for each run get stats data
    (for-each
     (lambda (run-info)
       ;; get the net state/status counts for this run
       (let ((run-id   (car  run-info))
	     (run-name (cadr run-info)))
	 (sqlite3:for-each-row
	  (lambda (state count)
	    (if (string? state)
	  (lambda (state status count)
	    (let ((netstate (if (equal? state "COMPLETED") status state)))
	      (if (string? netstate)
		(let* ((stateparts (string-split state "|"))
		       (newstate   (conc (car stateparts) "\n" (cadr stateparts))))
		  (hash-table-set! totals newstate (+ (hash-table-ref/default totals newstate 0) count))
		  (set! res (cons (list run-name newstate count) res)))))
		  (begin
		    (hash-table-set! totals netstate (+ (hash-table-ref/default totals netstate 0) count))
		    (hash-table-set! curr   netstate (+ (hash-table-ref/default curr   netstate 0) count))))))
	  (db:get-db dbstruct run-id)
	  "SELECT state||'|'||status AS s,count(id) FROM tests AS t ORDER BY s DESC;" )
    ;; (set! res (reverse res))
    (for-each (lambda (state)
		(set! res (cons (list "Totals" state (hash-table-ref totals state)) res)))
		   (sort (hash-table-keys totals) string>=))))
	  "SELECT state,status,count(id) FROM tests AS t GROUP BY state,status ORDER BY state,status DESC;")
	 ;; add the per run counts to res
	 (for-each (lambda (state)
		     (set! res (cons (list run-name state (hash-table-ref curr state)) res)))
		   (sort (hash-table-keys curr) string>=))
	 (set! curr (make-hash-table))))
     runs-info)
    (for-each (lambda (state)
		(set! res (cons (list "Totals" state (hash-table-ref totals state)) res)))
	      (sort (hash-table-keys totals) string>=))
    res))

;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
︙

Modified db_records.scm from [139c08b6c7] to [c4cc0272f9].

︙
24
25
26
27
28
29
30

31
32
33
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
84
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

24
25
26
27
28
29
30
31
32
33
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








+














+




-
+











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








(define-inline (dbr:dbstruct-get-mtime   vec)    (vector-ref  vec 6))
(define-inline (dbr:dbstruct-get-rtime   vec)    (vector-ref  vec 7))
(define-inline (dbr:dbstruct-get-stime   vec)    (vector-ref  vec 8))
(define-inline (dbr:dbstruct-get-inuse   vec)    (vector-ref  vec 9))
(define-inline (dbr:dbstruct-get-refdb   vec)    (vector-ref  vec 10))
(define-inline (dbr:dbstruct-get-locdbs  vec)    (vector-ref  vec 11))
(define-inline (dbr:dbstruct-get-olddb   vec)    (vector-ref  vec 12))
(define-inline (dbr:dbstruct-get-run-id  vec)    (vector-ref  vec 13))

(define-inline (dbr:dbstruct-set-main!   vec val)(vector-set! vec 0 val))
(define-inline (dbr:dbstruct-set-strdb!  vec val)(vector-set! vec 1 val))
(define-inline (dbr:dbstruct-set-path!   vec val)(vector-set! vec 2 val))
(define-inline (dbr:dbstruct-set-local!  vec val)(vector-set! vec 3 val))
(define-inline (dbr:dbstruct-set-rundb!  vec val)(vector-set! vec 4 val))
(define-inline (dbr:dbstruct-set-inmem!  vec val)(vector-set! vec 5 val))
(define-inline (dbr:dbstruct-set-mtime!  vec val)(vector-set! vec 6 val))
(define-inline (dbr:dbstruct-set-rtime!  vec val)(vector-set! vec 7 val))
(define-inline (dbr:dbstruct-set-stime!  vec val)(vector-set! vec 8 val))
(define-inline (dbr:dbstruct-set-inuse!  vec val)(vector-set! vec 9 val))
(define-inline (dbr:dbstruct-set-refdb!  vec val)(vector-set! vec 10 val))
(define-inline (dbr:dbstruct-set-locdbs! vec val)(vector-set! vec 11 val))
(define-inline (dbr:dbstruct-set-olddb!  vec val)(vector-set! vec 12 val))
(define-inline (dbr:dbstruct-set-run-id! vec val)(vector-set! vec 13 val))

;; constructor for dbstruct
;;
(define (make-dbr:dbstruct #!key (path #f)(local #f))
  (let ((v (make-vector 13 #f)))
  (let ((v (make-vector 14 #f)))
    (dbr:dbstruct-set-path! v path)
    (dbr:dbstruct-set-local! v local)
    (dbr:dbstruct-set-locdbs! v (make-hash-table))
    v))

(define (dbr:dbstruct-get-localdb v run-id)
  (hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f))

(define (dbr:dbstruct-set-localdb! v run-id db)
  (hash-table-set! (dbr:dbstruct-get-locdbs v) run-id db))

;; ;; get and set main db
;; (define-inline (dbr:dbstruct-get-main  vec)    (vector-ref vec 0))
;; (define-inline (dbr:dbstruct-set-main! vec db)(vector-set! vec 0 db))
;; ;; get the runs hash
;; (define-inline (dbr:dbstruct-get-dbhash vec) (vector-ref vec 1))
;; ;; the string db
;; (define-inline (dbr:dbstruct-get-strdb vec)    (vector-ref vec 2))
;; (define-inline (dbr:dbstruct-set-strdb! vec db)(vector-set! vec 2 db))
;; ;; path
;; (define-inline (dbr:dbstruct-get-path  vec)     (vector-ref vec 3))
;; (define-inline (dbr:dbstruct-set-path! vec path)(vector-set! vec 3))
;; ;; local
;; (define-inline (dbr:dbstruct-get-local vec)     (vector-ref vec 4))
;; (define-inline (dbr:dbstruct-set-local! vec val)(vector-set! vec 4 val))
;; 
;; ;; get a rundb vector, create it if not already existing
;; (define (dbr:dbstruct-get-rundb-rec vec run-id)
;;   (let* ((dbhash (dbr:dbstruct-get-dbhash vec))              ;; get the runs hash
;; 	 (runvec (hash-table-ref/default dbhash run-id #f))) ;; get the vector for run-id
;;     (if (vector? runvec)
;; 	runvec ;;           rundb inmemdb last-mod last-read last-sync in-use refdb
;; 	(let ((nvec  (vector #f      #f       -1       -1       -1       #f     #f)))
;; 	  (hash-table-set! dbhash run-id nvec)
;; 	  nvec))))
;; 
;; ;;  [ rundb inmemdb last-mod last-read last-sync ]
;; (define-inline (dbr:dbstruct-field-name->num field-name)
;;   (case field-name
;;     ((rundb) 0) ;; the on-disk db
;;     ((inmem) 1) ;; the in-memory db
;;     ((mtime) 2) ;; last modification time
;;     ((rtime) 3) ;; last read time
;;     ((stime) 4) ;; last sync time
;;     ((inuse) 5) ;; is the db currently in use, #t yes, #f no.
;;     ((refdb) 6) ;; the db used for reference (can be on disk or inmem)
;;     (else -1)))
;; 
;; ;; get/set rundb fields
;; (define (dbr:dbstruct-get-runvec-val vec run-id field-name)
;;   (let ((runvec   (dbr:dbstruct-get-rundb-rec vec run-id))
;; 	(fieldnum (dbr:dbstruct-field-name->num field-name)))
;;     ;; (vector-set! runvec (dbr:dbstruct-field-name->num 'inuse) #t)
;;     (vector-ref runvec fieldnum)))
;; 
;; (define (dbr:dbstruct-set-runvec-val! vec run-id field-name val)
;;   (let ((runvec (dbr:dbstruct-get-rundb-rec vec run-id)))
;;     (vector-set! runvec (dbr:dbstruct-field-name->num field-name) val)))
;; 
;; ;; get/set inmemdb
;; (define (dbr:dbstruct-get-inmemdb vec run-id)
;;   (let ((runvec (dbr:dbstruct-get-rundb-rec vec run-id)))
;;     (vector-ref runvec 1)))
;; 
;; (define (dbr:dbstruct-set-inmemdb! vec run-id inmemdb)
;;   (let ((runvec (dbr:dbstruct-get-rundb-rec vec run-id)))
;;     (vector-set! runvec 1 inmemdb)))


(define (make-db:test)(make-vector 20))
(define-inline (db:test-get-id           vec) (vector-ref vec 0))
(define-inline (db:test-get-run_id       vec) (vector-ref vec 1))
(define-inline (db:test-get-testname     vec) (vector-ref vec 2))
(define-inline (db:test-get-state        vec) (vector-ref vec 3))
(define-inline (db:test-get-status       vec) (vector-ref vec 4))
︙

This page was generated in about 0.103s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00