whalesong/tests/older-tests/moby-programs/struct.rkt

56 lines
2.1 KiB
Racket

#lang s-exp "../../lang/wescheme.rkt"
(require "../../lang/check-expect/test-expect.rkt")
"struct.rkt"
(let-values ([(a-struct-type
constructor
predicate
accessor
mutator)
(make-struct-type 'pair
#f
2
0)])
(test-expect (struct-type? a-struct-type) true)
(test-expect (struct-type? (constructor 3 4)) false)
(test-expect (predicate (constructor 3 4)) true)
(test-expect (predicate (cons 3 4)) false)
(test-expect (struct-constructor-procedure? constructor) true)
(test-expect (struct-constructor-procedure? (lambda (x y)
(constructor x y)))
false)
(test-expect (struct-predicate-procedure? predicate) true)
(test-expect (struct-predicate-procedure? accessor) false)
(test-expect (struct-predicate-procedure? 24) false)
(test-expect (struct-predicate-procedure? (lambda (x) true))
false)
(test-expect (struct-accessor-procedure? accessor) true)
(test-expect (struct-accessor-procedure? mutator) false)
(test-expect (struct-accessor-procedure? 24) false)
(test-expect (struct-accessor-procedure? (lambda (x) true))
false)
(test-expect (struct-mutator-procedure? mutator) true)
(test-expect (struct-mutator-procedure? accessor) false)
(test-expect (struct-mutator-procedure? 24) false)
(test-expect (struct-mutator-procedure? (lambda (x) true))
false)
(let ([f (make-struct-field-accessor accessor 0)]
[r (make-struct-field-accessor accessor 1)]
[set-f! (make-struct-field-mutator mutator 0)]
[set-r! (make-struct-field-mutator mutator 1)])
(let ([p1 (constructor 17 'foo)])
(test-expect (f p1) 17)
(test-expect (r p1) 'foo)
(set-f! p1 'something-else)
(test-expect (f p1) 'something-else)
(set-r! p1 1024)
(test-expect (r p1) '1024))))
"struct.rkt end"