First cl-space-efhm test extracted. This part seems to be affected by the

ICMBN-P issues.

kenzo-test.asd

@@ -23,4 +23,5 @@
 	       (:file "delta-test")
 	       (:file "bar-test")
 	       (:file "cartesian-products-test")
-	       (:file "cones-test")))
+	       (:file "cones-test")
+	       (:file "cl-space-efhm-test")))

package.lisp

@@ -86,6 +86,10 @@
 	   Z-CHCM
 	   ZERO-MRPH
 
+	   ;; cl-space-efhm.lisp
+
+	   CS-HAT-U-T
+
 	   ;; classes.lisp
 
 	   ABSM
@@ -101,6 +105,7 @@
 	   F
 	   FACE
 	   G
+	   GBAR
 	   GMSM
 	   H
 	   HOMOTOPY-EQUIVALENCE
@@ -114,6 +119,7 @@
 	   REDUCTION
 	   RRDCT
 	   TCC
+	   TNPR
 
 	   ;; combinations.lisp
 

test/bar-test.lisp

@@ -56,7 +56,7 @@
 	(funcall r 5 (cat:abar 2 (cat:d 3) 3 (cat:d 7)))))
 
 
-(defun random-abar (length)
+(defun random-abar1 (length)
   (let ((rslt nil))
     (dotimes (i length)
       (let* ((gmsm (random (cat:mask 7)))
@@ -71,9 +71,9 @@
 	(cat:cat-init)
 	(let ((v (cat:vrtc-bar (cat:soft-delta-infinity))))
 	  (dotimes (i 10)
-	    (print (random-abar 5)))
+	    (print (random-abar1 5)))
 	  (dotimes (i 10)
-	    (let ((abar (random-abar 3)))
+	    (let ((abar (random-abar1 3)))
 	      (print abar)
 	      (print (cat:? v (apply #'+ (mapcar #'car (cat:abar-list abar)))
 			    abar))
@@ -82,22 +82,6 @@
 				     abar))))))))
 
 
-(defun random-abar1 (tot-degr~ max-degr)
-  (do ((rslt nil)
-       (cum-degr 0 (+ cum-degr degr 1))
-       (degr))
-      ((>= cum-degr tot-degr~) (cat:make-abar :list rslt))
-    (setf degr (1+ (random max-degr)))
-    (push (cat:brgn (1+ degr)
-		(let ((list (make-list degr)))
-		  (mapl
-		   #'(lambda (sublist)
-		       (setf (car sublist) (- (random 21) 10)))
-		   list)
-		  list))
-	  rslt)))
-
-
 #|
 (test bar-intr-hrzn-dffr
       (let* ((k (cat:k-z-1))

test/cl-space-efhm-test.lisp

@@ -0,0 +1,56 @@
+
+(in-package :kenzo-test)
+
+(in-suite :kenzo)
+
+
+(test cs-hat-u-t
+      (progn
+	(cat:cat-init)
+	(let* ((c (cat:cs-hat-u-t (cat:k-z-1)))
+	       (abar (random-abar 8 4))
+	       (abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	       (gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '())
+					   2 '(4 5))
+			       abar-degr abar)))
+	  (dotimes (i 5) (print (random-abar 8 4)))
+	  #|
+	  (cat:? c (+ 5 abar-degr) gnrt)
+	  (cat:? c (cat:? c (+ 5 abar-degr) gnrt))
+	  (dotimes (i 10)
+	    (let ((abar (random-abar 8 4)))
+	      (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	      (setf gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
+							   0 '()) 2 '(4 5))
+				   abar-degr abar))
+	      (unless (>= abar-degr 10)
+		(print (cat:? c (+ 5 abar-degr) gnrt))
+		(print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
+	  (dotimes (i 10)
+	    (let ((abar (random-abar 8 4)))
+	      (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	      (setf gnrt (cat:tnpr 6 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
+							   0 '()) 3 '(4 5 6))
+				   abar-degr abar))
+	      (unless (>= abar-degr 9)
+		(print (cat:? c (+ 6 abar-degr) gnrt))
+		(print (cat:? c (cat:? c (+ 6 abar-degr) gnrt))))))
+	  (dotimes (i 10)
+	    (let ((abar (random-abar 8 4)))
+	      (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	      (setf gnrt (cat:tnpr 5 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
+					       3 '(4 5 6)) abar-degr abar))
+	      (unless (>= abar-degr 10)
+		(print (cat:? c (+ 5 abar-degr) gnrt))
+		(print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
+	  (dotimes (i 10)
+	    (let ((abar (random-abar 8 4)))
+	      (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
+	      (setf gnrt (cat:tnpr 4 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
+					       2 '(4 5))
+				   abar-degr abar))
+	      (unless (>= abar-degr 11)
+		(print (cat:? c (+ 4 abar-degr) gnrt))
+		(print (cat:? c (cat:? c (+ 4 abar-degr) gnrt))))))
+	  |#
+	  )))

test/common.lisp

@@ -168,3 +168,19 @@
 				       cat:*dg-gd* cat:*hg*))
 			 cat:*bc*
 			 cat:*tc*))))))
+
+
+(defun random-abar (tot-degr~ max-degr)
+  (do ((rslt nil)
+       (cum-degr 0 (+ cum-degr degr 1))
+       (degr))
+      ((>= cum-degr tot-degr~) (cat:make-abar :list rslt))
+    (setf degr (1+ (random max-degr)))
+    (push (cat:brgn (1+ degr)
+		(let ((list (make-list degr)))
+		  (mapl
+		   #'(lambda (sublist)
+		       (setf (car sublist) (- (random 21) 10)))
+		   list)
+		  list))
+	  rslt)))