[PATCH 1/1] (scheme base) member: return #f, not (), for no match

[PATCH 1/1] (scheme base) member: return #f, not (), for no match

[Rob Browning]

* module/scheme/base.scm (member): Match the r7rs requirement, as assoc
  already does.

Thanks to Erik Dominikus for reporting the problem.

Closes: 43304
---

 Proposed for 3.0

 module/scheme/base.scm | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/module/scheme/base.scm b/module/scheme/base.scm
index 5a366f846..94591477d 100644
--- a/module/scheme/base.scm
+++ b/module/scheme/base.scm
@@ -129,9 +129,10 @@
     (unless (procedure? =)
       (error "not a procedure" =))
     (let lp ((ls ls))
-      (if (or (null? ls) (= (car ls) x))
-          ls
-          (lp (cdr ls)))))))
+      (cond
+       ((null? ls) #f)
+       ((= (car ls) x) ls)
+       (else (lp (cdr ls))))))))
 
 (define* (assoc x ls #:optional (= equal?))
   (cond
-- 
2.26.1

Re: [PATCH 1/1] (scheme base) member: return #f, not (), for no match

[Rob Browning]

Rob Browning <rlb@defaultvalue.org> writes:

> * module/scheme/base.scm (member): Match the r7rs requirement, as assoc
>   already does.
>
> Thanks to Erik Dominikus for reporting the problem.
>
> Closes: 43304
> ---
>
>  Proposed for 3.0

Hmm, this causes a failure in r7rs.test.  Not sure if I made a mistake,
or if other code depends on the incorrect behavior.  Looking in to it.

-- 
Rob Browning
rlb @defaultvalue.org and @debian.org
GPG as of 2011-07-10 E6A9 DA3C C9FD 1FF8 C676 D2C4 C0F0 39E9 ED1B 597A
GPG as of 2002-11-03 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4

Re: [PATCH 1/1] (scheme base) member: return #f, not (), for no match

[Rob Browning]

Rob Browning <rlb@defaultvalue.org> writes:

> Hmm, this causes a failure in r7rs.test.  Not sure if I made a mistake,
> or if other code depends on the incorrect behavior.  Looking in to it.

Ahh, it just revealed a bug in r7rs.test, i.e.:

diff --git a/test-suite/tests/r7rs.test b/test-suite/tests/r7rs.test
index 0914f0c5e..1cc8cd31e 100644
--- a/test-suite/tests/r7rs.test
+++ b/test-suite/tests/r7rs.test
@@ -2171,7 +2171,7 @@
        (let ((out (open-output-string))
              (x (list 1)))
          (set-cdr! x x)
-         (write x out)
+         (write-shared x out)
          (get-output-string out))
        ;; labels not guaranteed to be 0 indexed, spacing may differ
        '("#0=(1 . #0#)" "#1=(1 . #1#)"))

I'll add that to the commit.

-- 
Rob Browning
rlb @defaultvalue.org and @debian.org
GPG as of 2011-07-10 E6A9 DA3C C9FD 1FF8 C676 D2C4 C0F0 39E9 ED1B 597A
GPG as of 2002-11-03 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4