Megatest

Check-in [73998460e8]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Changed rpc info messages to level 12, added debug to test4 invocation of server, added option to run server in conjunction with -runall or -runtests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 73998460e8902c4e94f5684410d056044fbd2aea
User & Date: mrwellan on 2012-10-19 17:02:27
Other Links: manifest | tags
Context
2012-10-20
19:22
Added zmq to the install check-in: 23fa12cb70 user: matt tags: trunk
2012-10-19
17:02
Changed rpc info messages to level 12, added debug to test4 invocation of server, added option to run server in conjunction with -runall or -runtests check-in: 73998460e8 user: mrwellan tags: trunk
2012-10-18
23:50
Added instrumentation to many database access routines check-in: 333996fd2f user: matt tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common_records.scm from [973da57ab3] to [676b1d8a73].

︙
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

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








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



+
-
-
-
+
+
+



+
+
-
-
-
+
+
+







      #t))

(define (debug:debug-mode n)
  (or (and (number? *verbosity*)
	   (<= n *verbosity*))
      (and (list? *verbosity*)
	   (member n *verbosity*))))

(define (debug:setup)
  (let ((debugstr (or (args:get-arg "-debug")
		      (getenv "MT_DEBUG_MODE"))))
    (set! *verbosity* (debug:calc-verbosity debugstr))
    (debug:check-verbosity *verbosity* debugstr)
    (if (or (args:get-arg "-debug")
	    (not (getenv "MT_DEBUG_MODE")))
	(setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
				    (string-intersperse (map conc *verbosity*) ",")
				    (conc *verbosity*))))))
  

(define (debug:print n . params)
  (if (debug:debug-mode n)
      (with-output-to-port (current-error-port)
      (begin
	(apply print params)
	(if *logging* (apply db:log-event params)))))
	(lambda ()
	  (apply print params)
	  (if *logging* (apply db:log-event params))))))

(define (debug:print-info n . params)
  (if (debug:debug-mode n)
      (with-output-to-port (current-error-port)
	(lambda ()
      (let ((res (format#format #f "INFO:~2d ~a" n (apply conc params))))
	(print res)
	(if *logging* (db:log-event res)))))
	  (let ((res (format#format #f "INFO:~2d ~a" n (apply conc params))))
	    (print res)
	    (if *logging* (db:log-event res)))))))

;; if a value is printable (i.e. string or number) return the value
;; else return an empty string
(define-inline (printable val)
  (if (or (number? val)(string? val)) val ""))

Modified dashboard.scm from [b4841769fb] to [86466a3427].

︙
112
113
114
115
116
117
118
119
120

121
122
123
124
125
126
127

112
113
114
115
116
117
118


119
120
121
122
123
124
125
126








-
-
+








(define *delayed-update* 0)

(define *db-file-path* (conc *toppath* "/megatest.db"))

(define *tests-sort-reverse* #f)
(define *hide-empty-runs* #f)

(set! *verbosity* (debug:calc-verbosity (args:get-arg "-debug")))
(debug:check-verbosity *verbosity* (args:get-arg "-debug"))
(debug:setup)

(define uidat #f)

(define-inline (dboard:uidat-get-keycol  vec)(vector-ref vec 0))
(define-inline (dboard:uidat-get-lftcol  vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header  vec)(vector-ref vec 2))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))
︙

Modified db.scm from [8c633b99ea] to [9e27b746af].

︙
242
243
244
245
246
247
248
249

250
251
252
253
254
255
256

242
243
244
245
246
247
248

249
250
251
252
253
254
255
256








-
+








	     (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					       (string->number (args:get-arg "-override-timeout"))
					       136000))))
	(sqlite3:set-busy-handler! db handler)
	(if (not dbexists)
	    (begin
	      (sqlite3:execute db "PRAGMA synchronous = FULL;")
	      (debug:print 0 "Initialized test database " dbpath)
	      (debug:print-info 11 "Initialized test database " dbpath)
	      (db:testdb-initialize db)))
	;; (sqlite3:execute db "PRAGMA synchronous = 0;")
	(debug:print-info 11 "open-test-db END (sucessful)" testpath)
	db)
      (begin
	(debug:print-info 11 "open-test-db END (unsucessful)" testpath)
	#f)))
︙
316
317
318
319
320
321
322
323

324
325
326
327
328
329
330

331
332
333
334
335
336
337

316
317
318
319
320
321
322

323
324
325
326
327
328
329

330
331
332
333
334
335
336
337








-
+






-
+








	 (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"))
					   136000)))) ;; 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 "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT,pwd TEXT,cmdline TEXT,pid INTEGER);")
	  (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:execute db "INSERT INTO log (logline,pwd,cmdline,pid) VALUES (?,?,?,?);" logline (current-directory)(string-intersperse (argv) " ")(current-process-id))
    (sqlite3:finalize! db)
    logline))

;;======================================================================
;; TODO:
;;   put deltas into an assoc list with version numbers
;;   apply all from last to current
︙
1392
1393
1394
1395
1396
1397
1398
1399

1400
1401
1402
1403
1404
1405
1406

1392
1393
1394
1395
1396
1397
1398

1399
1400
1401
1402
1403
1404
1405
1406








