www

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

meta-struct-test.rkt (2221B)

      1 #lang racket/base
      2 
      3 (require (for-syntax racket/base)
      4          phc-toolkit/meta-struct
      5          rackunit)
      6 
      7 (define-syntax (test-subtype? stx)
      8   (syntax-case stx ()
      9     [(_ sub super)
     10      #`#,(if (meta-struct-subtype? #'sub #'super)
     11              #t
     12              #f)]))
     13 
     14 (module m1 racket
     15   (struct sa ())
     16   (provide (struct-out sa)))
     17 (module m2 racket
     18   (require (submod ".." m1))
     19   (struct sb sa ())
     20   (provide (rename-out [sa sa2]))
     21   (provide (struct-out sb)))
     22 (require 'm1)
     23 (require 'm2)
     24 (struct sc sb ())
     25 
     26 (check-true (test-subtype? sa sa))
     27 (check-true (test-subtype? sa2 sa))
     28 (check-true (test-subtype? sb sa))
     29 (check-true (test-subtype? sc sa))
     30 
     31 (check-true (test-subtype? sa sa2))
     32 (check-true (test-subtype? sa2 sa2))
     33 (check-true (test-subtype? sb sa2))
     34 (check-true (test-subtype? sc sa2))
     35 
     36 (check-false (test-subtype? sa sb))
     37 (check-false (test-subtype? sa2 sb))
     38 (check-true (test-subtype? sb sb))
     39 (check-true (test-subtype? sc sb))
     40 
     41 (check-false (test-subtype? sa sc))
     42 (check-false (test-subtype? sa2 sc))
     43 (check-false (test-subtype? sb sc))
     44 (check-true (test-subtype? sc sc))
     45 
     46 
     47 
     48 
     49 
     50 (struct s (f) #:mutable)
     51 (struct t s (g))
     52 (struct u (f))
     53 (struct v u (g))
     54 (begin-for-syntax
     55   (require rackunit)
     56   (check-false (struct-type-id-is-immutable? #'s))
     57   (check-false (struct-type-id-is-immutable? #'t))
     58   (check-true (struct-type-id-is-immutable? #'u))
     59   (check-true (struct-type-id-is-immutable? #'v)))
     60 
     61 (struct ts (f) #:mutable #:transparent)
     62 (struct tt ts (g) #:transparent)
     63 (struct tu ([f #:mutable] g h) #:transparent)
     64 (struct tv tu (i j k l) #:transparent)
     65 (struct tw (f g h) #:transparent)
     66 (struct tx tu (i j k l) #:transparent)
     67   
     68 (require rackunit)
     69 (check-false (struct-instance-is-immutable? (s 1)))
     70 (check-false (struct-instance-is-immutable? (t 1 2)))
     71 ;; can't tell for u, because the struct is opaque.
     72 (check-false (struct-instance-is-immutable? (u 1)))
     73 
     74 (check-false (struct-instance-is-immutable? (ts 1)))
     75 (check-false (struct-instance-is-immutable? (tt 1 2)))
     76 (check-false (struct-instance-is-immutable? (tv 1 2 3 4 5 6 7)))
     77 (check-false (struct-instance-is-immutable? (tu 1 2 3)))
     78 (check-true (struct-instance-is-immutable? (tw 1 2 3)))
     79 (check-false (struct-instance-is-immutable? (tx 1 2 3 4 5 6 7)))