summaryrefslogtreecommitdiff
path: root/test-suite/tests/srfi-1.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/srfi-1.test')
-rw-r--r--test-suite/tests/srfi-1.test149
1 files changed, 75 insertions, 74 deletions
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index dc3e47f50..558934df4 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -21,6 +21,8 @@
#:use-module (ice-9 copy-tree)
#:use-module (srfi srfi-1))
+(define list+-bad-arg-exception
+ '(wrong-type-arg . "^Argument not a proper or circular list"))
(define (ref-delete x lst . proc)
"Reference implemenation of srfi-1 `delete'."
@@ -463,10 +465,10 @@
(pass-if-exception "too many args" exception:wrong-num-args
(concatenate-proc '() '()))
- (pass-if-exception "number" exception:wrong-type-arg
+ (pass-if-exception "number" '(wrong-type-arg . "Apply to non-list")
(concatenate-proc 123))
- (pass-if-exception "vector" exception:wrong-type-arg
+ (pass-if-exception "vector" '(wrong-type-arg . "Apply to non-list")
(concatenate-proc #(1 2 3)))
(pass-if "no lists"
@@ -1188,18 +1190,18 @@
(pass-if-exception "proc arg count 4" exception:wrong-num-args
(fold (lambda (x y z prev) x) 1 '(1 2 3) '(1 2 3)))
- (pass-if-exception "improper first 1" exception:wrong-type-arg
+ (pass-if-exception "improper first 1" list+-bad-arg-exception
(fold + 1 1 '(1 2 3)))
- (pass-if-exception "improper first 2" exception:wrong-type-arg
+ (pass-if-exception "improper first 2" list+-bad-arg-exception
(fold + 1 '(1 . 2) '(1 2 3)))
- (pass-if-exception "improper first 3" exception:wrong-type-arg
+ (pass-if-exception "improper first 3" list+-bad-arg-exception
(fold + 1 '(1 2 . 3) '(1 2 3)))
- (pass-if-exception "improper second 1" exception:wrong-type-arg
+ (pass-if-exception "improper second 1" list+-bad-arg-exception
(fold + 1 '(1 2 3) 1))
- (pass-if-exception "improper second 2" exception:wrong-type-arg
+ (pass-if-exception "improper second 2" list+-bad-arg-exception
(fold + 1 '(1 2 3) '(1 . 2)))
- (pass-if-exception "improper second 3" exception:wrong-type-arg
+ (pass-if-exception "improper second 3" list+-bad-arg-exception
(fold + 1 '(1 2 3) '(1 2 . 3)))
(pass-if (= 6 (fold + 1 '(2) '(3))))
@@ -1330,9 +1332,9 @@
(length+))
(pass-if-exception "too many args" exception:wrong-num-args
(length+ 123 456))
- (pass-if-exception "not a pair" exception:wrong-type-arg
+ (pass-if-exception "not a pair" list+-bad-arg-exception
(length+ 'x))
- (pass-if-exception "improper list" exception:wrong-type-arg
+ (pass-if-exception "improper list" list+-bad-arg-exception
(length+ '(x y . z)))
(pass-if (= 0 (length+ '())))
(pass-if (= 1 (length+ '(x))))
@@ -1449,7 +1451,14 @@
(pass-if (equal? '(1 . 2) (list-copy '(1 . 2))))
(pass-if (equal? '(1 2 . 3) (list-copy '(1 2 . 3))))
(pass-if (equal? '(1 2 3 . 4) (list-copy '(1 2 3 . 4))))
- (pass-if (equal? '(1 2 3 4 . 5) (list-copy '(1 2 3 4 . 5)))))
+ (pass-if (equal? '(1 2 3 4 . 5) (list-copy '(1 2 3 4 . 5))))
+
+ (let ((src (list 1 2 3 4 5)))
+ (define (find-pair? p lst)
+ (let lp ((lst lst))
+ (and (pair? lst) (or (eq? p lst) (lp (cdr lst))))))
+ (pair-for-each (lambda (p) (pass-if (not (find-pair? p src))))
+ (list-copy src))))
;;
;; list-index
@@ -1760,72 +1769,64 @@
(equal? '(1 2) (lset-adjoin = '(2) 1 1))))
;;
-;; lset-difference
+;; lset-difference and lset-difference!
;;
-(with-test-prefix "lset-difference"
-
- (pass-if "called arg order"
- (let ((good #f))
- (lset-difference (lambda (x y)
- (set! good (and (= x 1) (= y 2)))
- (= x y))
- '(1) '(2))
- good)))
+(begin
+ (define (test-shared-behavior diff)
+ (pass-if-exception "proc - num" exception:wrong-type-arg
+ (diff 123 '(4)))
+ (pass-if-exception "proc - list" exception:wrong-type-arg
+ (diff (list 1 2 3) '(4)))
-;;
-;; lset-difference!
-;;
-
-(with-test-prefix "lset-difference!"
-
- (pass-if-exception "proc - num" exception:wrong-type-arg
- (lset-difference! 123 '(4)))
- (pass-if-exception "proc - list" exception:wrong-type-arg
- (lset-difference! (list 1 2 3) '(4)))
-
- (pass-if "called arg order"
- (let ((good #f))
- (lset-difference! (lambda (x y)
- (set! good (and (= x 1) (= y 2)))
- (= x y))
- (list 1) (list 2))
- good))
-
- (pass-if (equal? '() (lset-difference! = '())))
- (pass-if (equal? '(1) (lset-difference! = (list 1))))
- (pass-if (equal? '(1 2) (lset-difference! = (list 1 2))))
-
- (pass-if (equal? '() (lset-difference! = (list ) '(3))))
- (pass-if (equal? '() (lset-difference! = (list 3) '(3))))
- (pass-if (equal? '(1) (lset-difference! = (list 1 3) '(3))))
- (pass-if (equal? '(1) (lset-difference! = (list 3 1) '(3))))
- (pass-if (equal? '(1) (lset-difference! = (list 1 3 3) '(3))))
- (pass-if (equal? '(1) (lset-difference! = (list 3 1 3) '(3))))
- (pass-if (equal? '(1) (lset-difference! = (list 3 3 1) '(3))))
-
- (pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(2 3))))
- (pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(3 2))))
- (pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(3) '(2))))
- (pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(2) '(3))))
- (pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(2) '(2 3))))
- (pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(2) '(3 2))))
-
- (pass-if (equal? '(1 2) (lset-difference! = (list 1 2 3) '(3) '(3))))
- (pass-if (equal? '(1 2) (lset-difference! = (list 1 3 2) '(3) '(3))))
- (pass-if (equal? '(1 2) (lset-difference! = (list 3 1 2) '(3) '(3))))
-
- (pass-if (equal? '(1 2 3) (lset-difference! = (list 1 2 3 4) '(4))))
- (pass-if (equal? '(1 2 3) (lset-difference! = (list 1 2 4 3) '(4))))
- (pass-if (equal? '(1 2 3) (lset-difference! = (list 1 4 2 3) '(4))))
- (pass-if (equal? '(1 2 3) (lset-difference! = (list 4 1 2 3) '(4))))
-
- (pass-if (equal? '(1 2) (lset-difference! = (list 1 2 3 4) '(4) '(3))))
- (pass-if (equal? '(1 2) (lset-difference! = (list 1 3 2 4) '(4) '(3))))
- (pass-if (equal? '(1 2) (lset-difference! = (list 3 1 2 4) '(4) '(3))))
- (pass-if (equal? '(1 2) (lset-difference! = (list 1 3 4 2) '(4) '(3))))
- (pass-if (equal? '(1 2) (lset-difference! = (list 3 1 4 2) '(4) '(3))))
- (pass-if (equal? '(1 2) (lset-difference! = (list 3 4 1 2) '(4) '(3)))))
+ (pass-if "called arg order"
+ (let ((good #f))
+ (diff (lambda (x y)
+ (set! good (and (= x 1) (= y 2)))
+ (= x y))
+ (list 1) (list 2))
+ good))
+
+ (pass-if (equal? '() (diff = '())))
+ (pass-if (equal? '(1) (diff = (list 1))))
+ (pass-if (equal? '(1 2) (diff = (list 1 2))))
+
+ (pass-if (equal? '() (diff = (list ) '(3))))
+ (pass-if (equal? '() (diff = (list 3) '(3))))
+ (pass-if (equal? '(1) (diff = (list 1 3) '(3))))
+ (pass-if (equal? '(1) (diff = (list 3 1) '(3))))
+ (pass-if (equal? '(1) (diff = (list 1 3 3) '(3))))
+ (pass-if (equal? '(1) (diff = (list 3 1 3) '(3))))
+ (pass-if (equal? '(1) (diff = (list 3 3 1) '(3))))
+
+ (pass-if (equal? '(1) (diff = (list 1 2 3) '(2 3))))
+ (pass-if (equal? '(1) (diff = (list 1 2 3) '(3 2))))
+ (pass-if (equal? '(1) (diff = (list 1 2 3) '(3) '(2))))
+ (pass-if (equal? '(1) (diff = (list 1 2 3) '(2) '(3))))
+ (pass-if (equal? '(1) (diff = (list 1 2 3) '(2) '(2 3))))
+ (pass-if (equal? '(1) (diff = (list 1 2 3) '(2) '(3 2))))
+
+ (pass-if (equal? '(1 2) (diff = (list 1 2 3) '(3) '(3))))
+ (pass-if (equal? '(1 2) (diff = (list 1 3 2) '(3) '(3))))
+ (pass-if (equal? '(1 2) (diff = (list 3 1 2) '(3) '(3))))
+
+ (pass-if (equal? '(1 2 3) (diff = (list 1 2 3 4) '(4))))
+ (pass-if (equal? '(1 2 3) (diff = (list 1 2 4 3) '(4))))
+ (pass-if (equal? '(1 2 3) (diff = (list 1 4 2 3) '(4))))
+ (pass-if (equal? '(1 2 3) (diff = (list 4 1 2 3) '(4))))
+
+ (pass-if (equal? '(1 2) (diff = (list 1 2 3 4) '(4) '(3))))
+ (pass-if (equal? '(1 2) (diff = (list 1 3 2 4) '(4) '(3))))
+ (pass-if (equal? '(1 2) (diff = (list 3 1 2 4) '(4) '(3))))
+ (pass-if (equal? '(1 2) (diff = (list 1 3 4 2) '(4) '(3))))
+ (pass-if (equal? '(1 2) (diff = (list 3 1 4 2) '(4) '(3))))
+ (pass-if (equal? '(1 2) (diff = (list 3 4 1 2) '(4) '(3)))))
+
+ (with-test-prefix "lset-difference"
+ (test-shared-behavior lset-difference))
+
+ (with-test-prefix "lset-difference!"
+ (test-shared-behavior lset-difference!)))
;;
;; lset-diff+intersection