From 0c4b44c5eb1553ae41d5d037df4db9db500531d1 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Tue, 14 Jun 2005 03:05:19 +0000
Subject: [PATCH] More const fold tests

---
 ansi-tests/acons.lsp            |  5 +++++
 ansi-tests/adjoin.lsp           |  2 ++
 ansi-tests/append.lsp           |  5 +++++
 ansi-tests/butlast.lsp          |  6 ++++++
 ansi-tests/cons-aux.lsp         |  5 +++++
 ansi-tests/cons.lsp             |  2 ++
 ansi-tests/copy-alist.lsp       |  4 ++++
 ansi-tests/copy-tree.lsp        |  4 ++++
 ansi-tests/intersection.lsp     |  2 ++
 ansi-tests/ldiff.lsp            |  5 ++++-
 ansi-tests/list.lsp             | 10 ++++++++++
 ansi-tests/make-list.lsp        |  4 ++++
 ansi-tests/mapc.lsp             |  7 ++-----
 ansi-tests/mapcar.lsp           |  5 +++++
 ansi-tests/maplist.lsp          |  5 +++++
 ansi-tests/pairlis.lsp          |  4 ++++
 ansi-tests/revappend.lsp        |  5 +++++
 ansi-tests/set-difference.lsp   |  2 ++
 ansi-tests/set-exclusive-or.lsp |  4 ++++
 ansi-tests/sublis.lsp           |  4 ++++
 ansi-tests/subst-if-not.lsp     |  2 ++
 ansi-tests/subst-if.lsp         |  2 ++
 ansi-tests/subst.lsp            |  2 ++
 ansi-tests/union.lsp            |  2 ++
 24 files changed, 92 insertions(+), 6 deletions(-)

diff --git a/ansi-tests/acons.lsp b/ansi-tests/acons.lsp
index d4a6ca3b..e97c9f6b 100644
--- a/ansi-tests/acons.lsp
+++ b/ansi-tests/acons.lsp
@@ -47,6 +47,11 @@
   ((a . b)(c . d))
   3 1 2 3)
 
+(def-fold-test acons.fold.1 (acons 'x 'y nil))
+(def-fold-test acons.fold.2 (acons 1 2 '((3 . 4) (5 . 6))))
+
+;;; Error tests
+
 (deftest acons.error.1
   (signals-error (acons) program-error)
   t)
diff --git a/ansi-tests/adjoin.lsp b/ansi-tests/adjoin.lsp
index c0848757..18c3e77a 100644
--- a/ansi-tests/adjoin.lsp
+++ b/ansi-tests/adjoin.lsp
@@ -133,6 +133,8 @@
   (a b c d e)
   5 1 2 3 4 5)
 
+(def-fold-test adjoin.fold.1 (adjoin 'x '(a b c nil d)))
+
 (deftest adjoin.allow-other-keys.1
   (adjoin 'a '(b c) :bad t :allow-other-keys t)
   (a b c))
diff --git a/ansi-tests/append.lsp b/ansi-tests/append.lsp
index 702a7b16..724b9770 100644
--- a/ansi-tests/append.lsp
+++ b/ansi-tests/append.lsp
@@ -62,6 +62,11 @@
   (let ((i 0)) (values (append (incf i)) i))
   1 1)
 
