From 13cfae2b9e227542bc84639d244f7086df3b4018 Mon Sep 17 00:00:00 2001 From: Kilian Sprotte <kilian.sprotte@gmail.com> Date: Sun, 1 Nov 2009 17:16:43 +0200 Subject: [PATCH] Fixed conjoin single predicate bug; more tests Added new test cases for DISJOIN, CONJOIN, COMPOSE and MULTIPLE-VALUE-COMPOSE. All of them testing for the edge case of a single predicate / function. --- functions.lisp | 24 +++++++++++++----------- tests.lisp | 23 +++++++++++++++++++++++ 2 files changed, 36 insertions(+), 11 deletions(-) diff --git a/functions.lisp b/functions.lisp index d8acb86..8d2fd38 100644 --- a/functions.lisp +++ b/functions.lisp @@ -37,16 +37,18 @@ If none of the predicates returns true, NIL is returned." functions in turn to its arguments, returning NIL if any of the predicates returns false, without calling the remaining predicates. If none of the predicates returns false, returns the primary value of the last predicate." - (lambda (&rest arguments) - (and (apply predicate arguments) - ;; Cannot simply use CL:EVERY because we want to return the - ;; non-NIL value of the last predicate if all succeed. - (do ((tail (cdr more-predicates) (cdr tail)) - (head (car more-predicates) (car tail))) - ((not tail) - (apply head arguments)) - (unless (apply head arguments) - (return nil)))))) + (if (null more-predicates) + predicate + (lambda (&rest arguments) + (and (apply predicate arguments) + ;; Cannot simply use CL:EVERY because we want to return the + ;; non-NIL value of the last predicate if all succeed. + (do ((tail (cdr more-predicates) (cdr tail)) + (head (car more-predicates) (car tail))) + ((not tail) + (apply head arguments)) + (unless (apply head arguments) + (return nil))))))) (defun compose (function &rest more-functions) @@ -79,7 +81,7 @@ and then calling the next one with the primary value of the last." (defun multiple-value-compose (function &rest more-functions) "Returns a function composed of FUNCTION and MORE-FUNCTIONS that applies -its arguments to to each in turn, starting from the rightmost of +its arguments to each in turn, starting from the rightmost of MORE-FUNCTIONS, and then calling the next one with all the return values of the last." (declare (optimize (speed 3) (safety 1) (debug 1))) diff --git a/tests.lisp b/tests.lisp index e76a7d3..722f97f 100644 --- a/tests.lisp +++ b/tests.lisp @@ -346,6 +346,12 @@ (funcall disjunction "test"))) (nil :cons :string)) +(deftest disjoin.2 + (let ((disjunction (disjoin #'zerop))) + (list (funcall disjunction 0) + (funcall disjunction 1))) + (t nil)) + (deftest conjoin.1 (let ((conjunction (conjoin #'consp (lambda (x) @@ -357,6 +363,12 @@ (funcall conjunction '("foo")))) (nil nil #\f)) +(deftest conjoin.2 + (let ((conjunction (conjoin #'zerop))) + (list (funcall conjunction 0) + (funcall conjunction 1))) + (t nil)) + (deftest compose.1 (let ((composite (compose '1+ (lambda (x) @@ -386,6 +398,12 @@ (funcall fun "3"))) 7) +(deftest compose.4 + (let ((composite (compose #'zerop))) + (list (funcall composite 0) + (funcall composite 1))) + (t nil)) + (deftest multiple-value-compose.1 (let ((composite (multiple-value-compose #'truncate @@ -423,6 +441,11 @@ (multiple-value-list (funcall fun "2 9")))) (4 1)) +(deftest multiple-value-compose.4 + (let ((composite (multiple-value-compose #'truncate))) + (multiple-value-list (funcall composite 9 2))) + (4 1)) + (deftest curry.1 (let ((curried (curry '+ 3))) (funcall curried 1 5)) -- GitLab