Megatest

Diff
Login

Differences From Artifact [cafb82815a]:

To Artifact [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