From bc4e360bdef5af513d239f06f7dabe7ca27a45ec Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sun, 13 Oct 2002 16:44:49 +0000 Subject: [PATCH] Fixed test bugs found by Sam Steingold. --- ansi-tests/cons-test-07.lsp | 17 +++++++---------- ansi-tests/flet.lsp | 2 +- ansi-tests/functionp.lsp | 4 +++- ansi-tests/labels.lsp | 2 +- 4 files changed, 12 insertions(+), 13 deletions(-) diff --git a/ansi-tests/cons-test-07.lsp b/ansi-tests/cons-test-07.lsp index e4170a19..b9ffae3c 100644 --- a/ansi-tests/cons-test-07.lsp +++ b/ansi-tests/cons-test-07.lsp @@ -139,17 +139,14 @@ ;;; nreconc (deftest nreconc-1 - (let* ((x (list 'a 'b 'c)) - (y (nreverse (loop for e on x collect e)))) - (setf x (nreconc x (copy-tree '(d e f)))) - (and (eq x (car y)) - (eq (cdr x) (cadr y)) - (eq (cddr x) (caddr y)) - x)) + (let* ((x (list 'a 'b 'c)) + (y (copy-tree '(d e f))) + (result (nreconc x y))) + (and (equal y '(d e f)) + result)) (c b a d e f)) (deftest nreconc-2 - (handler-case - (nreconc nil 'a) - (error (c) c)) + (nreconc nil 'a) a) + diff --git a/ansi-tests/flet.lsp b/ansi-tests/flet.lsp index 44bac4d5..ec6199ae 100644 --- a/ansi-tests/flet.lsp +++ b/ansi-tests/flet.lsp @@ -105,7 +105,7 @@ ;;; Definition of a (setf ...) function (deftest flet.17 - (flet (((setf %f) (x y) (setf (car x) y))) + (flet (((setf %f) (x y) (setf (car y) x))) (let ((z (list 1 2))) (setf (%f z) 'a) z)) diff --git a/ansi-tests/functionp.lsp b/ansi-tests/functionp.lsp index 4b4505fe..afa394b3 100644 --- a/ansi-tests/functionp.lsp +++ b/ansi-tests/functionp.lsp @@ -26,7 +26,9 @@ (deftest functionp.4 (loop for x in *cl-symbol-names* for s = (find-symbol x "CL") - for f = (and (fboundp s) (symbol-function s)) + for f = (and (fboundp s) (symbol-function s) + (not (special-operator-p s)) + (not (macro-function s))) always (or (null f) (functionp f))) t) diff --git a/ansi-tests/labels.lsp b/ansi-tests/labels.lsp index 595df93b..fe1c67c1 100644 --- a/ansi-tests/labels.lsp +++ b/ansi-tests/labels.lsp @@ -104,7 +104,7 @@ ;;; Definition of a (setf ...) function (deftest labels.17 - (labels (((setf %f) (x y) (setf (car x) y))) + (labels (((setf %f) (x y) (setf (car y) x))) (let ((z (list 1 2))) (setf (%f z) 'a) z)) -- GitLab