Megatest

Changes On Branch sqlite3-logging
Login

Changes In Branch sqlite3-logging Excluding Merge-Ins

This is equivalent to a diff from 6bba674f33 to 7bd6b6dae6

2013-01-29
10:15
Merged multi-transport to trunk, all tests passed check-in: 19f85b577e user: mrwellan tags: trunk
2013-01-27
13:14
Creating branch for multi transport options, http, rpc, zmq, and network fs check-in: 66763d5399 user: matt tags: multi-transport
13:11
merged trunk into sqlite3-logging Closed-Leaf check-in: 7bd6b6dae6 user: matt tags: sqlite3-logging
12:22
Merged http-transport to trunk check-in: 6bba674f33 user: matt tags: trunk
12:17
Merged zmq-3.2.2 to trunk check-in: 3be673e9be user: matt tags: trunk
10:04
Streamlined db access a little, test4 completes in reasonable time Closed-Leaf check-in: a893c641ca user: matt tags: http-transport
2013-01-20
00:02
Unknown work check-in: b0a0d0377c user: matt tags: sqlite3-logging

Modified common.scm from [1ba863b641] to [66b72bf51b].

60
61
62
63
64
65
66




67
68
69
70
71
72
73
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77







+
+
+
+







(define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
(define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
(define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
(define *test-info*         (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db

(define *run-info-cache*    (make-hash-table)) ;; run info is stable, no need to reget

;; Debugging stuff
(define *verbosity*         1)
(define *logging*           #f)

;; Awful. Please FIXME
(define *env-vars-by-run-id* (make-hash-table))
(define *current-run-name*   #f)

(define (common:clear-caches)
  (set! *target*             (make-hash-table))
  (set! *keys*               (make-hash-table))

Modified db.scm from [4a4c4c2fc7] to [a80b195e32].

230
231
232
233
234
235
236




237
238
239
240
241
242
243
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247







+
+
+
+







    (debug:print-info 11 "db:initialize END")
    ))

;;======================================================================
;; T E S T   S P E C I F I C   D B 
;;======================================================================

;;======================================================================
;; T E S T   S P E C I F I C   D B 
;;======================================================================

;; Create the sqlite db for the individual test(s)
(define (open-test-db testpath) 
  (debug:print-info 11 "open-test-db " testpath)
  (if (and testpath 
	   (directory? testpath)
	   (file-read-access? testpath))
      (let* ((dbpath    (conc testpath "/testdat.db"))
337
338
339
340
341
342
343

























344
345
346
347
348
349
350
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379







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







    (db:log-event logline pwd cmdline pid)))

(define (db:log-event logline pwd cmdline pid)
  (let ((db (open-logging-db)))
    (sqlite3:execute db "INSERT INTO log (logline,pwd,cmdline,pid) VALUES (?,?,?,?);" logline (current-directory)(string-intersperse (argv) " ")(current-process-id))
    (sqlite3:finalize! db)
    logline))

;;======================================================================
;; L O G G I N G    D B 
;;======================================================================

(define (open-logging-db) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((dbpath    (conc (if *toppath* (conc *toppath* "/") "") "logging.db")) ;; fname)
	 (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)))) ;; 136000)))
    (sqlite3:set-busy-handler! db handler)
    (if (not dbexists)
	(begin
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT);")
	  (sqlite3:execute db (conc "PRAGMA synchronous = 0;"))))
    db))

(define (db:log-event . loglst)
  (let ((db      (open-logging-db))
	(logline (apply conc loglst)))
    (sqlite3:execute db "INSERT INTO log (logline) VALUES (?);" logline)
    (sqlite3:finalize! db)
    logline))

;;======================================================================
;; TODO:
;;   put deltas into an assoc list with version numbers
;;   apply all from last to current
;;======================================================================
(define (patch-db db)

Modified megatest.scm from [d00ef9a849] to [89b02975ac].

97
98
99
100
101
102
103


104
105
106
107
108
109
110
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112







+
+







  -env2file fname         : write the environment to fname.csh and fname.sh
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname
  -list-servers            : list the servers 
  -repl                   : start a repl (useful for extending megatest)
  -debug N                : increase verbosity to N. (try 10 for lots of noise)
  -logging                : turn on logging all debug output to logging.db

Spreadsheet generation
  -extract-ods fname.ods  : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
                            if it contains forward slashes the path will be converted
                            to windows style
202
203
204
205
206
207
208

209
210
211
212
213
214
215
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218







+







			"-rollup"
			"-update-meta"
			"-gen-megatest-area"

			"-logging"
			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only
			"-logging"
		       )
		 args:arg-hash
		 0))

(if (args:get-arg "-h")
    (begin
      (print help)
253
254
255
256
257
258
259


260
261
262
263
264
265
266
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271







+
+







      ;; (debug:print 0 "    old: " old-testpatt ", new: " (args:get-arg "-testpatt"))
      (if (args:get-arg "-runtests")
	  (begin
	    ;; (debug:print 0 "NOTE: Also modifying -runtests")
	    (hash-table-set! args:arg-hash "-runtests" (tack-on-patt (args:get-arg "-runtests")
								     (args:get-arg "-itempatt")))))
      ))

(if (args:get-arg "-logging")(set! *logging* #t))

;;======================================================================
;; Misc general calls
;;======================================================================

(if (args:get-arg "-env2file")
    (begin

Modified server.scm from [12f5deda72] to [78dbb4bb4d].

30
31
32
33
34
35
36

37
38
39
40
41
42
43
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44







+







(define (server:make-server-url hostport)
  (if (not hostport)
      #f
      (conc "http://" (car hostport) ":" (cadr hostport))))

(define  *server-loop-heart-beat* (current-seconds))
(define *heartbeat-mutex* (make-mutex))
	  (debug:print 0 "Server started on " host:port)

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

;; Call this to start the actual server
;;