[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