www

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

test-after.rkt (3252B)


      1 #lang typed/racket
      2 
      3 (require typed-struct-props
      4          typed/rackunit)
      5 
      6 (define globl1 : (U #f foo1) #f)
      7 
      8 (struct/props foo1 ([f : Number] [g : String]) #:transparent
      9               #:property prop:custom-write
     10               (λ (this out mode)
     11                 (set! globl1 (struct-copy foo1 this [g "bbb"]))
     12                 (write "dummy" out)))
     13 
     14 (check-equal? (let ([f (foo1 0 "ggg")])
     15                 (check-false globl1)
     16                 (format "~a" f)
     17                 (check-not-false globl1)
     18                 (let ([gl globl1])
     19                   (if gl
     20                       (foo1-g gl)
     21                       'wrong)))
     22               "bbb")
     23 
     24 (define globl2q1 : (U #f foo2) #f)
     25 (define globl2q2 : (U #f foo2) #f)
     26 (define globl2h1 : (U #f foo2) #f)
     27 (define globl2h2 : (U #f foo2) #f)
     28 
     29 (struct/props foo2 ([f : Number] [g : String]) #:transparent
     30               #:property prop:equal+hash
     31               (list (λ (a b recur)
     32                       (when (foo2? a)
     33                         (set! globl2q1 (struct-copy foo2 a [g "bbb-q1"])))
     34                       (when (foo2? b)
     35                         (set! globl2q2 (struct-copy foo2 b [g "bbb-q2"])))
     36                       #f)
     37                     (λ (a recur)
     38                       (set! globl2h1 (struct-copy foo2 a [g "bbb-h1"]))
     39                       0)
     40                     (λ (a recur)
     41                       (set! globl2h2 (struct-copy foo2 a [g "bbb-h2"]))
     42                       0)))
     43 
     44 (check-equal? (let ([f1 (foo2 0 "ggg")]
     45                     [f2 (foo2 1 "hhh")])
     46                 (check-false globl2q1)
     47                 (check-false globl2q2)
     48                 (check-false globl2h1)
     49                 (check-false globl2h2)
     50                 (equal? f1 f2)
     51                 (check-not-false globl2q1)
     52                 (check-not-false globl2q2)
     53                 (check-false globl2h1)
     54                 (check-false globl2h2)
     55                 (let ([gl1 globl2q1]
     56                       [gl2 globl2q2])
     57                   (cons (if gl1 (cons (foo2-f gl1) (foo2-g gl1)) 'wrong)
     58                         (if gl2 (cons (foo2-f gl2) (foo2-g gl2)) 'wrong))))
     59               '((0 . "bbb-q1")
     60                 .
     61                 (1 . "bbb-q2")))
     62 
     63 (set! globl2q1 #f)
     64 (set! globl2q2 #f)
     65 
     66 (check-equal? (let ([f (foo2 0 "ggg")])
     67                 (check-false globl2q1)
     68                 (check-false globl2q2)
     69                 (check-false globl2h1)
     70                 (check-false globl2h2)
     71                 (equal-hash-code f)
     72                 (check-false globl2q1)
     73                 (check-false globl2q2)
     74                 (check-not-false globl2h1)
     75                 (check-false globl2h2)
     76                 (let ([gl globl2h1])
     77                   (if gl (foo2-g gl) 'wrong)))
     78               "bbb-h1")
     79 
     80 (set! globl2h1 #f)
     81 
     82 (check-equal? (let ([f (foo2 0 "ggg")])
     83                 (check-false globl2q1)
     84                 (check-false globl2q2)
     85                 (check-false globl2h1)
     86                 (check-false globl2h2)
     87                 (equal-secondary-hash-code f)
     88                 (check-false globl2q1)
     89                 (check-false globl2q2)
     90                 (check-false globl2h1)
     91                 (check-not-false globl2h2)
     92                 (let ([gl globl2h2])
     93                   (if gl (foo2-g gl) 'wrong)))
     94               "bbb-h2")