;; R7RS define-record-type tests (SRFI-9)

(defsuite
  "record-basic"
  (deftest
    "constructor and predicate"
    (do
      (define-record-type <point>
        (make-point x y)
        point?
        (x point-x)
        (y point-y))
      (let
        ((p (make-point 3 4)))
        (assert (point? p))
        (assert= 3 (point-x p))
        (assert= 4 (point-y p)))))
  (deftest
    "predicate rejects non-records"
    (do
      (define-record-type <point>
        (make-point x y)
        point?
        (x point-x)
        (y point-y))
      (assert= false (point? 42))
      (assert= false (point? "hello"))
      (assert= false (point? (list 1 2)))
      (assert= false (point? {:x 1 :y 2}))))
  (deftest
    "type-of returns stripped name"
    (do
      (define-record-type <point>
        (make-point x y)
        point?
        (x point-x)
        (y point-y))
      (assert= "point" (type-of (make-point 1 2)))))
  (deftest
    "record is not a dict"
    (do
      (define-record-type <point>
        (make-point x y)
        point?
        (x point-x)
        (y point-y))
      (assert= false (dict? (make-point 1 2)))
      (assert= false (list? (make-point 1 2)))
      (assert (record? (make-point 1 2))))))

(defsuite
  "record-mutator"
  (deftest
    "set! via mutator"
    (do
      (define-record-type <point>
        (make-point x y)
        point?
        (x point-x)
        (y point-y set-point-y!))
      (let
        ((p (make-point 3 4)))
        (set-point-y! p 99)
        (assert= 99 (point-y p))
        (assert= 3 (point-x p)))))
  (deftest
    "multiple mutations"
    (do
      (define-record-type <cell>
        (make-cell value)
        cell?
        (value cell-value set-cell-value!))
      (let
        ((c (make-cell 0)))
        (set-cell-value! c 1)
        (set-cell-value! c 2)
        (set-cell-value! c 3)
        (assert= 3 (cell-value c))))))

(defsuite
  "record-generative"
  (deftest
    "distinct types with same fields"
    (do
      (define-record-type <a>
        (make-a v)
        a?
        (v a-v))
      (define-record-type <b>
        (make-b v)
        b?
        (v b-v))
      (let
        ((x (make-a 1))
          (y (make-b 2)))
        (assert (a? x))
        (assert= false (a? y))
        (assert= false (b? x))
        (assert (b? y)))))
  (deftest
    "record? matches any record"
    (do
      (define-record-type <a>
        (make-a v)
        a?
        (v a-v))
      (define-record-type <b>
        (make-b v)
        b?
        (v b-v))
      (assert (record? (make-a 1)))
      (assert (record? (make-b 2)))
      (assert= false (record? 42)))))

(defsuite
  "record-field-reorder"
  (deftest
    "constructor params in different order"
    (do
      (define-record-type <pair>
        (make-pair second first)
        pair?
        (first pair-first)
        (second pair-second))
      (let
        ((p (make-pair 2 1)))
        (assert= 1 (pair-first p))
        (assert= 2 (pair-second p)))))
  (deftest
    "three fields reordered"
    (do
      (define-record-type <triple>
        (make-triple c a b)
        triple?
        (a triple-a)
        (b triple-b)
        (c triple-c))
      (let
        ((t (make-triple 30 10 20)))
        (assert= 10 (triple-a t))
        (assert= 20 (triple-b t))
        (assert= 30 (triple-c t))))))

(defsuite
  "record-nested"
  (deftest
    "records containing records"
    (do
      (define-record-type <point>
        (make-point x y)
        point?
        (x point-x)
        (y point-y))
      (define-record-type <line>
        (make-line start end)
        line?
        (start line-start)
        (end line-end))
      (let
        ((l (make-line (make-point 0 0) (make-point 3 4))))
        (assert (line? l))
        (assert (point? (line-start l)))
        (assert= 0 (point-x (line-start l)))
        (assert= 4 (point-y (line-end l)))))))

(defsuite
  "record-equality"
  (deftest
    "equal records are equal"
    (do
      (define-record-type <point>
        (make-point x y)
        point?
        (x point-x)
        (y point-y))
      (assert= (make-point 1 2) (make-point 1 2))))
  (deftest
    "different values are not equal"
    (do
      (define-record-type <point>
        (make-point x y)
        point?
        (x point-x)
        (y point-y))
      (assert (not (equal? (make-point 1 2) (make-point 1 3)))))))