Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -623,10 +623,11 @@ (loop))) (if (common:low-noise-print 30) (debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*))))))) (define (std-exit-procedure) + (let ((no-hurry (if *time-to-exit* ;; hurry up #f (begin (set! *time-to-exit* #t) #t)))) @@ -651,10 +652,19 @@ (thread-sleep! 5) ;; give the clean up few seconds to do it's stuff (thread-sleep! 2)) (debug:print 4 *default-log-port* " ... done") ) "clean exit"))) + + ;; let's try to clean up open sockets + (if *runremote* + (case (remote-transport *runremote*) + ((http) (close-all-connections!)) + ((rpc) (rpc:close-all-connections!)) + (else + (debug:print-info 0 *default-log-port* "Transport "(remote-transport *runremote*)" not supported")))) + (thread-start! th1) (thread-start! th2) (thread-join! th1)))) (define (std-signal-handler signum) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -1982,11 +1982,10 @@ ;;====================================================================== ;; Exit and clean up ;;====================================================================== -(if (and *runremote* (eq? 'http (remote-transport *runremote*))) (close-all-connections!)) ;; for http-client (if (not *didsomething*) (debug:print 0 *default-log-port* help)) (set! *time-to-exit* #t)