153 lines
5.2 KiB
Racket
153 lines
5.2 KiB
Racket
#lang racket/base
|
|
(require framework/preferences
|
|
racket/format
|
|
rackunit
|
|
racket/contract)
|
|
|
|
;(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)
|
|
|
|
(define the-prefs-table (make-hash))
|
|
(parameterize ([preferences:low-level-put-preferences
|
|
(λ (syms vals)
|
|
(for ([sym (in-list syms)]
|
|
[val (in-list vals)])
|
|
(hash-set! the-prefs-table sym val)))]
|
|
[preferences:low-level-get-preference
|
|
(λ (sym [fail void])
|
|
(hash-ref the-prefs-table sym fail))])
|
|
|
|
(check-exn
|
|
exn:unknown-preference?
|
|
(λ ()
|
|
(preferences:get pref-sym)))
|
|
|
|
(check-equal?
|
|
(begin
|
|
(preferences:set-default pref-sym 'passed symbol?)
|
|
(preferences:get pref-sym))
|
|
'passed)
|
|
|
|
(check-equal?
|
|
(begin (preferences:set pref-sym 'new-pref)
|
|
(preferences:get pref-sym))
|
|
'new-pref)
|
|
|
|
(check-true (preferences:default-set? pref-sym))
|
|
(check-false (preferences:default-set? 'unknown-preference))
|
|
(check-false (begin
|
|
(preferences:add-callback 'pref-with-only-callback-set void)
|
|
(preferences:default-set? 'pref-with-only-callback-set)))
|
|
|
|
(check-equal?
|
|
(begin (preferences:set-default marshalling-pref-sym (lambda () 'the-answer) procedure?)
|
|
(preferences:set-un/marshall marshalling-pref-sym
|
|
(lambda (f) (f))
|
|
(lambda (v) (lambda () v)))
|
|
(begin0 ((preferences:get marshalling-pref-sym))
|
|
(preferences:set marshalling-pref-sym (lambda () 2))))
|
|
'the-answer)
|
|
|
|
(check-equal? ((preferences:get marshalling-pref-sym)) 2)
|
|
|
|
;; make sure the preference actually got "written out"
|
|
(check-equal? (hash-ref the-prefs-table
|
|
(string->symbol (~a "plt:framework-pref:" pref-sym)))
|
|
'new-pref)
|
|
|
|
(let ()
|
|
(preferences:set-default 'unmarshalling-enumerate-test '() (listof exact-nonnegative-integer?))
|
|
(preferences:set-un/marshall 'unmarshalling-enumerate-test
|
|
(λ (lon) (~s lon))
|
|
(λ (s) (read (open-input-string s))))
|
|
|
|
;; simulate a value having been saved from some prior run of the preferences library
|
|
(hash-set! the-prefs-table 'plt:framework-pref:unmarshalling-enumerate-test
|
|
(~s '(1 2 3 4 5)))
|
|
|
|
(check-equal? (preferences:get 'unmarshalling-enumerate-test) '(1 2 3 4 5)))
|
|
|
|
(check-equal?
|
|
(let ([x 1])
|
|
(preferences:set-default default-test-sym 'default symbol?)
|
|
(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)
|
|
2)
|
|
|
|
(check-equal?
|
|
(let ([x 1])
|
|
(define remove-it (preferences:add-callback 'callback-before-delete (λ (a b) (set! x (+ x 1)))))
|
|
(preferences:set-default 'callback-before-delete 'default symbol?)
|
|
(preferences:set 'callback-before-delete 'xyz)
|
|
(remove-it)
|
|
(preferences:set 'callback-before-delete 'pdq)
|
|
x)
|
|
2)
|
|
|
|
(check-equal?
|
|
(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)
|
|
2)
|
|
|
|
(check-equal?
|
|
(let ([x 1])
|
|
(define f (λ (a b) (set! x (+ x 1))))
|
|
(unless (zero? (random 1)) (set! f 'not-a-proc))
|
|
(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)
|
|
3)
|
|
|
|
(check-equal?
|
|
(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)
|
|
(let loop ([n 10])
|
|
(cond
|
|
[(not (weak-box-value wb)) #t]
|
|
[(zero? n) 'f-still-alive]
|
|
[else
|
|
(collect-garbage)
|
|
(loop (- n 1))]))
|
|
(preferences:set default-test-sym 'xyz)
|
|
(remove-it)
|
|
(preferences:set default-test-sym 'pdq)
|
|
x)
|
|
1)
|
|
|
|
(let ()
|
|
(hash-set! the-prefs-table
|
|
'plt:framework-pref:preferences-aliases-test:1
|
|
"1")
|
|
(preferences:set-default 'preferences-aliases-test
|
|
0
|
|
exact-nonnegative-integer?
|
|
#:aliases '(preferences-aliases-test:1)
|
|
#:rewrite-aliases (list (λ (v) (read (open-input-string v)))))
|
|
(check-equal? (preferences:get 'preferences-aliases-test) 1))
|
|
|
|
|
|
(let ()
|
|
(preferences:set-default 'snapshot-test 0 number?)
|
|
(preferences:set 'snapshot-test 11)
|
|
(define snap (preferences:get-prefs-snapshot))
|
|
(preferences:set 'snapshot-test 12)
|
|
(preferences:restore-prefs-snapshot snap)
|
|
(check-equal? (preferences:get 'snapshot-test) 11)))
|