Megatest

Check-in [b47fdd6750]
Login
Overview
Comment:Getting there
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | inmem-per-run-db
Files: files | file ages | folders
SHA1: b47fdd6750f8d665a6cb56f2fd7c6310e425278f
User & Date: matt on 2013-11-25 23:58:38
Other Links: branch diff | manifest | tags
Context
2013-11-26
21:53
Inching along ... check-in: 84d0a58461 user: matt tags: inmem-per-run-db
2013-11-25
23:58
Getting there check-in: b47fdd6750 user: matt tags: inmem-per-run-db
23:02
Merged in fix for -list-runs not respecting -target, minor edits to dbstruct handling check-in: f2108ba85f user: matt tags: inmem-per-run-db
Changes

Modified api.scm from [ddd21ae4b1] to [e11745624f].

63
64
65
66
67
68
69

70
71




72
73
74
75
76
77
78
63
64
65
66
67
68
69
70


71
72
73
74
75
76
77
78
79
80
81







+
-
-
+
+
+
+







    ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
    ((csv->test-data)               (apply db:csv->test-data dbstruct params))
    ((get-steps-data)               (apply db:get-steps-data dbstruct params))

    ;; MISC
    ((login)                        (apply db:login dbstruct params))
    ((general-call)                 (let ((stmtname   (car params))
					  (run-id     (cadr params))
					  (realparams (cdr params)))
				      (db:general-call dbstruct stmtname realparams)))
					  (realparams (cddr params)))
				      (db:with-db dbstruct run-id #t ;; these are all for modifying the db
						  (lambda (db)
						    (db:general-call db stmtname realparams)))))
    ((sync-inmem->db)               (db:sync-back))
    ((kill-server)
     (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*)  ;; (db:sync-to *inmemdb* *db*)
     (let ((hostname (car  *runremote*))
	   (port     (cadr *runremote*))
	   (pid      (if (null? params) #f (car params)))
	   (th1      (make-thread (lambda ()(thread-sleep! 3)(debug:print 0 "Server exiting!")(exit 0)) "Server exit thread")))

Modified dashboard.scm from [093ab7bea8] to [d77fd2a401].

1217
1218
1219
1220
1221
1222
1223
1224

1225
1226
1227
1228
1229
1230
1231
1217
1218
1219
1220
1221
1222
1223

1224
1225
1226
1227
1228
1229
1230
1231







-
+







	      (let ((hideit (iup:button "HideTests" #:action (lambda (obj)
							       (set! *hide-not-hide* (not *hide-not-hide*))
							       (iup:attribute-set! obj "TITLE" (if *hide-not-hide* "HideTests" "NotHide"))
							       (mark-for-update)))))
		(set! *hide-not-hide-button* hideit)
		hideit))
	     (iup:hbox
	      (iup:button "Quit"      #:action (lambda (obj)(if *db* (sqlite3:finalize! *db*))(exit)))
	      (iup:button "Quit"      #:action (lambda (obj)(if *db* (db:close-all *db*))(exit)))
	      (iup:button "Refresh"   #:action (lambda (obj)
						 (mark-for-update)))
	      (iup:button "Collapse"  #:action (lambda (obj)
						 (let ((myname (iup:attribute obj "TITLE")))
						   (if (equal? myname "Collapse")
						       (begin
							 (for-each (lambda (tname)
1488
1489
1490
1491
1492
1493
1494
1495

1496
1497
1498
1499
1500
1501
1502
1488
1489
1490
1491
1492
1493
1494

1495
1496
1497
1498
1499
1500
1501
1502







-
+







(cond 
 ((args:get-arg "-run")
  (let ((runid (string->number (args:get-arg "-run"))))
    (if runid
	(begin
	  (lambda (x)
	    (on-exit (lambda ()
		       (if *db* (sqlite3:finalize! *db*))))
		       (if *db* (db:close-all *db*))))
	    (examine-run *db* runid)))
	(begin
	  (print "ERROR: runid is not a number " (args:get-arg "-run"))
	  (exit 1)))))
 ((args:get-arg "-test")
  (let ((testid (string->number (args:get-arg "-test"))))
    (if (and (number? testid)
1523
1524
1525
1526
1527
1528
1529
1530

1523
1524
1525
1526
1527
1528
1529

1530







-
+
			     (dashboard:run-update x)
			     (mutex-lock! *update-mutex*)
			     (set! *update-is-running* #f)
			     (mutex-unlock! *update-mutex*))))
		       1))))

(iup:main-loop)
(sqlite3:finalize! *db*)
(db:close-all *db*)

Modified db.scm from [8131c38c5f] to [72d96a4409].

119
120
121
122
123
124
125
126

127
128
129
130
131
132
133
119
120
121
122
123
124
125

126
127
128
129
130
131
132
133







-
+







	       (handler      (make-busy-timeout 136000)))
	  (if (and dbexists (not write-access))
	      (set! *db-write-access* #f)) ;; only unset so other db's also can use this control
	  (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))
	  (if (not dbexists)(db:initialize-run-id-db db))
	  (dbr:dbstruct-set-runvec! dbstruct run-id 'rundb db)
	  (dbr:dbstruct-set-runvec! dbstruct run-id 'inuse #t)
	  (if local
	      db
	      (begin
		(dbr:dbstruct-set-runvec! dbstruct run-id 'inmem inmem)
		(db:sync-tables db:sync-tests-only db inmem)
184
185
186
187
188
189
190
191

192
193
194
195
196
197
198
184
185
186
187
188
189
190

191
192
193
194
195
196
197
198







-
+







	   (sqlite3:finalize! rundb)
	   (debug:print 0 "WARNING: attempting to close databases but got " rundb " instead of a database"))))
   (hash-table-values (vector-ref dbstruct 1))))

(define (open-inmem-db)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler   (make-busy-timeout 3600)))
    (db:initialize db)
    (db:initialize-run-id-db 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-tests-only
468
469
470
471
472
473
474
475

476
477
478
479
480
481
482
468
469
470
471
472
473
474

475
476
477
478
479
480
481
482







-
+







    (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" "MEGATEST_VERSION" megatest-version)
    (debug:print-info 11 "db:initialize END")))

;;======================================================================
;; R U N   S P E C I F I C   D B 
;;======================================================================

(define (db:initialize-run-id-db db run-id)
(define (db:initialize-run-id-db db)
  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tests 
                    (id INTEGER PRIMARY KEY,
                     run_id       INTEGER   DEFAULT -1,
                     testname     TEXT      DEFAULT 'noname',
                     host         TEXT      DEFAULT 'n/a',
                     cpuload      REAL      DEFAULT -1,
                     diskfree     INTEGER   DEFAULT -1,

Modified db_records.scm from [315cdf30c2] to [7073c723c6].

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







-
-
-
+
+
+













-
+








;; get a rundb vector
(define (dbr:dbstruct-get-rundb-rec vec run-id)
  (let* ((dbhash (vector-ref vec 1))
	 (runvec (hash-table-ref/default dbhash run-id #f)))
    (if runvec
	runvec
	(begin
	  (hash-table-set! dbhash run-id (vector #f #f -1 -1 -1 #f))
	  (dbr:dbstruct-get-rundb-rec vec run-id)))))
	(let ((nvec  (vector #f #f -1 -1 -1 #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
    (else -1)))

;; get/set rundb fields
(define (dbr:dbstruct-get-runrec vec run-id field-name)
(define (dbr:dbstruct-get-runvec 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! vec run-id field-name val)
  (let ((runvec (dbr:dbstruct-get-rundb-rec vec run-id)))

Modified http-transport.scm from [eef5519839] to [8511ea36d9].

429
430
431
432
433
434
435
436

437
438
439
440
441
442
443
429
430
431
432
433
434
435

436
437
438
439
440
441
442
443







-
+







    (let loop ((count 0))
      ;; Use this opportunity to sync the inmemdb to db
      (let ((start-time (current-milliseconds))
	    (sync-time  #f)
	    (rem-time   #f))
	(if *inmemdb* (db:sync-touched *inmemdb*))
	(set! sync-time  (- (current-milliseconds) start-time))
	(debug:print 0 "SYNC: time= " sync-time)
	;; (debug:print 0 "SYNC: time= " sync-time)
	(set! rem-time (quotient (- 4000 sync-time) 1000))
	(if (and (< rem-time 4)
		 (> rem-time 0))
	    (thread-sleep! rem-time)))

      ;; (thread-sleep! 4) ;; no need to do this very often

Modified rmt.scm from [dd6d85038e] to [5a1394abda].

79
80
81
82
83
84
85


86
87


88
89
90
91
92
93
94
79
80
81
82
83
84
85
86
87


88
89
90
91
92
93
94
95
96







+
+
-
-
+
+







(define (rmt:login)
  (rmt:send-receive 'login (list *toppath* megatest-version *my-client-signature*)))

(define (rmt:kill-server)
  (rmt:send-receive 'kill-server '()))

;; hand off a call to one of the db:queries statements
;; added run-id to make looking up the correct db possible 
;;
(define (rmt:general-call stmtname . params)
  (rmt:send-receive 'general-call (append (list stmtname) params)))
(define (rmt:general-call stmtname run-id . params)
  (rmt:send-receive 'general-call (append (list stmtname run-id) params)))

(define (rmt:sync-inmem->db)
  (rmt:send-receive 'sync-inmem->db '()))

;;======================================================================
;;  K E Y S 
;;======================================================================

Added tests/unittests/dbrdbstruct.scm version [c136b1e628].






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
;;======================================================================
;; S E R V E R
;;======================================================================

;; Run like this:
;;
;;  (cd ..;make && make install) && ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)

(test #f #t                 (vector? (make-dbr:dbstruct "/tmp")))

(define dbstruct (make-dbr:dbstruct "/tmp"))

(test #f #t                 (begin (dbr:dbstruct-set-main! dbstruct "blah") #t))
(test #f "blah"             (dbr:dbstruct-get-main  dbstruct))
(test #f #t                 (vector? (dbr:dbstruct-get-rundb-rec dbstruct 1)))

(for-each
 (lambda (k)
   (test #f #t                 (begin (dbr:dbstruct-set-runvec! dbstruct 1 k (conc k)) #t))
   (test #f k                  (dbr:dbstruct-get-runvec dbstruct 1 k)))
 '(rundb inmem mtime rtime stime inuse))