[bpt/guile.git] / testsuite / t-proc-with-setter.scm

(define the-struct (vector 1 2))

(define get/set
  (make-procedure-with-setter
   (lambda (struct name)
     (case name
       ((first)  (vector-ref struct 0))
       ((second) (vector-ref struct 1))
       (else     #f)))
   (lambda (struct name val)
     (case name
       ((first)  (vector-set! struct 0 val))
       ((second) (vector-set! struct 1 val))
       (else     #f)))))

(and (eq? (vector-ref the-struct 0) (get/set the-struct 'first))
     (eq? (vector-ref the-struct 1) (get/set the-struct 'second))
     (begin
       (set! (get/set the-struct 'second) 77)
       (eq? (vector-ref the-struct 1) (get/set the-struct 'second))))
Commit	Line	Data
0b5f0e49 LC	1	(define the-struct (vector 1 2))
	2
	3	(define get/set
	4	(make-procedure-with-setter
	5	(lambda (struct name)
	6	(case name
	7	((first) (vector-ref struct 0))
	8	((second) (vector-ref struct 1))
	9	(else #f)))
	10	(lambda (struct name val)
	11	(case name
	12	((first) (vector-set! struct 0 val))
	13	((second) (vector-set! struct 1 val))
	14	(else #f)))))
b6368dbb LC	15
	16	(and (eq? (vector-ref the-struct 0) (get/set the-struct 'first))
	17	(eq? (vector-ref the-struct 1) (get/set the-struct 'second))
	18	(begin
	19	(set! (get/set the-struct 'second) 77)
	20	(eq? (vector-ref the-struct 1) (get/set the-struct 'second))))