;;;; t.scm - tests for typed-records.scm


(use typed-records)


(define-record point
  x
  (y : number))

(define-record-type point3
  (make-point3 y x)
  point3?
  (x get-x set-x : number)
  (y get-y : number)
  (foo get-foo)
  (bar get-bar set-bar)
  (baz get-baz : float)
  (goo get-goo set-foo : pointer))

(defstruct person
  name
  (age : fixnum)
  ((species 'human) : symbol)
  (planet 'earth))

(define-syntax assert-type
  (syntax-rules ()
    ((_ t x)
     #+compiling
     (compiler-typecase x
       (t 'ok)))))

(let ((pt (make-point 1 2))
      (p3 (make-point3 1 2)))

  (assert-type number (point-y pt))
  (assert-type float (get-baz p3))

  (when (point? pt)
    (assert-type (struct point) pt))

  (assert-type (struct person) (make-person))

  #+compiling
  (set! person-age 42)

  (let ((p (make-person age: 33)))
    #+compiling 
    (compiler-typecase (person-age p)
      (fixnum 'ok))
    (assert (= 33 (person-age p))))

  )

;;; test by megane (#899):

(define-record-type foo
  (make-foo bar)
  foo?
  (bar foo-bar foo-bar-set!))

(display (make-foo 1))
(newline)