Extracted simplicial morphism tests.

kenzo-test.asd

@@ -27,6 +27,8 @@
 	       (:file "k-pi-n-test")
 	       (:file "kan-test")
 	       (:file "searching-homology-test")
+	       (:file "simplicial-mrphs-test")
 	       (:file "simplicial-sets-test")
 	       (:file "tensor-products-test")
-	       (:file "various-test")))
+	       (:file "various-test")
+	       ))

package.lisp

@@ -283,6 +283,10 @@
 
 	   HOMOLOGY
 
+	   ;; simplicial-mrphs.lisp
+
+	   BUILD-SMMR
+
 	   ;; simplicial-sets.lisp
 
 	   1DGNR

src/simplicial-mrphs.lisp

@@ -20,6 +20,7 @@
     (otherwise
      (funcall (sintr smmr) dmns absm-or-gmsm))))  
 
+
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) nil))
 (DEFMETHOD PRINT-OBJECT ((smmr simplicial-mrph) stream)
@@ -40,6 +41,7 @@
   (the (or null simplicial-mrph)
        (find idnm *smmr-list* :key #'idnm)))
 
+
 (DEFUN SINTR-INTR (sintr)
   (declare (type sintr sintr))
   (flet ((rslt (dmns gmsm)
@@ -55,6 +57,7 @@
 		 (term-cmbn dmns 1 (gmsm rslt))))))
     (the intr-mrph #'rslt)))
 
+
 (DEFUN BUILD-SMMR (&key sorc trgt degr sintr intr strt orgn)
   (declare
    (type simplicial-set sorc trgt)
@@ -87,18 +90,18 @@
 	   rslt))))
 
 #|
-  (setf d (delta 3))
-  (setf m (build-smmr
+(setf d (delta 3))
+(setf m (build-smmr
 	 :sorc d :trgt d :degr 0
 	 :sintr #'(lambda (dmns gmsm)
 		    (absm 0 gmsm))
 	 :orgn '(identity delta-3)))
-  (setf m2 (build-smmr
+(setf m2 (build-smmr
 	  :sorc d :trgt d :degr 0
 	  :sintr #'(lambda (dmns gmsm)
 		     (absm (mask dmns) 1))
 	  :orgn '(null delta-3)))
-  (? m2 2 7)
+(? m2 2 7)
 ;;  (s? m2 2 7)
 |#
 

test/simplicial-mrphs-test.lisp

@@ -0,0 +1,19 @@
+
+(in-package :kenzo-test)
+
+(in-suite :kenzo)
+
+
+(test build-smmr
+      (let* ((d (cat:delta 3))
+	     (m (cat:build-smmr
+		 :sorc d :trgt d :degr 0
+		 :sintr #'(lambda (dmns gmsm) (cat:absm 0 gmsm))
+		 :orgn '(identity delta-3)))
+	     (m2 (cat:build-smmr
+		  :sorc d :trgt d :degr 0
+		  :sintr #'(lambda (dmns gmsm) (cat:absm (cat:mask dmns) 1))
+		  :orgn '(null delta-3))))
+	(cat:? m2 2 7)
+	;;  (s? m2 2 7)
+	))