-
+








	  (sqlite3:finalize! tdb)

	  ;; Now rollup the counts to the central megatest.db
	  (rdb:pass-fail-counts test-id fail-count pass-count)
	  ;; (sqlite3:execute db "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;" 
	  ;;                     fail-count pass-count test-id)

	  (thread-sleep! 10) ;; play nice with the queue by ensuring the rollup is at least 10s later than the set
	  (thread-sleep! 1) ;; play nice with the queue by ensuring the rollup is at least 10ms later than the set
	  
	  ;; if the test is not FAIL then set status based on the fail and pass counts.
	  (rdb:test-rollup-test_data-pass-fail test-id)
	  ;; (sqlite3:execute
	  ;;  db   ;;; NOTE: Should this be WARN,FAIL? A WARN is not a FAIL????? BUG FIXME
	  ;;  "UPDATE tests
          ;;             SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0
︙

Modified megatest.scm from [396f3db966] to [55e970d9c0].

︙
210
211
212
213
214
215
216
217
218

219
220
221
222
223
224
225

210
211
212
213
214
215
216


217
218
219
220
221
222
223
224








-
-
+









(define *didsomething* #f)

;;======================================================================
;; Misc setup stuff
;;======================================================================

(set! *verbosity* (debug:calc-verbosity (args:get-arg "-debug")))
(debug:check-verbosity *verbosity* (args:get-arg "-debug"))
(debug:setup)

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

(if (debug:debug-mode 3) ;; we are obviously debugging
    (set! open-run-close open-run-close-no-exception-handling))

;; a,b,c % => a/%,b/%,c/%
︙

Modified server.scm from [3e6e2a05fc] to [8e5d903894].

︙
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

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








-
+






-
+





-
+





-
+





-
+





-
+








	  ;;======================================================================
	  ;; db specials here
	  ;;======================================================================
	  ;; remote call to open-run-close
	  (rpc:publish-procedure!
	   'rdb:open-run-close 
	   (lambda (procname . remargs)
	     (debug:print-info 4 "Remote call of rdb:open-run-close " procname " " remargs)
	     (debug:print-info 12 "Remote call of rdb:open-run-close " procname " " remargs)
	     (set! *last-db-access* (current-seconds))
	     (apply open-run-close (eval procname) remargs)))
	  
	  (rpc:publish-procedure!
	   'cdb:test-set-status-state
	   (lambda (test-id status state msg)
	     (debug:print-info 4 "Remote call of cdb:test-set-status-state test-id=" test-id ", status=" status ", state=" state ", msg=" msg)
	     (debug:print-info 12 "Remote call of cdb:test-set-status-state test-id=" test-id ", status=" status ", state=" state ", msg=" msg)
	     (cdb:test-set-status-state test-id status state msg)))

	  (rpc:publish-procedure!
	   'cdb:test-rollup-test_data-pass-fail
	   (lambda (test-id)
	     (debug:print-info 4 "Remote call of cdb:test-rollup-test_data-pass-fail " test-id)
	     (debug:print-info 12 "Remote call of cdb:test-rollup-test_data-pass-fail " test-id)
	     (cdb:test-rollup-test_data-pass-fail test-id)))

	  (rpc:publish-procedure!
	   'cdb:pass-fail-counts
	   (lambda (test-id fail-count pass-count)
	     (debug:print-info 4 "Remote call of cdb:pass-fail-counts " test-id " passes: " pass-count " fails: " fail-count)
	     (debug:print-info 12 "Remote call of cdb:pass-fail-counts " test-id " passes: " pass-count " fails: " fail-count)
	     (cdb:pass-fail-counts test-id fail-count pass-count)))

	  (rpc:publish-procedure!
	   'cdb:tests-register-test
	   (lambda (db run-id test-name item-path)
	     (debug:print-info 4 "Remote call of cdb:tests-register-test " run-id " testname: " test-name " item-path: " item-path)
	     (debug:print-info 12 "Remote call of cdb:tests-register-test " run-id " testname: " test-name " item-path: " item-path)
	     (cdb:tests-register-test db run-id test-name item-path)))

	  (rpc:publish-procedure!
	   'cdb:flush-queue
	   (lambda ()
	     (debug:print-info 4 "Remote call of cdb:flush-queue")
	     (debug:print-info 12 "Remote call of cdb:flush-queue")
	     (cdb:flush-queue)))

	  ;;======================================================================
	  ;; end of publish-procedure section
	  ;;======================================================================

	  (set! *rpc:listener* rpc:listener)
︙

Modified tests/Makefile from [5cba9a6467] to [bb4cf1d0a1].

︙
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50

36
37
38
39
40
41
42

43
44
45
46
47
48
49
50








-
+








	sleep 40;cd fullrun;megatest -target ubuntu/nfs/none :runname $(RUNNAME) -set-state-status COMPLETED,FORCED :state COMPLETED :status PASS -testpatt ez_p%s,runfirst/ -debug $(DEBUG) $(LOGGING)


test3 : fullprep
	cd fullrun;$(MEGATEST) -runtests runfirst -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b  $(SERVER) -debug 10

test4 : fullprep
	cd fullrun;$(MEGATEST) $(SERVER) $(LOGGING)&
	cd fullrun;$(MEGATEST) $(SERVER) $(LOGGING) -debug $(DEBUG) &
	cd fullrun;sleep 5;$(MEGATEST) -debug $(DEBUG) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(LOGGING)

# NOTE: Only one instance can be a server
test5 : fullprep
	cd fullrun;$(MEGATEST) $(SERVER) $(LOGGING) &
	cd fullrun;sleep 10;$(MEGATEST) -runall $(TARGET) :runname $(RUNNAME)_aa -debug $(DEBUG) $(LOGGING) > aa.log 2> aa.log &
	cd fullrun;sleep 10;$(MEGATEST) -runall $(TARGET) :runname $(RUNNAME)_ab -debug $(DEBUG) $(LOGGING) > ab.log 2> ab.log &
︙

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