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

  (if (client:setup run-id)
      (debug:print-info 2 "connected as client")
      (begin
	(debug:print 0 "ERROR: Failed to connect as client")
	(exit))))








|
>






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/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

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







|







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 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
			    (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.")
			    (thread-sleep! 5) ;; give the clean up few seconds to do it's stuff
			    (debug:print 0 "       Done.")
			    (exit 4))
			  "exit on ^C timer")))
    (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")







|


|
|







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

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







>
|







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*)))))
     "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"))