www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

test-child.rkt (2296B)

      1 #lang typed/racket
      2 
      3 (require typed-struct-props
      4          typed/rackunit)
      5 (define-syntax (test-not-equal? stx)
      6   (syntax-case stx ()
      7     [(_ name v1 v2)
      8      (syntax/loc stx
      9        (test-false name (equal? v1 v2)))]))
     10 
     11 (struct foo-parent ([f : Number]) #:transparent)
     12 
     13 (struct/props (A) foo foo-parent ([g : A]) #:transparent
     14               #:property prop:equal+hash (list (λ (a b rec) #f)
     15                                                (λ (a rec) 42)
     16                                                (λ (a rec) 43)))
     17 
     18 (test-not-exn "The structure's constructor and type work properly"
     19               (λ () (ann (foo 12 "b") (foo String))))
     20 
     21 (test-equal? "The structure's constructor and accessor for a field declared by
     22  the parent work properly"
     23              (ann (foo-parent-f (foo 12 "b")) Number)
     24              12)
     25 
     26 (test-equal? "The structure's constructor and accessor work properly"
     27              (ann (foo-g (foo 12 "b")) String)
     28              "b")
     29 
     30 (test-false "The equal? function supplied to #:equal+hash is used"
     31             (equal? (foo 0 "b") (foo 0 "b")))
     32   
     33 (test-equal? "The equal-hash-code function supplied to #:equal+hash is used"
     34              (equal-hash-code (foo 34 "c"))
     35              (equal-hash-code (foo 56 "d")))
     36 
     37 (test-equal?
     38  "The equal-secondary hash-code function supplied to #:equal+hash is used"
     39  (equal-secondary-hash-code (foo 78 'e))
     40  (equal-secondary-hash-code (foo 90 'f)))
     41 
     42 
     43 
     44 
     45 (test-not-exn "The parent structure's constructor and type work properly"
     46               (λ () (ann (foo-parent 12) foo-parent)
     47                 (void)))
     48 
     49 (test-equal? "The parent structure's constructor and accessor work properly"
     50              (ann (foo-parent-f (foo-parent 12)) Number)
     51              12)
     52 
     53 (test-true "The equal? function supplied to #:equal+hash is not used in the
     54  parent"
     55            (equal? (foo-parent 0) (foo-parent 0)))
     56   
     57 (test-not-equal? "The equal-hash-code function supplied to #:equal+hash is not
     58  used in the parent"
     59                  (equal-hash-code (foo-parent 34))
     60                  (equal-hash-code (foo-parent 56)))
     61 
     62 (test-not-equal? "The equal-secondary hash-code function supplied to
     63  #:equal+hash is not used in the parent"
     64                  (equal-secondary-hash-code (foo-parent 78))
     65                  (equal-secondary-hash-code (foo-parent 90)))