Megatest

Check-in [80dc29f269]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added ability to make in-mem db be on disk for debugging
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 80dc29f269136dd04e459bcf27bef82a1df0c655
User & Date: matt on 2013-11-11 06:07:19
Other Links: manifest | tags
Context
2013-11-11
08:22
Added missing file check-in: f1ab91987a user: matt tags: trunk
06:07
Added ability to make in-mem db be on disk for debugging check-in: 80dc29f269 user: matt tags: trunk
2013-11-10
23:28
few more calls converted to api check-in: ece438fcbd user: matt tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [1b301b64a8] to [1e1638bb1a].

︙
87
88
89
90
91
92
93







94
95


96
97
98
99
100
101
102

87
88
89
90
91
92
93
94
95
96
97
98
99
100


101
102
103
104
105
106
107
108
109








+
+
+
+
+
+
+
-
-
+
+








    (if (not dbexists)
	(db:initialize db))
    ;; Moving db:set-sync to a call in run.scm - it is a persistent value and only needs to be set once
    ;; (db:set-sync db)
    db))

(define (open-in-mem-db)
  (let* ((path   (configf:lookup *configdat* "setup" "tmpdb"))
	 (fname  (if path (conc path "/temp-megatest.db")))
	 (exists (and path (file-exists? fname)))
	 (db     (if path
		     (begin
		       (create-directory path #t)
		       (sqlite3:open-database fname))
  (let ((db (sqlite3:open-database ":memory:")))
    (db:initialize db)
		     (sqlite3:open-database ":memory:"))))
    (if (not exists) (db:initialize db))
    db))

(define (db:sync-to fromdb todb)
  ;; strategy
  ;;  1. Get all run-ids
  ;;  2. For each run-id 
  ;;     a. Sync that run in a transaction
︙
110
111
112
113
114
115
116
117
118


119
120
121
122
123
124
125
126



127
128
129
130
131
132
133

117
118
119
120
121
122
123


124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143








-
-
+
+








+
+
+








     (lambda (run-id)
       (let ((tdats     (db:get-all-tests-info-by-run-id fromdb run-id)))
	 ;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id)
	 (for-each
	  (lambda (tdat) ;; iterate over tests
	    (let ((test-id (vector-ref tdat 0)))
	      (sqlite3:with-transaction
	       todb
	       (lambda ()
	        todb
	        (lambda ()
		 (let ((curr-tdat #f))
		   (sqlite3:for-each-row
		    (lambda (a . b)
		      (set! curr-tdat (apply vector a b)))
		    tgetstmt
		    test-id)
		   (if (not (equal? curr-tdat tdat)) ;; something changed
		       (begin
			 (debug:print 0 "  test-id: " test-id
				      "\ncurr-tdat: " curr-tdat
				      "\n     tdat: " tdat)
			 (apply sqlite3:execute tputstmt (vector->list tdat))
			 (set! trecchgd (+ trecchgd 1)))))))))
	  tdats)))
     run-ids)
    (sqlite3:finalize! tgetstmt)
    (sqlite3:finalize! tputstmt)
    (if (> trecchgd 0)(debug:print 0 "sync'd " trecchgd " changed records in tests table"))
︙
158
159
160
161
162
163
164



165
166
167
168
169
170






171
172
173
174
175
176
177

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








+
+
+





-
+
+
+
+
+
+








	      (sqlite3:for-each-row 
	       (lambda (a . b)
		 (set! curr-rdat (apply vector a b)))
	       rgetstmt
	       run-id)
	      (if (not (equal? curr-rdat rdat))
		  (begin
		    (debug:print 0 "   run-id: " run-id
				 "\ncurr-rdat: " curr-rdat
				 "\n     rdat: " rdat)
		    (set! rrecchgd (+ rrecchgd 1))
		    (apply sqlite3:execute rputstmt (vector->list rdat))))))
	  rdats)))
      (sqlite3:finalize! rgetstmt)
      (sqlite3:finalize! rputstmt)
      (if (> rrecchgd 0)(debug:print 0 "sync'd " rrecchgd " changed records in runs table")))))
      (if (> rrecchgd 0)(debug:print 0 "synced " rrecchgd " changed records in runs  table"))
      (if (> trecchgd 0)(debug:print 0 "synced " trecchgd " changed records in tests table"))
      )))

(define (db:sync-back)
  (db:sync-to *inmemdb* *db*))

