[plt-scheme] register-finalizer wills only executed first time program is Run in DrScheme session

On Tue, May 26, 2009 at 10:09 AM, Neil Van Dyke <neil at neilvandyke.org> wrote:
> I have implemented some code using "scheme/foreign" that uses
> "register-finalizer" to clean up some resources.

I suggest using different mechanisms to ensure your database
connections are never left open. I have never had much success with
wills.

1. Use a with-database-connection type function/macro that uses
dynamic-wind internally. This will ensure the connection is closed
unless the thread is killed

2. Monitor for thread killed events, and close any open connections
used by that thread on this event.

Of course you don't have to write any this code. Snooze includes 1
(call-with-connection), YC has written a kill-safe proxy for spgsql
[thread title: dynamic-wind & kill-thread], and I have included some
code demonstrating 2 below.

N.


#lang scheme/base

(require scheme/file
         scheme/match
         (only-in srfi/1 lset-adjoin lset-difference))

;; struct monitor-message : thread input-port
(define-struct monitor-message (thread port))

(define (register-port-with-monitor port)
  (thread-send monitor-thread
               (make-monitor-message (current-thread) port)))

;; This thread monitors the file eating threads, and when is
;; killed it closes the handle
(define monitor-thread
  (thread
   (lambda ()
     (let ([receive-evt (thread-receive-evt)]
           ;; (hashof thread-dead (list port))
           [ports-table (make-hash)])
       (let loop ([events (list receive-evt)])
         (let ([evt (apply sync events)])
           (cond
            ;; We have a new port to register
            [(eq? receive-evt evt)
             (match (thread-receive)
                    [(struct monitor-message (thread port))
                     (let ([dead-evt (thread-dead-evt thread)])
                       (hash-update! ports-table
                                     dead-evt
                                     (lambda (ports) (cons port ports))
                                     null)
                       (loop (lset-adjoin eq? events dead-evt)))]
                    [err
                     (printf
                      "monitor-thread received message ~a which it
cannot handle.\n"
                      err)
                     (loop events)])]

            ;; A thread has been killed
            [else
             ;; Find all the ports and close them
             (let ([ports (hash-ref ports-table evt)])
               (printf "Closing ~a\n" ports)
               (for-each close-input-port ports))
             ;; Remove this dead-evt from the events we monitor
             (loop (lset-difference eq? events (list evt)))])))))))


;;; Test code

;; ( -> input-port)
(define (eat-file)
  (open-input-file (make-temporary-file)))

(define (make-file-eating-thread chan)
  (thread
   (lambda ()
     (let ([p (eat-file)])
       (register-port-with-monitor p)
       ;; Notify that we've registered the thread
       (channel-put chan #t)
       ;; Block forever
       (sync (current-thread))))))

(define ready-chan (make-channel))

;; Eat lots of files!
;;
;; This should not complain that too many files handles are open
(for ([i (in-range 10000)])
     (when (zero? (modulo i 100))
       (printf "Iteration ~a\n" i))
     (let ([t (make-file-eating-thread ready-chan)])
       (sync ready-chan)
       (kill-thread t)))