Megatest

Check-in [fac1a3d1e7]
Login
Overview
Comment:Servers will wait until no running tests before exiting
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: fac1a3d1e710d63cabcda61273559029bfe5e6ab
User & Date: matt on 2014-08-19 23:59:56
Other Links: branch diff | manifest | tags
Context
2014-08-20
00:12
Fixed logic bug in tests for server keep going check-in: 39f86ecb7a user: matt tags: v1.60
2014-08-19
23:59
Servers will wait until no running tests before exiting check-in: fac1a3d1e7 user: matt tags: v1.60
23:21
Delay opening the database until *after* the server is started check-in: 8262fac699 user: matt tags: v1.60
Changes

Modified http-transport.scm from [779f20d631] to [b22fd66de9].

390
391
392
393
394
395
396
397

398
399



400
401
402
403
404
405
406
390
391
392
393
394
395
396

397
398
399
400
401
402
403
404
405
406
407
408
409







-
+


+
+
+







      ;; Transfer *last-db-access* to last-access to use in checking that we are still alive
      (mutex-lock! *heartbeat-mutex*)
      (set! last-access *last-db-access*)
      (mutex-unlock! *heartbeat-mutex*)

      ;; (debug:print 11 "last-access=" last-access ", server-timeout=" server-timeout)
      ;;
      ;; no_traffic
      ;; no_traffic, no running tests, if server 0, no running servers
      ;;
      (if (and *server-run*
	       (or (> (db:get-count-tests-running *inmemdb* run-id) 0)
		   (and (eq? run-id 0)
			(> (tasks:num-servers-non-zero-running tdb) 0)))
	       (> (+ last-access server-timeout)
		  (current-seconds)))
	  (begin
	    (debug:print-info 0 "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
	    ;;
	    ;; Consider implementing some smarts here to re-insert the record or kill self is
	    ;; the db indicates so

Modified tasks.scm from [0cb7ba898b] to [003a5b308d].

139
140
141
142
143
144
145










146
147
148
149
150
151
152
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162







+
+
+
+
+
+
+
+
+
+







    (sqlite3:for-each-row
     (lambda (num-in-queue)
       (set! res num-in-queue))
     mdb
     "SELECT count(id) FROM servers WHERE run_id=? AND state = 'available';"
     run-id)
    res))

(define (tasks:num-servers-non-zero-running mdb)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (num-running)
       (set! res num-running))
     mdb
     "SELECT count(id) FROM servers WHERE run_id != 0 AND state = 'running';"
     run-id)
    res))

(define (tasks:server-clean-out-old-records-for-run-id mdb run-id tag)
  (sqlite3:execute mdb "UPDATE servers SET state=?,heartbeat=strftime('%s','now') WHERE state in ('available','shutting-down') AND (strftime('%s','now') - start_time) > 50 AND run_id=?;"
		   (conc "defunct" tag) run-id))

(define (tasks:server-force-clean-running-records-for-run-id mdb run-id tag)
  (sqlite3:execute mdb "UPDATE servers SET state=?,heartbeat=strftime('%s','now') WHERE state = 'running' AND run_id=?;"