diff --git a/collects/framework/preferences.rkt b/collects/framework/preferences.rkt
index a74db8edb8..4068b50f12 100644
--- a/collects/framework/preferences.rkt
+++ b/collects/framework/preferences.rkt
@@ -191,7 +191,7 @@ the state transitions / contracts are:
 (define preferences:add-callback 
   (lambda (p callback [weak? #f])
     (let ([new-cb (make-pref-callback (if weak?
-                                          (make-weak-box (impersonator-ephemeron callback))
+                                          (impersonator-ephemeron callback)
                                           callback))])
       (hash-set! callbacks
                  p 
@@ -215,27 +215,28 @@ the state transitions / contracts are:
 
 ;; check-callbacks : sym val -> void
 (define (check-callbacks p value)
-  (let ([new-callbacks
-         (let loop ([callbacks (hash-ref callbacks p '())])
-           (cond
-             [(null? callbacks) null]
-             [else 
-              (let* ([callback (car callbacks)]
-                     [cb (pref-callback-cb callback)])
-                (cond
-                  [(weak-box? cb)
-                   (let ([v (weak-box-value cb)])
-                     (if v
-                         (begin 
-                           (v p value)
-                           (cons callback (loop (cdr callbacks))))
-                         (loop (cdr callbacks))))]
-                  [else
-                   (cb p value)
-                   (cons callback (loop (cdr callbacks)))]))]))])
-    (if (null? new-callbacks)
-        (hash-remove! callbacks p)
-        (hash-set! callbacks p new-callbacks))))
+  (define new-callbacks
+    (let loop ([callbacks (hash-ref callbacks p '())])
+      (cond
+        [(null? callbacks) null]
+        [else 
+         (define callback (car callbacks))
+         (define cb (pref-callback-cb callback))
+         (cond
+           [(ephemeron? cb)
+            (define v (ephemeron-value cb))
+            (cond
+              [v
+               (v p value)
+               (cons callback (loop (cdr callbacks)))]
+              [else
+               (loop (cdr callbacks))])]
+           [else
+            (cb p value)
+            (cons callback (loop (cdr callbacks)))])])))
+  (if (null? new-callbacks)
+      (hash-remove! callbacks p)
+      (hash-set! callbacks p new-callbacks)))
 
 (define (preferences:set-un/marshall p marshall unmarshall)
   (cond
diff --git a/collects/tests/framework/prefs.rkt b/collects/tests/framework/prefs.rkt
index 1313604361..e3a4dd6b3d 100644
--- a/collects/tests/framework/prefs.rkt
+++ b/collects/tests/framework/prefs.rkt
@@ -1,7 +1,7 @@
 #lang racket/base
 (require "test-suite-utils.rkt")
   
-  (define ((check-eq? x) y) (eq? x y))
+  (define ((check-equal? x) y) (equal? x y))
   (define pref-sym 'plt:not-a-real-preference)
   (define marshalling-pref-sym 'plt:not-a-real-preference-marshalling)
   (define default-test-sym 'plt:not-a-real-preference-default-test)
@@ -10,22 +10,22 @@
   
   (test
    'preference-unbound
-   (check-eq? 'passed)
+   (check-equal? 'passed)
    `(with-handlers ([exn:unknown-preference?
                      (lambda (x)
                        'passed)])
       (preferences:get ',pref-sym)))
   (test 'preference-set-default/get
-        (check-eq? 'passed)
+        (check-equal? 'passed)
         `(begin (preferences:set-default ',pref-sym 'passed symbol?)
                 (preferences:get ',pref-sym)))
   (test 'preference-set/get
-        (check-eq? 'new-pref)
+        (check-equal? 'new-pref)
         `(begin (preferences:set ',pref-sym 'new-pref)
                 (preferences:get ',pref-sym)))
 
   (test 'preference-marshalling
-        (check-eq? 'the-answer)
+        (check-equal? 'the-answer)
         `(begin (preferences:set-default ',marshalling-pref-sym (lambda () 'the-answer) procedure?)
                 (preferences:set-un/marshall ',marshalling-pref-sym
                                              (lambda (f) (f))
@@ -34,7 +34,7 @@
                         (preferences:set ',marshalling-pref-sym (lambda () 2)))))
   (shutdown-mred)
   (test 'preference-marshalling
-        (check-eq? 2)
+        (check-equal? 2)
         `(begin (preferences:set-default ',marshalling-pref-sym (lambda () 'the-answer) procedure?)
                 (preferences:set-un/marshall ',marshalling-pref-sym
                                              (lambda (f) (f))
@@ -52,27 +52,80 @@
                                (yield (make-semaphore 0)))))
   
   (test 'preference-get-after-restart
-        (check-eq? 'new-pref)
+        (check-equal? 'new-pref)
         `(begin (preferences:set-default ',pref-sym 'passed symbol?)
                 (preferences:get ',pref-sym)))
 
   (test 'preference-no-set-default-stage1
-        (check-eq? 'stage1)
+        (check-equal? 'stage1)
         `(begin (preferences:set-default ',default-test-sym 'default symbol?)
                 (preferences:set ',default-test-sym 'new-value)
                 'stage1))
   (shutdown-mred)
   (test 'preference-no-set-default-stage2
-        (check-eq? 'stage2)
+        (check-equal? 'stage2)
         `(begin 'stage2))
   (shutdown-mred)
   (test 'preference-no-set-default-stage3
-        (check-eq? 'new-value)
+        (check-equal? 'new-value)
         `(begin (preferences:set-default ',default-test-sym 'default symbol?)
                 (preferences:get ',default-test-sym)))
   
+  (test 'preference-add-callback
+        (check-equal? 2)
+        `(begin 
+           (let ([x 1])
+             (define remove-it (preferences:add-callback ',default-test-sym (λ (a b) (set! x (+ x 1)))))
+             (preferences:set ',default-test-sym 'xyz)
+             (remove-it)
+             (preferences:set ',default-test-sym 'pdq)
+             x)))
+  
+  (test 'preference-add-weak-callback
+        (check-equal? 2)
+        `(begin 
+           (let ([x 1])
+             (define f (λ (a b) (set! x (+ x 1))))
+             (define remove-it (preferences:add-callback ',default-test-sym f #t))
+             (preferences:set ',default-test-sym 'xyz)
+             (remove-it)
+             (preferences:set ',default-test-sym 'pdq)
+             x)))
+  
+  (test 'preference-add-weak-callback2
+        (check-equal? 3)
+        `(begin 
+           (let ([x 1])
+             (define f (λ (a b) (set! x (+ x 1))))
+             (unless (zero? (random 1)) (set! f 'not-a-proc)) ;; try to stop inlining
+             (define remove-it (preferences:add-callback ',default-test-sym f #t))
+             (collect-garbage) (collect-garbage) (collect-garbage)
+             (preferences:set ',default-test-sym 'xyz)
+             (remove-it)
+             (preferences:set ',default-test-sym 'pdq)
+             (f 'a 'b)  ;; make sure safe-for-space doesn't free 'f' earlier
+             x)))
+  
+  (test 'preference-weak-callback-is-weak
+        (check-equal? #t)
+        `(begin 
+           (let ([x 1])
+             (define f (λ (a b) (set! x (+ x 1))))
+             (define wb (make-weak-box f))
+             (define remove-it (preferences:add-callback ',default-test-sym f #t))
+             (set! f #f)
+             (begin0
+               (let loop ([n 10])
+                 (cond
+                   [(not (weak-box-value wb)) #t]
+                   [(zero? n) 'f-still-alive]
+                   [else
+                    (collect-garbage)
+                    (loop (- n 1))]))
+               (remove-it)))))
+  
   (test 'dialog-appears
-        (lambda (x) (eq? 'passed x))
+        (check-equal? 'passed)
         (lambda ()
           (queue-sexp-to-mred '(begin (send (make-object frame:basic% "frame") show #t)
                                       (preferences:show-dialog)))