Megatest

Check-in [856aa4b5ec]
Login
Overview
Comment:Fixing tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | interleaved-queries
Files: files | file ages | folders
SHA1: 856aa4b5ec44b5ee69bb3917984d2551805bbc44
User & Date: matt on 2012-11-20 01:11:52
Other Links: branch diff | manifest | tags
Context
2012-11-20
07:32
(no comment) check-in: 6c9186d4af user: matt tags: interleaved-queries
01:11
Fixing tests check-in: 856aa4b5ec user: matt tags: interleaved-queries
2012-11-19
19:43
Added back a missing "not" check-in: b21db309a8 user: matt tags: interleaved-queries
Changes

Modified db.scm from [cafb82815a] to [cead3c7ecc].

1231
1232
1233
1234
1235
1236
1237
1238


1239
1240
1241
1242
1243
1244
1245
1231
1232
1233
1234
1235
1236
1237

1238
1239
1240
1241
1242
1243
1244
1245
1246







-
+
+







	'(tests:test-set-toplog   "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
    ))

;; do not run these as part of the transaction
(define db:special-queries   '(rollup-tests-pass-fail
			       db:roll-up-pass-fail-counts
                               login
                               immediate))
                               immediate
			       flush))

;; not used, intended to indicate to run in calling process
(define db:run-local-queries '()) ;; rollup-tests-pass-fail))

;; The queue is a list of vectors where the zeroth slot indicates the type of query to
;; apply and the second slot is the time of the query and the third entry is a list of 
;; values to be applied
1260
1261
1262
1263
1264
1265
1266

1267

1268
1269
1270
1271
1272
1273
1274
1261
1262
1263
1264
1265
1266
1267
1268

1269
1270
1271
1272
1273
1274
1275
1276







+
-
+







		     (if (not (hash-table-ref/default queries stmt-key #f))
			 (let ((stmt (alist-ref stmt-key db:queries)))
			   (debug:print-info 11 "stmt-key=" stmt-key ", stmt=" stmt)
			   (if stmt
			       (hash-table-set! queries stmt-key (sqlite3:prepare db (car stmt)))
			       (if (procedure? stmt-key)
				   (hash-table-set! queries stmt-key #f)
				   (if (not (member stmt-key db:special-queries))
				   (debug:print 0 "ERROR: Missing query spec for " stmt-key "!")))))))
				       (debug:print 0 "ERROR: Missing query spec for " stmt-key "!"))))))))
		 data)
       
       ;; outer loop to handle special queries that cannot be handled in the
       ;; transaction.
       (let outerloop ((special-qry #f)
		       (stmts       data))
	 (debug:print-info 11 "special-qry=" special-qry ", stmts=" stmts)
1309
1310
1311
1312
1313
1314
1315


1316
1317
1318
1319
1320
1321
1322
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326







+
+







			      (client-key   (caddr params)))
			  (if (and (equal? calling-path *toppath*)
				   (equal? megatest-version calling-vers))
			      (begin
				(hash-table-set! *logged-in-clients* client-key (current-seconds))
				(server:reply  pubsock return-address '(#t "successful login")))      ;; path matches - pass! Should vet the caller at this time ...
			      (list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*))))))
		   ((flush)
		    (server:reply pubsock return-address '(#t "sucessful flush")))
		   (else
		    (debug:print 0 "ERROR: Unrecognised queued call " qry " " params)))))
	       (if (not (null? stmts))
		   (outerloop #f stmts)))

	     ;; handle normal queries
	     (let ((rem (sqlite3:with-transaction 

Modified tests/tests.scm from [1b09dbc8f0] to [77a9ed7a49].

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







-
-
-
-
+
+
+
+
+

-
+



-
-
-
-
+
+
+
+

-
+
+
+
+

-
+




-
+





-
-







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

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

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

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

(define hostinfo #f)
(test #f #t (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
				   (set! hostinfo dat)
				   (and (string? (car dat))
					(number? (cadr dat)))))
(test "get-best-server" #t (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
			     (set! hostinfo dat) ;; host ip pullport pubport
			     (and (string? (car dat))
				  (number? (caddr dat)))))

(test #f #t (let ((zmq-socket (apply server:client-connect hostinfo)))
(test #f #t (let ((zmq-socket (server:client-connect
			       (cadr hostinfo)
			       (caddr hostinfo)
			       (cadddr hostinfo))))
	      (set! *runremote* zmq-socket)
	      (socket? *runremote*)))
	      (socket? (vector-ref *runremote* 0))))

(test #f #t (let ((res (server:client-login *runremote*)))
	      (car res)))

(test #f #t (socket? *runremote*))
(test #f #t (socket? (vector-ref *runremote* 0)))

;; (test #f #t (server:client-setup))

(test #f #t (car (cdb:login *runremote* *toppath* *my-client-signature*)))

(test #f #t (open-run-close tasks:get-best-server tasks:open-db))

;;======================================================================
;; C O N F I G   F I L E S 
;;======================================================================

(define conffile #f)
(test "Read a config" #t (hash-table? (read-config "test.config" #f #f)))
(test "Read a config that doesn't exist" #t (hash-table? (read-config "nada.config" #f #f)))