Megatest

Diff
Login

Differences From Artifact [49d251d815]:

To Artifact [cafb82815a]:


1224
1225
1226
1227
1228
1229
1230
1231

1232
1233
1234
1235
1236
1237
1238
1224
1225
1226
1227
1228
1229
1230

1231
1232
1233
1234
1235
1236
1237
1238







-
+







                                    THEN 'PASS'
                                    ELSE status
                                    END WHERE id=?;")
	'(test-set-log            "UPDATE tests SET final_logf=? WHERE id=?;")
	'(test-set-rundir-by-test-id "UPDATE tests SET rundir=? WHERE id=?")
	'(test-set-rundir         "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;")
	'(delete-tests-in-state   "DELETE FROM tests WHERE state=? AND run_id=?;")
	'(tests:test-set-toplog    "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
	'(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))
1252
1253
1254
1255
1256
1257
1258

1259

1260
1261

1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272

1273
1274
1275
1276
1277
1278
1279
1252
1253
1254
1255
1256
1257
1258
1259

1260

1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281







+
-
+
-

+











+







				      (< (cdb:packet-get-qtime a)(cdb:packet-get-qtime b))))))
       (if (> (length data) 0)
	   (debug:print-info 4 "Writing cached data " data))

       ;; prepare the needed statements, do each only once
       (for-each (lambda (request-item)
		   (let ((stmt-key (cdb:packet-get-qtype request-item)))
		     (debug:print-info 11 "stmt-key=" stmt-key ", request-item=" request-item)
		     (if (and (not (hash-table-ref/default queries stmt-key #f))
		     (if (not (hash-table-ref/default queries stmt-key #f))
			      (not (member stmt-key db:special-queries)))
			 (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)
				   (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)
	 (if special-qry

	     ;; handle a query that cannot be part of the grouped queries
	     (let* ((stmt-key       (cdb:packet-get-qtype special-qry))
		    (return-address (cdb:packet-get-client-sig special-qry))
		    (qry            (hash-table-ref/default queries stmt-key #f))
		    (params         (cdb:packet-get-params special-qry)))
1324
1325
1326
1327
1328
1329
1330

1331

1332
1333
1334
1335
1336
1337
1338
1326
1327
1328
1329
1330
1331
1332
1333

1334
1335
1336
1337
1338
1339
1340
1341







+
-
+







			   (if (null? stmts)
			       stmts
			       (let innerloop ((hed (car stmts))
					       (tal (cdr stmts)))
				 (let ((params         (cdb:packet-get-params hed))
				       (return-address (cdb:packet-get-client-sig hed))
				       (stmt-key       (cdb:packet-get-qtype hed)))
				   (if (or (not (hash-table-ref/default queries stmt-key #f))
				   (if (member stmt-key db:special-queries)
					   (member stmt-key db:special-queries))
				       (begin
					 (debug:print-info 11 "Handling special statement " stmt-key)
					 (cons hed tal))
				       (begin
					 (debug:print-info 11 "Executing " stmt-key " for " params)
					 (apply sqlite3:execute (hash-table-ref queries stmt-key) params)
					 (server:reply pubsock return-address #t)