ref: a0e26d4f40a3a63f9d33fd1a1f01e23a18ff7e27
dir: /test/defstruct.sl/
(defstruct sa a b (c 3))
(assert (bound? 'make-sa)) ; default constructor is defined
(assert (bound? 'sa-a)) ; slot accessors are defined
(assert (bound? 'sa-b))
(assert (bound? 'sa-c))
(def ax (make-sa))
(assert (sa? ax))
(assert (not (vec? ax)))
(assert (not (cons? ax)))
(assert (equal? (type-of ax) '(struct sa)))
(assert (not (equal? #('sa :a NIL :b NIL :c 3) ax)))
(assert (not (eqv? #('sa :a NIL :b NIL :c 3) ax)))
(assert (not (sa-a ax))) ; a defaults to NIL
(assert (not (sa-b ax))) ; so is b
(assert (= (sa-c ax) 3))
(def ax (make-sa :a 1 :b 2))
(assert (sa? ax))
(assert (= (sa-a ax) 1))
(assert (= (sa-b ax) 2))
(assert (= (sa-c ax) 3))
(sa-c ax 4)
(sa-b ax 5)
(sa-a ax 6)
(assert (= (sa-a ax) 6))
(assert (= (sa-b ax) 5))
(assert (= (sa-c ax) 4))
(def ax (make-sa :c 0))
(assert (sa? ax))
(assert (not (sa-a ax)))
(assert (not (sa-b ax)))
(assert (= (sa-c ax) 0))
; same struct, different name
(defstruct sb a b (c 3))
(def bx (make-sb))
(assert (sb? bx))
(assert (not (sa? bx)))
(assert (not (vec? bx)))
(assert (not (cons? bx)))
(assert (equal? (type-of bx) '(struct sb)))
; struct as a list, NOT named
(defstruct sl :type list a b (c 3))
(def lx (make-sl))
(assert (not (bound? 'sl?))) ; not :named, should not have a predicate
(assert (cons? lx))
(assert (length= lx 3)) ; 3 slots, not named by default
(assert (not (sl-a lx)))
(assert (not (sl-b lx)))
(assert (= (sl-c lx) 3))
(sl-a lx lx)
(assert (eq? (sl-a lx) lx))
; struct as a list, named
(defstruct sln :type list :named T a b (c 3))
(def lx (make-sln))
(assert (bound? 'sln?)) ; :named, should have a predicate defined
(assert (cons? lx))
(assert (length= lx 4)) ; 4 slots (with the name)
(assert (not (sln-a lx)))
(assert (not (sln-b lx)))
(assert (= (sln-c lx) 3))
(sl-a lx lx)
(assert (eq? (sl-a lx) lx))
(defstruct ok :named T a)
(assert-fail (macroexpand '(defstruct fail :named NIL a)))
; custom constructor - renamed
(defstruct scc :constructor scc_ a b (c 3))
(assert (not (bound? 'make-scc)))
(assert (bound? 'scc_))
(def ccx (scc_ :a 1 :b 2))
(assert (= (scc-a ccx) 1))
(assert (= (scc-b ccx) 2))
(assert (= (scc-c ccx) 3))
(let ((b (buffer))) ; able to read the #S(...) form with a renamed constructor
(write ccx b)
(io-seek b 0)
(assert (equal? (read b) ccx)))
; custom constructor - no keywords
(defstruct scc2 :constructor (scc2 a b c) a b (c 3))
(assert (not (bound? 'make-scc2)))
(assert (bound? 'scc2))
(def cc2x (scc2 1 2 4))
(assert (= (scc2-a cc2x) 1))
(assert (= (scc2-b cc2x) 2))
(assert (= (scc2-c cc2x) 4))
(let ((b (buffer))) ; able to read the #S(...) form with a custom constructor
(write cc2x b)
(io-seek b 0)
(assert (equal? (read b) cc2x)))