From 6cc1acf71b4606470e67ef56aa0338aa89d5a160 Mon Sep 17 00:00:00 2001
From: Gerd Heber <gheber@hdfgroup.org>
Date: Sun, 2 Aug 2015 11:17:46 -0500
Subject: [PATCH] Band-aid for issue #61.

---
 src/simplicial-sets.lisp   | 30 ++++++++++++++++--------------
 test/suspensions-test.lisp | 19 +++++++++++++------
 2 files changed, 29 insertions(+), 20 deletions(-)

diff --git a/src/simplicial-sets.lisp b/src/simplicial-sets.lisp
index 8f400af..b7c3a74 100644
--- a/src/simplicial-sets.lisp
+++ b/src/simplicial-sets.lisp
@@ -364,25 +364,27 @@
 	      (- 1dlop (logcount right))))))))
 
 
-(DEFUN A-FACE4 (face indx dmns absm) 
+(DEFUN A-FACE4 (face indx dmns absm)
   (declare
    (type face face)
    (fixnum indx dmns)
    (type absm absm))
   (the absm
-       (with-absm (dgop gmsm) absm
-		  (multiple-value-bind (dgop2 1dlop) (1dlop-dgop indx dgop)
-		    (declare (fixnum dgop2)
-			     #-(or ccl ecl lispworks sbcl)
-			     (type (or fixnum nil) 1dlop))
-		    ;; Bug LispWorks if this or-type defined
-		    (unless 1dlop
-		      (return-from a-face4 (absm dgop2 gmsm)))
-		    (locally (declare (fixnum 1dlop))
-		      (let ((gmsm-face (funcall face 1dlop (- dmns (logcount dgop)) gmsm)))
-			(declare (type absm gmsm-face))
-			(with-absm (dgop3 gmsm3) gmsm-face
-				   (absm (dgop*dgop dgop2 dgop3) gmsm3))))))))
+       (with-absm
+	   (dgop gmsm) absm
+	   (multiple-value-bind (dgop2 1dlop) (1dlop-dgop indx dgop)
+	     (declare (fixnum dgop2)
+		      #-(or ccl ecl lispworks sbcl)
+		      (type (or fixnum nil) 1dlop))
+	     ;; Bug LispWorks if this or-type defined
+	     (unless 1dlop
+	       (return-from a-face4 (absm dgop2 gmsm)))
+	     (locally (declare (fixnum 1dlop))
+	       (let ((gmsm-face (funcall face 1dlop (- dmns (logcount dgop))
+					 gmsm)))
+		 (declare (type absm gmsm-face))
+		 (with-absm (dgop3 gmsm3) gmsm-face
+			    (absm (dgop*dgop dgop2 dgop3) gmsm3))))))))
 
 
 (DEFUN 1DGNR (indx absm)
diff --git a/test/suspensions-test.lisp b/test/suspensions-test.lisp
index d4202c4..41e57d0 100644
--- a/test/suspensions-test.lisp
+++ b/test/suspensions-test.lisp
@@ -54,7 +54,7 @@
 	(cat:? scoal 3 7)
 	(cat:cprd scoal 3 7)))
 
-#|
+
 (test suspension-face
       (cat:cat-init)
       (let* ((ss (cat:deltab))
@@ -62,15 +62,22 @@
 	     (m (cat:moore 2 3)))
 	(funcall face 4 4 15)
 	(funcall face 0 4 15)
-	(cat:check-faces #'cat:f-cmpr face 4 15)
-	(cat:check-faces #'cat:f-cmpr face 3 7)
-	(cat:check-faces #'cat:f-cmpr face 2 3)
+	#+(or ecl sbcl)
+	(signals type-error (cat:check-faces #'cat:f-cmpr face 4 15))
+	#+(or ecl sbcl)
+	(signals type-error (cat:check-faces #'cat:f-cmpr face 3 7))
+	#+(or ecl sbcl)
+	(signals type-error (cat:check-faces #'cat:f-cmpr face 2 3))
+	#-(or ecl sbcl) (cat:check-faces #'cat:f-cmpr face 4 15)
+	#-(or ecl sbcl) (cat:check-faces #'cat:f-cmpr face 3 7)
+	#-(or ecl sbcl) (cat:check-faces #'cat:f-cmpr face 2 3)
 	(setf face (cat:suspension-face (cat:face m)))
 	(dotimes (i 5) (print (funcall face i 4 'm3)))
 	(dotimes (i 6) (print (funcall face i 5 'mm4)))
 	(cat:check-faces #'cat:s-cmpr face 4 'm3)
-	(cat:check-faces #'cat:s-cmpr face 5 'mm4)))
-|#
+	(cat:check-faces #'cat:s-cmpr face 5 'mm4)
+	))
+
 
 (test suspension1
       (cat:cat-init)