From d3dce67ea4c71a0f22d7774430e42271a42098b6 Mon Sep 17 00:00:00 2001
From: Gerd Heber <gheber@hdfgroup.org>
Date: Fri, 3 Jul 2015 20:42:09 -0500
Subject: [PATCH] The *CMBN-CONTROL* variable was ignored in DO-CONTROL. Fixed.
 Added missing tests.

---
 test/chain-complexes-test.lisp | 117 +++++++++++++++------------------
 1 file changed, 53 insertions(+), 64 deletions(-)

diff --git a/test/chain-complexes-test.lisp b/test/chain-complexes-test.lisp
index 6754151..bb79b4d 100644
--- a/test/chain-complexes-test.lisp
+++ b/test/chain-complexes-test.lisp
@@ -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))))))