test-write+equal+hash-poly.rkt (1549B)
1 #lang typed/racket 2 3 (require typed-struct-props 4 typed/rackunit) 5 6 (struct/props (A) foo ([f : A]) #:transparent 7 #:property prop:custom-write 8 (λ (this out mode) 9 (fprintf out "#<an-instance ~a>" (foo-f this))) 10 #:property prop:equal+hash 11 (list (λ (a b rec) #f) 12 (λ (a rec) 42) 13 (λ (a rec) 43))) 14 15 (struct/props (A) bar ([f : A]) #:transparent 16 #:property prop:custom-write 17 (λ (this out mode) 18 (fprintf out "#<bar-instance ~a>" (bar-f this)))) 19 20 (test-not-exn "The structure's constructor and type work properly" 21 (λ () (ann (foo "b") (foo String)))) 22 23 (test-equal? "The structure's constructor and accessor work properly" 24 (ann (foo-f (foo "b")) String) 25 "b") 26 27 (test-equal? "The prop:custom-write is taken into account" 28 (format "~a" (foo 1)) 29 "#<an-instance 1>") 30 31 (test-begin 32 (test-false "The equal? function supplied to #:equal+hash is used" 33 (equal? (foo 0) (foo 0))) 34 35 (test-true "When unspecified, the default implementation of equal? is used" 36 (equal? (bar 0) (bar 0)))) 37 38 (test-equal? "The equal-hash-code function supplied to #:equal+hash is used" 39 (equal-hash-code (foo "d")) 40 (equal-hash-code (foo "e"))) 41 42 (test-equal? 43 "The equal-secondary hash-code function supplied to #:equal+hash is used" 44 (equal-secondary-hash-code (foo 'f)) 45 (equal-secondary-hash-code (foo 'g)))