Explicit definitions for `memp' and `assp' in `(rnrs list)'; the predicate

argument to Guile's `member' and `assoc' functions has a different expected
arity.

* module/rnrs/lists.scm (memp, assp): Wrap the predicate function with a
  two-argument wrapper before calling Guile's underlying implemenation.
* test-suite/Makefile.am: Add test-suite/tests/r6rs-lists.test to
  SCM_TESTS.
* test-suite/tests/r6rs-lists.test: New file.

3 files changed, 35 insertions, 2 deletions

diff --git a/module/rnrs/lists.scm b/module/rnrs/lists.scm
index c9d913b29..812ce5f98 100644
--- a/module/rnrs/lists.scm
+++ b/module/rnrs/lists.scm
@@ -44,6 +44,6 @@
   (define (remv obj list) (remp (lambda (elt) (eqv? obj elt)) list))
   (define (remq obj list) (remp (lambda (elt) (eq? obj elt)) list))
 
-  (define (memp pred list) (memp-internal #f list pred))
-  (define (assp pred list) (assp-internal #f list pred))
+  (define (memp pred list) (memp-internal #f list (lambda (x y) (pred y))))
+  (define (assp pred list) (assp-internal #f list (lambda (x y) (pred y))))
 )
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 078df792f..eab1cd5f0 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -88,6 +88,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/r6rs-exceptions.test		\
 	    tests/r6rs-files.test		\
 	    tests/r6rs-hashtables.test		\
+	    tests/r6rs-lists.test		\
 	    tests/r6rs-ports.test		\
 	    tests/r6rs-records-inspection.test	\
 	    tests/r6rs-records-procedural.test	\
diff --git a/test-suite/tests/r6rs-lists.test b/test-suite/tests/r6rs-lists.test
new file mode 100644
index 000000000..ba645ed01
--- /dev/null
+++ b/test-suite/tests/r6rs-lists.test
@@ -0,0 +1,32 @@
+;;; r6rs-lists.test --- Test suite for R6RS (rnrs lists)
+
+;;      Copyright (C) 2010 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (test-suite test-r6rs-lists)
+  :use-module ((rnrs lists) :version (6))
+  :use-module (test-suite lib))
+
+(with-test-prefix "memp"
+  (pass-if "memp simple" 
+    (equal? (memp even? '(3 1 4 1 5 9 2 6 5)) '(4 1 5 9 2 6 5))))
+
+(with-test-prefix "assp"
+  (pass-if "assp simple"
+    (let ((d '((3 a) (1 b) (4 c))))
+      (equal? (assp even? d) '(4 c)))))
+