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