Megatest

Check-in [c91f937011]
Login
Overview
Comment:test4 now passing in zmq server mode
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | switch-to-zmq
Files: files | file ages | folders
SHA1: c91f937011631ae488687904263046816d0062f3
User & Date: matt on 2012-10-24 00:08:07
Other Links: branch diff | manifest | tags
Context
2012-10-24
07:02
Fix to kill check-in: 85a1288370 user: matt tags: switch-to-zmq
00:08
test4 now passing in zmq server mode check-in: c91f937011 user: matt tags: switch-to-zmq
2012-10-23
22:49
zmq mostly working... check-in: 7cb1bd5c46 user: matt tags: switch-to-zmq
Changes

Modified common_records.scm from [676b1d8a73] to [9ac4a598ab].

54
55
56
57
58
59
60
61
62


63
64
65
66
67
68
69
54
55
56
57
58
59
60


61
62
63
64
65
66
67
68
69







-
-
+
+







	  (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)
	  (let ((res #f));; (format#format #f "INFO:~2d ~a" n (apply conc params))))
	    (apply print "INFO: (" n ") " params) ;; 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 db.scm from [bee7518912] to [f9d64d5f5d].

67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81







-
+







    (if (not dbexists)
	(db:initialize db))
    (db:set-sync db)
    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, idb=" idb ", params=" params)
  (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (let* ((db   (if idb idb (open-db)))
	 (res #f))
    (set! res (apply proc db params))
    (if (not idb)(sqlite3:finalize! db))
    (debug:print-info 11 "open-run-close-no-exception-handling END" )
    res))

1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172

1173
1174
1175
1176
1177
1178
1179
1152
1153
1154
1155
1156
1157
1158

1159

1160
1161
1162
1163
1164
1165
1166
1167
1168
1169

1170
1171
1172
1173
1174
1175
1176
1177







-

-










-
+







(define (db:obj->string obj)(with-output-to-string (lambda ()(serialize obj))))
(define (db:string->obj msg)(with-input-from-string msg (lambda ()(deserialize))))

(define (cdb:client-call zmq-socket . params)
  (debug:print-info 11 "cdb:client-call zmq-socket=" zmq-socket " params=" params)
  (let ((zdat (db:obj->string params)) ;; (with-output-to-string (lambda ()(serialize params))))
	(res  #f))
    (print "cdb:client-call before send message, params=" params)
    (send-message zmq-socket zdat)
    (print "cdb:client-call after send message")
    (set! res (db:string->obj (receive-message zmq-socket zdat)))
    (debug:print-info 11 "zmq-socket " (car params) " res=" res)
    res))
  
(define (cdb:test-set-status-state zmqsocket test-id status state msg)
  (if msg
      (cdb:client-call zmqsocket 'state-status-msg #t state status msg test-id)
      (cdb:client-call zmqsocket 'state-status #t state status test-id))) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) 

(define (cdb:test-rollup-test_data-pass-fail zmqsocket test-id)
  (cdb:client-call zmqsocket 'test_data-pf-rollup #t test-id test-id test-id))
  (cdb:client-call zmqsocket 'test_data-pf-rollup #t test-id test-id test-id test-id))

(define (cdb:pass-fail-counts zmqsocket test-id fail-count pass-count)
  (cdb:client-call zmqsocket 'pass-fail-counts #t fail-count pass-count test-id))

(define (cdb:tests-register-test zmqsocket run-id test-name item-path)
  (let ((item-paths (if (equal? item-path "")
			(list item-path)
1409
1410
1411
1412
1413
1414
1415
1416

1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428
1429
1430
1407
1408
1409
1410
1411
1412
1413

1414
1415
1416
1417
1418
1419
1420

1421
1422
1423
1424
1425
1426
1427
1428







-
+






-
+







	   tdb 
	   "SELECT (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail') AS fail_count,
                   (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') AS pass_count;"
	   test-id test-id)
	  (sqlite3:finalize! tdb)

	  ;; Now rollup the counts to the central megatest.db
	  (cdb:pass-fail-counts *remoterun* test-id fail-count pass-count)
	  (cdb:pass-fail-counts *runremote* 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! 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.
	  (cdb:test-rollup-test_data-pass-fail *remoterun* test-id)
	  (cdb:test-rollup-test_data-pass-fail *runremote* 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 
          ;;                THEN 'FAIL'
          ;;             WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 AND 
          ;;                  (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL')

Modified server.scm from [8eaeed198f] to [3324d285ea].

24
25
26
27
28
29
30
31

32
33
34
35



36
37
38
39
40
41
42
24
25
26
27
28
29
30

31
32
33


34
35
36
37
38
39
40
41
42
43







-
+


-
-
+
+
+







(include "db_records.scm")

(define (server:run hostn)
  (debug:print 0 "Attempting to start the server ...")
  (let ((host:port      (open-run-close db:get-var #f "SERVER"))) ;; do whe already have a server running?
    (if host:port 
	(begin
	  (debug:print 0 "ERROR: server already running.")
	  (debug:print 0 "WARNING: server already running.")
	  (if (server:client-setup)
	      (begin 
		(debug:print-info 0 "Server is alive, exiting")
		(exit))
		(debug:print-info 0 "Server is alive, not starting another")
		;;(exit)
		)
	      (begin
		(debug:print-info 0 "Server is dead, removing flag and trying again")
		(open-run-close db:del-var #f "SERVER")
		(server:run hostn))))
	(let* ((zmq-socket     #f)
	       (hostname       (if (string=? "-" hostn)
				   (get-host-name)