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

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

@ -4,16 +4,6 @@
(in-suite :kenzo) (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 (test do-control
(let ((comb (cat:do-control #'cat:s-cmpr (cat:cmbn 0 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-degr comb) 0))
@ -25,8 +15,12 @@
(signals simple-error (cat:do-control #'cat:s-cmpr (signals simple-error (cat:do-control #'cat:s-cmpr
(cat:cmbn 0 1 'a 1 'b -1 'b))) (cat:cmbn 0 1 'a 1 'b -1 'b)))
(setf cat:*cmbn-control* nil)) (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-? (test gnrt-?
(progn (progn
@ -43,9 +37,7 @@
:intr #'(lambda (degr n) :intr #'(lambda (degr n)
(cat:cmbn degr 1 n)) (cat:cmbn degr 1 n))
:strt :gnrt :orgn '(test)))) :strt :gnrt :orgn '(test))))
;; setting this to a small value (-1) triggers some kind (setf cat:+too-much-time+ -1)
;; of caching which appears to be broken (???)
(setf cat:+too-much-time+ 50)
(dotimes (i 20) (dotimes (i 20)
(let* ((n (- (random 50) 50)) (let* ((n (- (random 50) 50))
(comb (cat:gnrt-? ff 0 n))) (comb (cat:gnrt-? ff 0 n)))
@ -89,7 +81,4 @@
(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)) (setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb)) (setq comb (cat:cmbn-? mrph comb))))))
;; (time (cat:cmbn-? mrph *))
;; (inspect mrph)
))))