;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling  proc idb . params)
  (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (if (or *db-write-access*
	  (not (member proc *db:all-write-procs*)))
      (let* ((db   (cond
︙
245
246
247
248
249
250
251
252
253
254
255
256
257






258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284




















285
286
287
288
289
290
291

263
264
265
266
267
268
269






270
271
272
273
274
275
276
277
278
279
280
281
282




















283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309








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







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








    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));")
    (for-each (lambda (key)
		(sqlite3:execute db "INSERT INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT"))
	      keys)
    (sqlite3:execute db (conc 
			 "CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, " 
			 fieldstr (if havekeys "," "")
			 "runname TEXT,"
			 "state TEXT DEFAULT '',"
			 "status TEXT DEFAULT '',"
			 "owner TEXT DEFAULT '',"
			 "event_time TIMESTAMP,"
			 "comment TEXT DEFAULT '',"
			 "runname    TEXT DEFAULT 'norun',"
			 "state      TEXT DEFAULT '',"
			 "status     TEXT DEFAULT '',"
			 "owner      TEXT DEFAULT '',"
			 "event_time TIMESTAMP DEFAULT (strftime('%s','now')),"
			 "comment    TEXT DEFAULT '',"
			 "fail_count INTEGER DEFAULT 0,"
			 "pass_count INTEGER DEFAULT 0,"
			 "CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));"))
    (sqlite3:execute db (conc "CREATE INDEX runs_index ON runs (runname" (if havekeys "," "") keystr ");"))
    (sqlite3:execute db 
		     "CREATE TABLE IF NOT EXISTS tests 
                    (id INTEGER PRIMARY KEY,
                     run_id     INTEGER,
                     testname   TEXT,
                     host       TEXT DEFAULT 'n/a',
                     cpuload    REAL DEFAULT -1,
                     diskfree   INTEGER DEFAULT -1,
                     uname      TEXT DEFAULT 'n/a', 
                     rundir     TEXT DEFAULT 'n/a',
                     shortdir   TEXT DEFAULT '',
                     item_path  TEXT DEFAULT '',
                     state      TEXT DEFAULT 'NOT_STARTED',
                     status     TEXT DEFAULT 'FAIL',
                     attemptnum INTEGER DEFAULT 0,
                     final_logf TEXT DEFAULT 'logs/final.log',
                     logdat     BLOB, 
                     run_duration INTEGER DEFAULT 0,
                     comment    TEXT DEFAULT '',
                     event_time TIMESTAMP,
                     fail_count INTEGER DEFAULT 0,
                     pass_count INTEGER DEFAULT 0,
                     archived   INTEGER DEFAULT 0, -- 0=no, 1=in progress, 2=yes
                     run_id       INTEGER   DEFAULT -1,
                     testname     TEXT      DEFAULT 'noname',
                     host         TEXT      DEFAULT 'n/a',
                     cpuload      REAL      DEFAULT -1,
                     diskfree     INTEGER   DEFAULT -1,
                     uname        TEXT      DEFAULT 'n/a', 
                     rundir       TEXT      DEFAULT 'n/a',
                     shortdir     TEXT      DEFAULT '',
                     item_path    TEXT      DEFAULT '',
                     state        TEXT      DEFAULT 'NOT_STARTED',
                     status       TEXT      DEFAULT 'FAIL',
                     attemptnum   INTEGER   DEFAULT 0,
                     final_logf   TEXT      DEFAULT 'logs/final.log',
                     logdat       TEXT      DEFAULT '', 
                     run_duration INTEGER   DEFAULT 0,
                     comment      TEXT      DEFAULT '',
                     event_time   TIMESTAMP DEFAULT (strftime('%s','now')),
                     fail_count   INTEGER   DEFAULT 0,
                     pass_count   INTEGER   DEFAULT 0,
                     archived     INTEGER   DEFAULT 0, -- 0=no, 1=in progress, 2=yes
                     CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path)
          );")
    (sqlite3:execute db "CREATE INDEX tests_index ON tests (run_id, testname, item_path);")
    (sqlite3:execute db "CREATE VIEW runs_tests AS SELECT * FROM runs INNER JOIN tests ON runs.id=tests.run_id;")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_steps 
                              (id INTEGER PRIMARY KEY,
                               test_id INTEGER,
︙

Modified tests/simplerun/megatest.config from [4fdc96f0ee] to [81ccddf872]. 

1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15








+








[fields]
SYSTEM TEXT
RELEASE TEXT

[setup]
# Adjust max_concurrent_jobs to limit how much you load your machines
max_concurrent_jobs 50
tmpdb /tmp

# This is your link path, you can move it but it is generally better to keep it stable
linktree #{shell readlink -f #{getenv PWD}/../simplelinks}

# Valid values for state and status for steps, NB// It is not recommended you use this
[validvalues]
state start end completed
︙

Modified tests/unittests/server.scm from [34b89d1e39] to [6efd00f121]. 

1
2
3
4
5
6
7
8
9
10


11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40











+
+




















-
+








;;======================================================================
;; S E R V E R
;;======================================================================

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

(set! *transport-type* 'http)

(test "open inmem db"          1  (begin (open-in-mem-db) 1))

(test "setup for run" #t (begin (setup-for-run)
				(string? (getenv "MT_RUN_AREA_HOME"))))

(test "server-register, get-best-server" #t (let ((res #f))
					      (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 100 'live 'http)
					      (set! res (open-run-close tasks:get-best-server tasks:open-db))
					      (number? (vector-ref res 3))))

(test "de-register server" #f (let ((res #f))
				(open-run-close tasks:server-deregister tasks:open-db "bob" port: 1234)
				(vector? (open-run-close tasks:get-best-server tasks:open-db))))

(define server-pid #f)

;; Not sure how the following should work, replacing it with system of megatest -server
;; (test "launch server" #t (let ((pid (process-fork (lambda ()
;; 						    ;; (daemon:ize)
;; 						    (server:launch 'http)))))
;; 			   (set! server-pid pid)
;; 			   (number? pid)))
(system "megatest -server - &")
(system "megatest -server - -debug 22&")

(thread-sleep! 3) ;; need to wait for server to start. Yes, a better way is needed.
(test "get-best-server" #t (begin 
			     (client:launch)
			     (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
			       (vector? dat))))
︙
46
47
48
49
50
51
52




53
54
55
56
57
58
59

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65








+
+
+
+








(test "get run info"  "firstrun"  (let ((rinfo (rmt:get-run-info 1)))
				    (vector-ref (vector-ref rinfo 1) 3)))
(test "get tests (no data)" '()   (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f))
(test "register test"       #t    (rmt:general-call 'register-test 1 "test1" ""))
(test "get tests (some data)"  1  (length (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f)))
(test "get test id"            1  (rmt:get-test-id 1 "test1" ""))

(test "get test id from main"  1  (db:get-test-id *db* 1 "test1" ""))


;; (test "sync back"              #t (begin (rmt:sync-back) #t))

;;======================================================================
;; D B
;;======================================================================

(test #f '(#t "exit process started") (cdb:kill-server *runremote* #f)) ;; *toppath* *my-client-signature* #f)))

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