[fset-cvs] r25 - trunk/Code

Scott L. Burson sburson at common-lisp.net
Mon Nov 10 05:44:30 UTC 2008


Author: sburson
Date: Mon Nov 10 05:44:30 2008
New Revision: 25

Log:
Some minor fixes:
  
() `domain-contains' and `range-contains' were not exported.
() Some `deflex' variables in `testing.lisp' needed +earmuffs+ on Scieneer.
() A case error showed up in case-sensitive Lisps.



Modified:
   trunk/Code/defs.lisp
   trunk/Code/testing.lisp
   trunk/Code/tuples.lisp

Modified: trunk/Code/defs.lisp
==============================================================================
--- trunk/Code/defs.lisp	(original)
+++ trunk/Code/defs.lisp	Mon Nov 10 05:44:30 2008
@@ -37,7 +37,8 @@
 	   ;; are unlikely to be useful in user code.
 	   #:equal? #:compare #:compare-slots #:identity-ordering-mixin
 	   #:define-cross-type-compare-methods
-	   #:empty? nonempty? #:size #:set-size #:arb #:contains? #:multiplicity
+	   #:empty? nonempty? #:size #:set-size #:arb
+	   #:contains? #:domain-contains? #:range-contains? #:member? #:multiplicity
 	   #:empty-set #:empty-bag #:empty-map #:empty-seq #:empty-tuple
 	   #:empty-wb-set #:empty-wb-bag #:empty-wb-map #:empty-wb-seq
 	   #:empty-dyn-tuple

Modified: trunk/Code/testing.lisp
==============================================================================
--- trunk/Code/testing.lisp	(original)
+++ trunk/Code/testing.lisp	Mon Nov 10 05:44:30 2008
@@ -15,16 +15,16 @@
 	    (:constructor Make-My-Integer (Value)))
   Value)
 
-(def-tuple-key K0)
-(def-tuple-key K1)
-(def-tuple-key K2)
-(def-tuple-key K3)
-(def-tuple-key K4)
-(def-tuple-key K5)
-(def-tuple-key K6)
-(def-tuple-key K7)
-(def-tuple-key K8)
-(def-tuple-key K9)
+(def-tuple-key +K0+)
+(def-tuple-key +K1+)
+(def-tuple-key +K2+)
+(def-tuple-key +K3+)
+(def-tuple-key +K4+)
+(def-tuple-key +K5+)
+(def-tuple-key +K6+)
+(def-tuple-key +K7+)
+(def-tuple-key +K8+)
+(def-tuple-key +K9+)
 
 
 (defun run-test-suite (n-iterations &optional random-seed)
@@ -122,12 +122,12 @@
       (test (unequal? (seq 'a 3 'c) (seq 'a 3.0 'c)))
       (test (less-than? (seq 'a 3 'c) (seq 'a 3.0 'd)))
       (test (less-than? (seq) (tuple)))
-      (test (equal (convert 'list (eval '(tuple (k0 1) ($ (tuple (k1 2) (k2 3)))
-					        (k0 2) ($ (tuple (k4 7) (k2 8))))))
-		   `((,k0 . 2) (,k1 . 2) (,k2 . 8) (,k4 . 7))))
-      (test (less-than? (tuple (k0 1)) (tuple (k0 2))))
-      (test (unequal? (tuple (k0 1.0) (k1 'c)) (tuple (k0 1) (k1 'c))))
-      (test (less-than? (tuple (k0 1.0) (k1 'c)) (tuple (k0 1) (k1 'd))))
+      (test (equal (convert 'list (eval '(tuple (+K0+ 1) ($ (tuple (+K1+ 2) (+K2+ 3)))
+					        (+K0+ 2) ($ (tuple (+K4+ 7) (+K2+ 8))))))
+		   `((,+K0+ . 2) (,+K1+ . 2) (,+K2+ . 8) (,+K4+ . 7))))
+      (test (less-than? (tuple (+K0+ 1)) (tuple (+K0+ 2))))
+      (test (unequal? (tuple (+K0+ 1.0) (+K1+ 'c)) (tuple (+K0+ 1) (+K1+ 'c))))
+      (test (less-than? (tuple (+K0+ 1.0) (+K1+ 'c)) (tuple (+K0+ 1) (+K1+ 'd))))
       (test (empty? (set)))
       (test (empty? (map)))
       (test (empty? (bag)))
