#lang scheme/base
;; See srfi-9-plus.ss for legal info.

(require (planet neil/testeez:1:3)
         "srfi-9-plus.ss")

(define (my-write-proc record port write?)
  (and write? (display "#<foo " port))
  (display ":bar " port)
  (write (my-accessor-0 record) port)
  (display " :baz " port)
  (write (my-accessor-1 record) port)
  (and write? (write-char #\> port)))

(define-record-type/write my-record-type
  (my-constructor my-field-0 my-field-1)
  my-predicate
  my-write-proc
  (my-field-0 my-accessor-0)
  (my-field-1 my-accessor-1 my-mutator-1)
  (my-field-2 my-accessor-2)
  (my-field-3 my-accessor-3)
  (my-field-4 my-accessor-4 my-mutator-4))

(define-record-type mo-record-type
  (mo-constructor mo-field-0 mo-field-1)
  mo-predicate
  (mo-field-0 mo-accessor-0)
  (mo-field-1 mo-accessor-1 mo-mutator-1)
  (mo-field-2 mo-accessor-2)
  (mo-field-3 mo-accessor-3)
  (mo-field-4 mo-accessor-4 mo-mutator-4))

(testeez
 "srfi9-plus"

 ((format "~A" my-record-type) "#<struct-type:my-record-type>")
 ((format "~A" my-constructor) "#<procedure:my-constructor>")
 ((format "~A" my-accessor-0)  "#<procedure:my-accessor-0>")
 ((format "~A" my-accessor-1)  "#<procedure:my-accessor-1>")
 ((format "~A" my-mutator-1)   "#<procedure:my-mutator-1>")
 ((format "~A" my-predicate)   "#<procedure:my-predicate>")

 (test-define "" my-record (my-constructor 111 222))

 ((format "~S" my-record) "#<foo :bar 111 :baz 222>")

 ((format "~A" my-record) ":bar 111 :baz 222")

 ((my-predicate my-record) #t)

 ((my-predicate 'hi) #f)

 ((my-accessor-0 my-record) 111)

 ((my-accessor-1 my-record) 222)

 (test-eval "" (my-mutator-1 my-record 333))

 ((my-accessor-1 my-record) 333)

 (test-eval "" (my-mutator-4 my-record 666))

 ((my-accessor-4 my-record) 666)

 ((format "~S" my-record) "#<foo :bar 111 :baz 333>"))