+(def-fold-test append.fold.1 (append '(a b c) nil))
+(def-fold-test append.fold.2 (append nil '(x) nil))
+
+;;; Error tests
+
 (deftest append.error.1
   (signals-error (append '(a . b) '(z))
 		 type-error)
diff --git a/ansi-tests/butlast.lsp b/ansi-tests/butlast.lsp
index 46ac2d4e..f78e8f77 100644
--- a/ansi-tests/butlast.lsp
+++ b/ansi-tests/butlast.lsp
@@ -76,6 +76,12 @@
      i))
   (a b c) 1)
 
+(def-fold-test butlast.fold.1 (butlast '(a b) 1))
+(def-fold-test butlast.fold.2 (butlast '(a b c d e f) 3))
+(def-fold-test butlast.fold.3 (butlast '(a b c d e f g h i) 7))
+
+;;; Error tests
+
 (deftest butlast.error.1
   (signals-error (butlast (copy-tree '(a b c d)) 'a)
 		 type-error)
diff --git a/ansi-tests/cons-aux.lsp b/ansi-tests/cons-aux.lsp
index e5f2e137..a47467ac 100644
--- a/ansi-tests/cons-aux.lsp
+++ b/ansi-tests/cons-aux.lsp
@@ -617,3 +617,8 @@
     (cons nil (rev-assoc-list (cdr x))))
    (t
     (acons (cdar x) (caar x) (rev-assoc-list (cdr x))))))
+
+(defvar *mapc.6-var* nil)
+(defun mapc.6-fun (x)
+  (push x *mapc.6-var*)
+  x)
diff --git a/ansi-tests/cons.lsp b/ansi-tests/cons.lsp
index ae3ee676..2e1edab3 100644
--- a/ansi-tests/cons.lsp
+++ b/ansi-tests/cons.lsp
@@ -36,6 +36,8 @@
   (let ((i 0)) (values (cons (incf i) (incf i)) i))
   (1 . 2) 2)
 
+(def-fold-test cons.fold.1 (cons 'a 'b))
+
 ;;; Error tests
 
 (deftest cons.error.1
diff --git a/ansi-tests/copy-alist.lsp b/ansi-tests/copy-alist.lsp
index 9eaed81d..b72d1574 100644
--- a/ansi-tests/copy-alist.lsp
+++ b/ansi-tests/copy-alist.lsp
@@ -25,6 +25,10 @@
        t))
   t)
 
+(def-fold-test copy-alist.1 (copy-alist '((a . b) nil (c . d))))
+(def-fold-test copy-alist.2 (car (copy-alist '((a . b) nil (c . d)))))
+(def-fold-test copy-alist.3 (caddr (copy-alist '((a . b) nil (c . d)))))
+
 ;;; Error tests
 
 (deftest copy-alist.error.1
diff --git a/ansi-tests/copy-tree.lsp b/ansi-tests/copy-tree.lsp
index 390c6a0b..1c6ad0e7 100644
--- a/ansi-tests/copy-tree.lsp
+++ b/ansi-tests/copy-tree.lsp
@@ -34,6 +34,10 @@
      i))
   (a b c) 1)
 
+(def-fold-test copy-tree.fold.1 (copy-tree '(a . b)))
+(def-fold-test copy-tree.fold.2 (copy-tree '(a)))
+(def-fold-test copy-tree.fold.3 (copy-tree '(a b c d e)))
+
 ;;; Error tests
 
 (deftest copy-tree.error.1
diff --git a/ansi-tests/intersection.lsp b/ansi-tests/intersection.lsp
index 13ceaf37..2c76fb42 100644
--- a/ansi-tests/intersection.lsp
+++ b/ansi-tests/intersection.lsp
@@ -349,6 +349,8 @@
    #'<)
   (3 4))
 
+(def-fold-test intersection.fold.1 (intersection '(a b c d e f) '(d w a x b y)))
+
 ;;; Error tests
 
 (deftest intersection.error.1
diff --git a/ansi-tests/ldiff.lsp b/ansi-tests/ldiff.lsp
index d682b0f0..6f502995 100644
--- a/ansi-tests/ldiff.lsp
+++ b/ansi-tests/ldiff.lsp
@@ -105,7 +105,10 @@
 	    (progn (setf y (incf i))
 		   'd))
      i x y))
-  (a b c) 2 1 2)       
+  (a b c) 2 1 2)
+
+(def-fold-test ldiff.fold.1 (ldiff '(a b c) 'x))
+(def-fold-test ldiff.fold.2 (let ((x '(a b c))) (ldiff x (cddr x))))
 
 ;; Error checking
 
diff --git a/ansi-tests/list.lsp b/ansi-tests/list.lsp
index 5fe585ad..2b352632 100644
--- a/ansi-tests/list.lsp
+++ b/ansi-tests/list.lsp
@@ -34,6 +34,12 @@
 	  (incf i) (incf i) (incf i) (incf i)))
   (1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16))
 
+(def-fold-test list.fold.1 (list 'a))
+(def-fold-test list.fold.2 (list 'a 'b))
+(def-fold-test list.fold.3 (list 'a 'b 'c 'd 'e 'f))
+
+;;; LIST* tests
+
 (deftest list*.1
   (list* 1 2 3)
   (1 2 . 3))
@@ -62,3 +68,7 @@
 	   (incf i) (incf i) (incf i) (incf i)
 	   (incf i) (incf i) (incf i) (incf i)))
   (1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 . 16))
+
+(def-fold-test list*.fold.1 (list* 'a 'b))
+(def-fold-test list*.fold.2 (list* 'a 'b 'c))
+(def-fold-test list*.fold.3 (list* 'a 'b 'c 'd 'e 'f))
diff --git a/ansi-tests/make-list.lsp b/ansi-tests/make-list.lsp
index 671f1b61..84010d2a 100644
--- a/ansi-tests/make-list.lsp
+++ b/ansi-tests/make-list.lsp
@@ -69,6 +69,10 @@
   (a a a a a)
   3 1 2 3)
 
+(def-fold-test make-list.fold.1 (make-list 1))
+(def-fold-test make-list.fold.2 (make-list 10 :initial-element 'x))
+
+;;; Error tests
 
 (deftest make-list.error.1
   (check-type-error #'make-list (typef 'unsigned-byte))
diff --git a/ansi-tests/mapc.lsp b/ansi-tests/mapc.lsp
index cf1b78d0..70494fd0 100644
--- a/ansi-tests/mapc.lsp
+++ b/ansi-tests/mapc.lsp
@@ -46,11 +46,6 @@
      x))
   ((a a a a a) 3))
 
-(defvar *mapc.6-var* nil)
-(defun mapc.6-fun (x)
-  (push x *mapc.6-var*)
-  x)
-
 (deftest mapc.6
   (let* ((x (copy-list '(a b c d e f g h)))
 	 (xcopy (make-scaffold-copy x)))
@@ -73,6 +68,8 @@
      i x y z))
   (a b c) 3 1 2 3)
 
+;;; Error tests
+
 (deftest mapc.error.1
   (check-type-error #'(lambda (x) (mapc #'identity x)) #'listp)
   nil)
diff --git a/ansi-tests/mapcar.lsp b/ansi-tests/mapcar.lsp
index 1b8598b1..e1db5f8c 100644
--- a/ansi-tests/mapcar.lsp
+++ b/ansi-tests/mapcar.lsp
@@ -80,6 +80,11 @@
   ((a 1) (b 2) (c 3))
   3 1 2 3)
 
+(def-fold-test mapcar.fold.1 (mapcar 'identity '(a b c d)))
+(def-fold-test mapcar.fold.2 (mapcar 'not '(t nil nil t t)))
+
+;;; Error tests
+
 (deftest mapcar.error.1
   (check-type-error #'(lambda (x) (mapcar #'identity x)) #'listp)
   nil)
diff --git a/ansi-tests/maplist.lsp b/ansi-tests/maplist.lsp
index b452ce05..14a75968 100644
--- a/ansi-tests/maplist.lsp
+++ b/ansi-tests/maplist.lsp
@@ -94,6 +94,11 @@
      i x y z))
   (1 2 3) 3 1 2 3)
 
+(def-fold-test maplist.fold.1 (maplist 'car '(a b c d e)))
+(def-fold-test maplist.fold.2 (maplist #'cadr '(a b c d e)))
+
+;;; Error tests
+
 (deftest maplist.error.1
   (check-type-error #'(lambda (x) (maplist #'identity x)) #'listp)
   nil)
diff --git a/ansi-tests/pairlis.lsp b/ansi-tests/pairlis.lsp
index ad0e31f4..658e18e7 100644
--- a/ansi-tests/pairlis.lsp
+++ b/ansi-tests/pairlis.lsp
@@ -63,6 +63,10 @@
        t))
   t)
 
+(def-fold-test pairlis.fold.1 (pairlis '(a b) '(c d)))
+
+;;; Error tests
+
 (deftest pairlis.error.1
   (signals-error (pairlis) program-error)
   t)
diff --git a/ansi-tests/revappend.lsp b/ansi-tests/revappend.lsp
index f711cfa1..ba18db90 100644
--- a/ansi-tests/revappend.lsp
+++ b/ansi-tests/revappend.lsp
@@ -41,6 +41,11 @@
      i x y))
   (c b a d e f) 2 1 2)
 
+(def-fold-test revappend.fold.1 (revappend '(x) nil))
+(def-fold-test revappend.fold.2 (revappend '(x y z) nil))
+
+;;; Error tests
+
 (deftest revappend.error.1
   (signals-error (revappend) program-error)
   t)
diff --git a/ansi-tests/set-difference.lsp b/ansi-tests/set-difference.lsp
index c10c7ffa..6bb8359f 100644
--- a/ansi-tests/set-difference.lsp
+++ b/ansi-tests/set-difference.lsp
@@ -270,6 +270,8 @@
    #'<)
   nil)
 
+(def-fold-test set-difference.fold.1 (set-difference '(a b c d e f g h) '(b w h x e y)))
+
 ;;; Error tests
 
 
diff --git a/ansi-tests/set-exclusive-or.lsp b/ansi-tests/set-exclusive-or.lsp
index f2a3e2f3..0d7575a3 100644
--- a/ansi-tests/set-exclusive-or.lsp
+++ b/ansi-tests/set-exclusive-or.lsp
@@ -313,6 +313,10 @@
 	#'<)
   nil)
 
+(def-fold-test set-exclusive-or.fold.1 (set-exclusive-or '(a b c d e f) '(b x e y z c)))
+
+;;; Error tests
+
 (deftest set-exclusive-or.error.1
   (signals-error (set-exclusive-or) program-error)
   t)
diff --git a/ansi-tests/sublis.lsp b/ansi-tests/sublis.lsp
index daa2e49e..46d76d49 100644
--- a/ansi-tests/sublis.lsp
+++ b/ansi-tests/sublis.lsp
@@ -116,6 +116,10 @@
   (z b c d)
   4 1 2 3 4)
 
+;;; Const fold tests
+
+(def-fold-test sublis.fold.1 (sublis '((a . b)) '(a x y . a)))
+
 
 ;;; Keyword tests
 
diff --git a/ansi-tests/subst-if-not.lsp b/ansi-tests/subst-if-not.lsp
index bbc93fe7..664a0afb 100644
--- a/ansi-tests/subst-if-not.lsp
+++ b/ansi-tests/subst-if-not.lsp
@@ -53,6 +53,8 @@
      i w x y z))
   (1 2 a a c)
   4 1 2 3 4)
+
+(def-fold-test subst-if-not.fold.1 (subst-if-not 'a #'consp '((1 . 2) 3 . 4)))
   
 ;;; Keywords tests for subst-if-not
 
diff --git a/ansi-tests/subst-if.lsp b/ansi-tests/subst-if.lsp
index cb2cdaa7..0546248d 100644
--- a/ansi-tests/subst-if.lsp
+++ b/ansi-tests/subst-if.lsp
@@ -56,6 +56,8 @@
   (1 2 a a c)
   4 1 2 3 4)
 
+(def-fold-test subst-if.fold.1 (subst-if 'x 'numberp '(a b 3 (4) c d . 12)))
+
 ;;; Keyword tests for subst-if
 
 (deftest subst-if.allow-other-keys.1
diff --git a/ansi-tests/subst.lsp b/ansi-tests/subst.lsp
index 11a6026b..0de24a19 100644
--- a/ansi-tests/subst.lsp
+++ b/ansi-tests/subst.lsp
@@ -107,7 +107,9 @@
   ((10 b . b) b b c ((b)) z)
   5 1 2 3 4 5)
 
+;;; Const fold tests
 
+(def-fold-test subst.fold.1 (subst 'a 'b '(a b c (a . b) . a)))
 
 ;;; Keyword tests for subst
 
diff --git a/ansi-tests/union.lsp b/ansi-tests/union.lsp
index b4309cd3..0bb1fd5d 100644
--- a/ansi-tests/union.lsp
+++ b/ansi-tests/union.lsp
@@ -363,6 +363,8 @@
 	#'<)
   (1 1 2 2 3 3))
 
+(def-fold-test union.fold.1 (union '(a b c d e) '(d x y a w c)))
+
 ;;; Error tests
 
 (deftest union.error.1
-- 
GitLab