@@ -301,16 +301,16 @@
       (error "Set arb/contains? failed (fs1) on iteration ~D" i))
     (unless (member (compare (least fs0)
 			     (reduce (lambda (mi1 mi2)
-				       (if (< (my-integer-value mi1)
-					      (my-integer-value mi2))
+				       (if (< (My-Integer-Value mi1)
+					      (My-Integer-Value mi2))
 					   mi1 mi2))
 				     s0))
 		    '(:equal :unequal))
       (error "Set least failed on iteration ~D" i))
     (unless (member (compare (greatest fs0)
 			     (reduce (lambda (mi1 mi2)
-				       (if (> (my-integer-value mi1)
-					      (my-integer-value mi2))
+				       (if (> (My-Integer-Value mi1)
+					      (My-Integer-Value mi2))
 					   mi1 mi2))
 				     s0))
 		    '(:equal :unequal))
@@ -429,16 +429,16 @@
       (error "Map arb/contains? failed (fm1) on iteration ~D" i))
     (unless (member (compare (least fm0)
 			     (reduce (lambda (mi1 mi2)
-				       (if (< (my-integer-value mi1)
-					      (my-integer-value mi2))
+				       (if (< (My-Integer-Value mi1)
+					      (My-Integer-Value mi2))
 					   mi1 mi2))
 				     (mapcar #'car m0)))
 		    '(:equal :unequal))
       (error "Map least failed on iteration ~D" i))
     (unless (member (compare (greatest fm0)
 			     (reduce (lambda (mi1 mi2)
-				       (if (> (my-integer-value mi1)
-					      (my-integer-value mi2))
+				       (if (> (My-Integer-Value mi1)
+					      (My-Integer-Value mi2))
 					   mi1 mi2))
 				     (mapcar #'car m0)))
 		    '(:equal :unequal))
@@ -586,16 +586,16 @@
       (error "Bag arb/contains? failed (fb1) on iteration ~D" i))
     (unless (member (compare (least fb0)
 			     (reduce (lambda (mi1 mi2)
-				       (if (< (my-integer-value mi1)
-					      (my-integer-value mi2))
+				       (if (< (My-Integer-Value mi1)
+					      (My-Integer-Value mi2))
 					   mi1 mi2))
 				     (mapcar #'car b0)))
 		    '(:equal :unequal))
       (error "Bag least failed on iteration ~D" i))
     (unless (member (compare (greatest fb0)
 			     (reduce (lambda (mi1 mi2)
-				       (if (> (my-integer-value mi1)
-					      (my-integer-value mi2))
+				       (if (> (My-Integer-Value mi1)
+					      (My-Integer-Value mi2))
 					   mi1 mi2))
 				     (mapcar #'car b0)))
 		    '(:equal :unequal))
@@ -785,7 +785,7 @@
 	(error "Find failed on iteration ~D" i)))))
 
 
-(deflex Tuple-Keys (vector K0 K1 K2 K3 K4 K5 K6 K7 K8 K9))
+(deflex Tuple-Keys (vector +K0+ +K1+ +K2+ +K3+ +K4+ +K5+ +K6+ +K7+ +K8+ +K9+))
 
 (defun Test-Tuple-Operations (i)
   (let ((tup (tuple))

Modified: trunk/Code/tuples.lisp
==============================================================================
--- trunk/Code/tuples.lisp	(original)
+++ trunk/Code/tuples.lisp	Mon Nov 10 05:44:30 2008
@@ -510,8 +510,8 @@
   (format stream ">"))
 
 (defmethod compare ((tup1 tuple) (tup2 tuple))
-  (let ((key-set-1 (tuple-desc-key-set (dyn-tuple-descriptor tup1)))
-	(key-set-2 (tuple-desc-key-set (dyn-tuple-descriptor tup2)))
+  (let ((key-set-1 (Tuple-Desc-Key-Set (dyn-tuple-descriptor tup1)))
+	(key-set-2 (Tuple-Desc-Key-Set (dyn-tuple-descriptor tup2)))
 	((res (compare key-set-1 key-set-2)))
 	(default ':equal))
     (if (not (eq res ':equal))




More information about the Fset-cvs mailing list