Re-enabled special-smsts-test.

gheber · May 29, 2019 · 51e5f7c · 51e5f7c
1 parent e519e58
commit 51e5f7c
Show file tree

Hide file tree

Showing 2 changed files with 38 additions and 37 deletions.
diff --git a/kenzo-test.asd b/kenzo-test.asd
@@ -43,7 +43,7 @@
                  (:file "simplicial-mrphs-test")
                  (:file "simplicial-sets-test")
                  ;;(:file "smith-test")
-                 ;;(:file "special-smsts-test")
+                 (:file "special-smsts-test")
                  (:file "suspensions-test")
                  (:file "tensor-products-test")
                  (:file "various-test")

diff --git a/test/special-smsts-test.lisp b/test/special-smsts-test.lisp
@@ -125,39 +125,40 @@ TR is NIL. Why?
         (dotimes (i 7)
           (print (cat:? dd i i)))))
 
-
-(test gmsms-subsmst
-      (cat:cat-init)
-      (let* ((k (cat:k-z 2))
-             (efhm (cat:efhm k))
-             g cmbn kf incl cone s2 cl2 f2 s3
-
-             )
-        (setf cat:*homology-verbose* nil)
-        (setf g (first (cat:chcm-homology-gen (cat:rbcc efhm) 4)))
-        (setf cmbn (cat:lf efhm (cat:rg efhm g)))
-        (multiple-value-setq (kf incl) (cat:gmsms-subsmst k cmbn))
-        (setf cone (cat:cone incl))
-        (cat:efhm cone)
-        (cat:homology kf 0 5)
-        (cat:homology (cat:cone incl) 0 6)
-
-        (setf g (first (cat:chcm-homology-gen (cat:rbcc efhm) 8)))
-        (setf cmbn (cat:lf efhm (cat:rg efhm g)))
-        (multiple-value-setq (kf incl) (cat:gmsms-subsmst k cmbn))
-        (setf cone (cat:cone incl))
-        (cat:efhm cone)
-        (cat:homology kf 0 9)
-        (cat:homology (cat:cone incl) 0 10)
-        (dotimes (i 9) (print (length (cat:basis kf i))))
-
-        (setf s2 (cat:sphere 2))
-        (setf cl2 (cat:chml-clss s2 2))
-        (setf f2 (cat:z-whitehead s2 cl2))
-        (setf s3 (cat:fibration-total f2))
-        (setf efhm (cat:efhm s3))
-        (cat:basis (cat:rbcc efhm) 3)
-        (setf cmbn (cat:lf efhm (cat:rg efhm 3 (first (cat:basis
-                                                       (cat:rbcc efhm) 3)))))
-        (setf kf (cat:gmsms-subsmst s3 cmbn))
-        (cat:homology kf 0 4)))
+(when (or (string= (package-name (find-package 'cat)) "CAT-7")
+          (string= (package-name (find-package 'cat)) "CAT-8"))
+  (test gmsms-subsmst
+        (cat:cat-init)
+        (let* ((k (cat:k-z 2))
+               (efhm (cat:efhm k))
+               g cmbn kf incl cone s2 cl2 f2 s3
+
+               )
+          (setf cat:*homology-verbose* nil)
+          (setf g (first (cat:chcm-homology-gen (cat:rbcc efhm) 4)))
+          (setf cmbn (cat:lf efhm (cat:rg efhm g)))
+          (multiple-value-setq (kf incl) (cat:gmsms-subsmst k cmbn))
+          (setf cone (cat:cone incl))
+          (cat:efhm cone)
+          (cat:homology kf 0 5)
+          (cat:homology (cat:cone incl) 0 6)
+
+          (setf g (first (cat:chcm-homology-gen (cat:rbcc efhm) 8)))
+          (setf cmbn (cat:lf efhm (cat:rg efhm g)))
+          (multiple-value-setq (kf incl) (cat:gmsms-subsmst k cmbn))
+          (setf cone (cat:cone incl))
+          (cat:efhm cone)
+          (cat:homology kf 0 9)
+          (cat:homology (cat:cone incl) 0 10)
+          (dotimes (i 9) (print (length (cat:basis kf i))))
+
+          (setf s2 (cat:sphere 2))
+          (setf cl2 (cat:chml-clss s2 2))
+          (setf f2 (cat:z-whitehead s2 cl2))
+          (setf s3 (cat:fibration-total f2))
+          (setf efhm (cat:efhm s3))
+          (cat:basis (cat:rbcc efhm) 3)
+          (setf cmbn (cat:lf efhm (cat:rg efhm 3 (first (cat:basis
+                                                         (cat:rbcc efhm) 3)))))
+          (setf kf (cat:gmsms-subsmst s3 cmbn))
+          (cat:homology kf 0 4))))