Megatest

Check-in [b21db309a8]
Login
Overview
Comment:Added back a missing "not"
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | interleaved-queries
Files: files | file ages | folders
SHA1: b21db309a8541948aa7781f4a4dee4db6c2b6d1d
User & Date: matt on 2012-11-19 19:43:19
Other Links: branch diff | manifest | tags
Context
2012-11-20
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
13:04
Tweaked for testing, all calls immediate check-in: 6ac20061e7 user: mrwellan tags: interleaved-queries
Changes

Modified db.scm from [49d251d815] to [cafb82815a].

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='';")
    ))

;; 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))







|







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='';")
    ))

;; 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
				      (< (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)))

		     (if (and (not (hash-table-ref/default queries stmt-key #f))
			      (not (member stmt-key db:special-queries)))
			 (let ((stmt (alist-ref stmt-key db:queries)))

			   (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))

	 (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)))







>
|
<

>











>







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 (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)
				   (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
			   (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 (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)







>
|







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))
					   (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)

Modified server.scm from [3fa467925b] to [cc206acab0].

134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
			     (loop))))))))

    ;; The heavy lifting
    ;;
    ;; make-vector-record cdb packet client-sig qtype immediate query-sig params qtime
    ;;
    (let loop ((queue-lst '()))
      (print "GOT HERE EH?")
      (let* ((rawmsg (receive-message* pull-socket))
	     (packet (db:string->obj rawmsg)))
	(debug:print-info 12 "server=> received packet=" packet)
	(if #t ;; (cdb:packet-get-immediate packet) ;; process immediately or put in queue
	    (begin
	      (db:process-queue pub-socket (cons packet queue-lst))
	      (loop '()))







<







134
135
136
137
138
139
140

141
142
143
144
145
146
147
			     (loop))))))))

    ;; The heavy lifting
    ;;
    ;; make-vector-record cdb packet client-sig qtype immediate query-sig params qtime
    ;;
    (let loop ((queue-lst '()))

      (let* ((rawmsg (receive-message* pull-socket))
	     (packet (db:string->obj rawmsg)))
	(debug:print-info 12 "server=> received packet=" packet)
	(if #t ;; (cdb:packet-get-immediate packet) ;; process immediately or put in queue
	    (begin
	      (db:process-queue pub-socket (cons packet queue-lst))
	      (loop '()))

Modified testzmq/mockupserver.scm from [5ff56c6e40] to [71a381625f].

52
53
54
55
56
57
58


59
60
61


62
63
64
65
66
67
68
    (execute db "UPDATE clients SET num_accesses=num_accesses+1 WHERE id=?;" cid)
    (set! total-db-accesses (+ total-db-accesses 1))
    ))

(define db (open-db))
;; (define queuelst '())
;; (define mx1 (make-mutex))



(define (process-queue queuelst)
  (let ((queuelen (length queuelst)))


    (for-each
     (lambda (item)
       (let ((cname (vector-ref item 1))
	     (clcmd (vector-ref item 2))
	     (cdata (vector-ref item 3)))
	 (send-message pub cname send-more: #t)
	 (send-message pub (case clcmd







>
>



>
>







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
    (execute db "UPDATE clients SET num_accesses=num_accesses+1 WHERE id=?;" cid)
    (set! total-db-accesses (+ total-db-accesses 1))
    ))

(define db (open-db))
;; (define queuelst '())
;; (define mx1 (make-mutex))

(define max-queue-len 0)

(define (process-queue queuelst)
  (let ((queuelen (length queuelst)))
    (if (> queuelen max-queue-len)
	(set! max-queue-len queuelen))
    (for-each
     (lambda (item)
       (let ((cname (vector-ref item 1))
	     (clcmd (vector-ref item 2))
	     (cdata (vector-ref item 3)))
	 (send-message pub cname send-more: #t)
	 (send-message pub (case clcmd
127
128
129
130
131
132
133
134

(thread-start! th1)
(thread-start! th2)
(thread-join! th2)

(let* ((run-time       (- (current-seconds) start-time))
       (queries/second (/  total-db-accesses run-time)))
  (print "Server exited! Total db accesses=" total-db-accesses " in " run-time " seconds for " queries/second " queries/second"))







|
131
132
133
134
135
136
137
138

(thread-start! th1)
(thread-start! th2)
(thread-join! th2)

(let* ((run-time       (- (current-seconds) start-time))
       (queries/second (/  total-db-accesses run-time)))
  (print "Server exited! Total db accesses=" total-db-accesses " in " run-time " seconds for " queries/second " queries/second with max queue length of: " max-queue-len))