113 lines
3.7 KiB
Common Lisp
113 lines
3.7 KiB
Common Lisp
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*
|
|
|
|
(in-package :kenzo-test)
|
|
|
|
(in-suite :kenzo)
|
|
|
|
(test con-test
|
|
(cat:con0 'a)
|
|
(cat:con1 'a)
|
|
(cat:con0 (cat:con0 'a))
|
|
(cat:con0 (cat:con1 'a))
|
|
(cat:con1 (cat:con0 'a))
|
|
(cat:con1 (cat:con1 'a))
|
|
(cat:con0 (cat:con1 (cat:con0 (cat:con1 'a)))))
|
|
|
|
|
|
(test cone-cmpr
|
|
(let ((cmpr (cat:cone-cmpr #'cat:s-cmpr #'cat:f-cmpr)))
|
|
(is (equal :less (funcall cmpr (cat:con0 'a) (cat:con0 'b))))
|
|
(is (equal :equal (funcall cmpr (cat:con0 'b) (cat:con0 'b))))
|
|
(is (equal :greater (funcall cmpr (cat:con0 'b) (cat:con0 'a))))
|
|
(is (equal :less (funcall cmpr (cat:con0 'b) (cat:con1 '2))))
|
|
(is (equal :greater (funcall cmpr (cat:con1 '2) (cat:con0 'b))))
|
|
(is (equal :less (funcall cmpr (cat:con1 '1) (cat:con1 '2))))
|
|
(is (equal :equal (funcall cmpr (cat:con1 '2) (cat:con1 '2))))
|
|
(is (equal :greater (funcall cmpr (cat:con1 '2) (cat:con1 '1))))))
|
|
|
|
|
|
(test cone-basis
|
|
(let ((basis (cat:cone-basis #'(lambda (n) (list n))
|
|
#'(lambda (n) (list n)))))
|
|
(funcall basis 4)))
|
|
|
|
|
|
(test term-con
|
|
(cat:term-con0 (cat:term 2 'a))
|
|
(cat:term-con1 (cat:term 2 'a))
|
|
(cat:term-uncon (cat:term 2 (cat:con0 'a))))
|
|
|
|
|
|
(test cmbn-con
|
|
(cat:cmbn-con0 (cat:cmbn 3 1 'a 2 'b))
|
|
(cat:cmbn-con1 (cat:cmbn 3 1 'a 2 'b)))
|
|
|
|
|
|
(test cone-cmbn-split
|
|
(cat:cone-cmbn-split (cat:cmbn 3 4 (cat:con0 'a) 5 (cat:con1 'b)))
|
|
(cat:cone-cmbn-split (cat:cmbn 3 4 (cat:con0 'a)))
|
|
(cat:cone-cmbn-split (cat:cmbn 3 4 (cat:con1 'a))))
|
|
|
|
|
|
(test cone-2cmbn-append
|
|
(cat:cone-2cmbn-append (cat:cmbn 3 4 'a) (cat:cmbn 2 5 'b)))
|
|
|
|
|
|
(test cone-2mrph-diag-impl
|
|
(let* ((mrph (cat:dffr (cat:delta 4)))
|
|
(rslt (cat:cone-2mrph-diag-impl mrph mrph)))
|
|
(funcall rslt (cat:cmbn 3 4 (cat:con0 15) 5 (cat:con1 7)))))
|
|
|
|
|
|
(test cone-3mrph-triangle-impl
|
|
(let ((rslt (cat:cone-3mrph-triangle-impl #'cat:f-cmpr
|
|
(cat:dffr (cat:delta 4))
|
|
(cat:dffr (cat:delta 4))
|
|
(cat:idnt-mrph (cat:delta 4)))))
|
|
(funcall rslt 4 (cat:con0 '31))
|
|
(funcall rslt 5 (cat:con1 '31))
|
|
(funcall rslt 4 (cat:con1 '15))))
|
|
|
|
|
|
(test cone
|
|
(progn
|
|
(cat:cat-init)
|
|
(let* ((k (cat:k-z 1))
|
|
(u (cat:idnt-mrph k))
|
|
(c (cat:cone u))
|
|
(cone))
|
|
(setf cat:*tc* (cat:cmbn 4 1 (cat:con0 '(1 2 3 4))))
|
|
(cat:? c 4 (cat:con0 '(1 2 3 4)))
|
|
(cat:? c cat:*tc*)
|
|
|
|
(setf cone (cat:cone (cat:idnt-mrph (cat:delta 4))))
|
|
(cat:? cone (cat:cmbn 4 1 (cat:con0 '31) -1 (cat:con1 '15)))
|
|
(cat:? cone
|
|
(cat:? cone (cat:cmbn 4
|
|
1 (cat:con0 '31) -1 (cat:con1 '15)))))))
|
|
|
|
|
|
(test cone-2mrph-diag
|
|
(let* ((idnt (cat:idnt-mrph (cat:delta 4)))
|
|
(cone (cat:cone idnt))
|
|
(ff (cat:cone-2mrph-diag cone cone idnt idnt)))
|
|
(cat:? ff (cat:cmbn 4 1 (cat:con0 '31) 10 (cat:con1 '15)))))
|
|
|
|
|
|
(test cone-3mrph-triangle
|
|
(progn
|
|
(cat:cat-init)
|
|
(let* ((d (cat:delta 4))
|
|
(df (cat:dffr (cat:delta 4)))
|
|
(n (cat:idnt-mrph d))
|
|
(c (cat:cone n))
|
|
(z (cat:sbtr (cat:dffr c)
|
|
(cat:cone-3mrph-triangle c c df
|
|
(cat:n-mrph -1 df) n))))
|
|
(cat:? z 0 (cat:con0 '1))
|
|
(cat:? z 1 (cat:con1 '1))
|
|
(cat:? z 1 (cat:con0 '3))
|
|
(cat:? z 2 (cat:con1 '3))
|
|
(cat:? z 4 (cat:con0 '31))
|
|
(cat:? z 5 (cat:con1 '31)))))
|