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

Applied Francis' changes to remedy issue #44. It's still failing.

Browse Source
This commit is contained in:
Gerd Heber 2015-11-24 20:14:03 -06:00
parent 90467b1895
commit ffdcb9cd7f
3 changed files with 180 additions and 181 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/cat-init.lisp
View File

@ -60,8 +60,8 @@
(format t "~% FILE ~2D: ~A" i (car mark)))
(DEFCONSTANT +SOURCE-EXTENSION+
#+(or allegro clisp lispworks) "cl"
#+(or ccl ecl sbcl) "lisp"
#+(or allegro lispworks) "cl"
#+(or clisp ccl ecl sbcl) "lisp"
#-(or allegro ccl clisp ecl lispworks sbcl)
(error "Not an Allegro or CCL or CLisp or LispWorks or SBCL environment."))

7
test/bar-test.lisp
View File

@ -59,7 +59,7 @@
(defun random-abar1 (length)
(let ((rslt nil))
(dotimes (i length)
(let* ((gmsm (random (cat:mask 7)))
(let* ((gmsm (random (cat:mask 6)))
(dmns (1- (logcount gmsm))))
(when (plusp dmns)
(push (cat:brgn (1+ dmns) (cat:d gmsm)) rslt))))
@ -69,7 +69,7 @@
(test vrtc-bar
(progn
(cat:cat-init)
(let ((v (cat:vrtc-bar (cat:soft-delta-infinity))))
(let ((v (cat:vrtc-bar (cat:delta-infinity))))
(dotimes (i 10)
(print (random-abar1 5)))
(dotimes (i 10)
@ -177,7 +177,6 @@
3 (cat:crpr 0 14 0 14))))))
#|
(test vrtc-bar1
(progn
(cat:cat-init)
@ -231,7 +230,7 @@
(aleat-bc)
;;(loop (c))
(dotimes (i 10) (c))))) ;; degrees >= 15 is possible => error.
|#
(test homology
(progn

4
test/common.lisp
View File

@ -176,7 +176,7 @@
(gnrt (intern (coerce (vector (code-char (+ 65 (random 4)))) 'string))
(intern (coerce (vector (code-char (+ 65 (random 4)))) 'string)))
(rslt nil (cons (cat:brgn degr gnrt) rslt)))
((> tdegr 10) (setf cat:*tc* (cat:cmbn tdegr 1 (cat:make-abar
((> tdegr 8) (setf cat:*tc* (cat:cmbn tdegr 1 (cat:make-abar
:list rslt))))))
@ -186,7 +186,7 @@
(gnrt (intern (coerce (vector (code-char (+ 67 (random 2)))) 'string))
(intern (coerce (vector (code-char (+ 67 (random 2)))) 'string)))
(rslt nil (cons (cat:brgn degr gnrt) rslt)))
((> tdegr 10) (setf cat:*bc* (cat:cmbn tdegr 1 (cat:make-abar
((> tdegr 8) (setf cat:*bc* (cat:cmbn tdegr 1 (cat:make-abar
:list rslt))))))