Megatest

Check-in [ec49837f01]
Login
Overview
Comment:Still trying to get watchdog, on-exit and signal/int or signal/term working gracefully
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: ec49837f010711a8a9c28fbf52ab1081c17dbee6
User & Date: matt on 2015-05-26 23:40:02
Other Links: branch diff | manifest | tags
Context
2015-05-27
05:36
More cleanup on exit handling. Exit on ^Z check-in: 824cbc749e user: matt tags: v1.60
2015-05-26
23:40
Still trying to get watchdog, on-exit and signal/int or signal/term working gracefully check-in: ec49837f01 user: matt tags: v1.60
23:07
Moved watchdog timer exit message check-in: 1ab7fff8bf user: matt tags: v1.60
Changes

Modified client.scm from [ae90ed41bd] to [56bcfe26a8].

234
235
236
237
238
239
240
241


242
243
244
245
246
247
234
235
236
237
238
239
240

241
242
243
244
245
246
247
248







-
+
+






     (thread-join! th2))))

;; client:launch
;; Need to set the signal handler somewhere other than here as this
;; routine will go away.
;;
(define (client:launch run-id)
  (set-signal-handler! signal/int client:signal-handler)
  (set-signal-handler! signal/int  client:signal-handler)
  (set-signal-handler! signal/term client:signal-handler)
  (if (client:setup run-id)
      (debug:print-info 2 "connected as client")
      (begin
	(debug:print 0 "ERROR: Failed to connect as client")
	(exit))))

Modified common.scm from [a861c03ed0] to [2dd389ebcc].

242
243
244
245
246
247
248
249

250
251
252
253
254
255
256
242
243
244
245
246
247
248

249
250
251
252
253
254
255
256







-
+








;;======================================================================
;; E X I T   H A N D L I N G
;;======================================================================

(define (std-exit-procedure)
  (set! *time-to-exit* #t)
  (debug:print-info 0 "starting exit process, finalizing databases.")
  (debug:print-info 4 "starting exit process, finalizing databases.")
  (if (debug:debug-mode 18)
      (rmt:print-db-stats))
  (let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds
			    (let ((run-ids (hash-table-keys *db-local-sync*)))
			      (if (and (not (null? run-ids))
				       (configf:lookup *configdat* "setup" "megatest-db"))
				  (db:multi-db-sync run-ids 'new2old)))
265
266
267
268
269
270
271
272

273
274
275
276


277
278
279
280
281
282
283
265
266
267
268
269
270
271

272
273
274


275
276
277
278
279
280
281
282
283







-
+


-
-
+
+







			    (if *task-db*     (let ((db (cdr *task-db*)))
						(if (sqlite3:database? db)
						    (begin
						      (sqlite3:interrupt! db)
						      (sqlite3:finalize! db #t)
						      (vector-set! *task-db* 0 #f)))))) "Cleanup db exit thread"))
	(th2 (make-thread (lambda ()
			    (debug:print 0 "ERROR: Received ^C, attempting clean exit. Please be patient and wait a few seconds before hitting ^C again.")
			    (debug:print 4 "Attempting clean exit. Please be patient and wait a few seconds...")
			    (thread-sleep! 5) ;; give the clean up few seconds to do it's stuff
			    (debug:print 0 "       Done.")
			    (exit 4))
			  "exit on ^C timer")))
			    (exit))
			  "clean exit")))
    (thread-start! th2)
    (thread-start! th1)
    (thread-join! th2)))

(define (std-signal-handler signum)
  ;; (signal-mask! signum)
  (debug:print 0 "ERROR: Received signal " signum " exiting promptly")

Modified megatest.scm from [0fff055d69] to [134d7dd741].

350
351
352
353
354
355
356

357

358
359
360
361
362
363
364
350
351
352
353
354
355
356
357

358
359
360
361
362
363
364
365







+
-
+







		 (let delay-loop ((count 0))
		   (if (and (not *time-to-exit*)
			    (< count 11)) ;; aprox 5-6 seconds
		       (begin
			 (thread-sleep! 1)
			 (delay-loop (+ count 1))))
		   (loop)))
	     (if (common:low-noise-print 30)
	     (debug:print-info 0 "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*))))
		 (debug:print-info 0 "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*)))))
     "Watchdog thread")))

(thread-start! *watchdog*)

(if (args:get-arg "-log")
    (let ((oup (open-output-file (args:get-arg "-log"))))
      (debug:print-info 0 "Sending log output to " (args:get-arg "-log"))