mmarco/kenzo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

The *CMBN-CONTROL* variable was ignored in DO-CONTROL. Fixed.

Browse Source 
Added missing tests.
This commit is contained in:
Gerd Heber 2015-07-03 20:42:09 -05:00
parent c95825279c
commit d3dce67ea4
1 changed files with 53 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
test/chain-complexes-test.lisp
View File

@ -4,53 +4,45 @@
(in-suite :kenzo)
#|
(do-control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'c))
(do-control #'s-cmpr (cmbn 0 1 'b 1 'b -1 'c))
(do-control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b))
(setf *cmbn-control* nil)
(control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b))
(setf *cmbn-control* t)
(control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b))
|#
(test do-control
(let ((comb (cat:do-control #'cat:s-cmpr (cat:cmbn 0 1 'a 1 'b -1 'c))))
(is (equal (cat:cmbn-degr comb) 0))
(is (equal (cat:cmbn-list comb) '((1 . a) (1 . b) (-1 . c)))))
(let ((comb (cat:do-control #'cat:s-cmpr (cat:cmbn 0 1 'a 1 'b -1 'c))))
(is (equal (cat:cmbn-degr comb) 0))
(is (equal (cat:cmbn-list comb) '((1 . a) (1 . b) (-1 . c)))))
(signals simple-error (cat:do-control #'cat:s-cmpr
(cat:cmbn 0 1 'b 1 'b -1 'c)))
(signals simple-error (cat:do-control #'cat:s-cmpr
(cat:cmbn 0 1 'b 1 'b -1 'c)))
(signals simple-error (cat:do-control #'cat:s-cmpr
(cat:cmbn 0 1 'a 1 'b -1 'b)))
(setf cat:*cmbn-control* nil))
(signals simple-error (cat:do-control #'cat:s-cmpr
(cat:cmbn 0 1 'a 1 'b -1 'b)))
(setf cat:*cmbn-control* nil)
(is (not (null (cat:do-control #'cat:s-cmpr
(cat:cmbn 0 1 'a 1 'b -1 'b)))))
(setf cat:*cmbn-control* t)
(signals simple-error (cat:do-control #'cat:s-cmpr
(cat:cmbn 0 1 'a 1 'b -1 'b))))
(test gnrt-?
(progn
(cat:cat-init)
(let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
:basis :locally-effective
:bsgn 0
:intr-dffr #'(lambda (cmbn)
(cat:cmbn
(1- (cat:cmbn-degr cmbn))))
:strt :cmbn
:orgn '(Z of Z)))
(ff (cat:build-mrph :sorc cc :trgt cc :degr 0
:intr #'(lambda (degr n)
(cat:cmbn degr 1 n))
:strt :gnrt :orgn '(test))))
;; setting this to a small value (-1) triggers some kind
;; of caching which appears to be broken (???)
(setf cat:+too-much-time+ 50)
(dotimes (i 20)
(let* ((n (- (random 50) 50))
(comb (cat:gnrt-? ff 0 n)))
(is (equal (cat:cmbn-degr comb) 0))
(is (equal (cat:cmbn-list comb) (cons (cons 1 n) nil))))))))
(progn
(cat:cat-init)
(let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
:basis :locally-effective
:bsgn 0
:intr-dffr #'(lambda (cmbn)
(cat:cmbn
(1- (cat:cmbn-degr cmbn))))
:strt :cmbn
:orgn '(Z of Z)))
(ff (cat:build-mrph :sorc cc :trgt cc :degr 0
:intr #'(lambda (degr n)
(cat:cmbn degr 1 n))
:strt :gnrt :orgn '(test))))
(setf cat:+too-much-time+ -1)
(dotimes (i 20)
(let* ((n (- (random 50) 50))
(comb (cat:gnrt-? ff 0 n)))
(is (equal (cat:cmbn-degr comb) 0))
(is (equal (cat:cmbn-list comb) (cons (cons 1 n) nil))))))))
(defparameter *n* 10)
@ -69,27 +61,24 @@
:list rslt))))
(test cmbn-?
(progn
(compile 'ff)
(cat:cat-init)
(let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
:basis :locally-effective
:bsgn 0
:intr-dffr #'(lambda (cmbn)
(cat:cmbn
(1- (cat:cmbn-degr cmbn))))
:strt :cmbn
:orgn '(Z of Z)))
(mrph (cat:build-mrph :sorc cc :trgt cc :degr 0
:intr #'ff :strt :gnrt :orgn '(test))))
(progn
(compile 'ff)
(cat:cat-init)
(let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
:basis :locally-effective
:bsgn 0
:intr-dffr #'(lambda (cmbn)
(cat:cmbn
(1- (cat:cmbn-degr cmbn))))
:strt :cmbn
:orgn '(Z of Z)))
(mrph (cat:build-mrph :sorc cc :trgt cc :degr 0
:intr #'ff :strt :gnrt :orgn '(test))))
(let ((comb (cat:cmbn-? mrph (cat:cmbn 0 1 100))))
(is (equal (cat:cmbn-degr comb) 0))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
;; (time (cat:cmbn-? mrph *))
;; (inspect mrph)
))))
(let ((comb (cat:cmbn-? mrph (cat:cmbn 0 1 100))))
(is (equal (cat:cmbn-degr comb) 0))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))))))