diff options
author | Rob Browning <rlb@defaultvalue.org> | 2020-10-04 10:43:09 -0500 |
---|---|---|
committer | Rob Browning <rlb@defaultvalue.org> | 2021-01-17 13:25:40 -0600 |
commit | f1547e1d58ae369538bf4b6c8f12c6db1399e8c7 (patch) | |
tree | fd5fa2ec03f6b816400e86afaac2fc607696a955 | |
parent | 7a1cd29637749c5c8eb9ccff4354530ffb62d432 (diff) | |
download | guile-f1547e1d58ae369538bf4b6c8f12c6db1399e8c7.tar.gz |
(scheme base) member: return #f, not (), for no match
* module/scheme/base.scm (member): Match the r7rs requirement, as assoc
already does.
Thanks to Erik Dominikus for reporting the problem.
Closes: 43304
-rw-r--r-- | THANKS | 2 | ||||
-rw-r--r-- | module/scheme/base.scm | 7 | ||||
-rw-r--r-- | test-suite/tests/r7rs.test | 2 |
3 files changed, 7 insertions, 4 deletions
@@ -2,6 +2,7 @@ Contributors since the last release: Christopher Baines Greg Benison + Rob Browning Tristan Colgate-McFarlane Aleix Conchillo Flaqué Ludovic Courtès @@ -79,6 +80,7 @@ For fixes or providing information which led to a fix: Josh Datko David Diffenbaugh Hyper Division + Erik Dominikus Alexandre Duret-Lutz Nils Durner John W Eaton diff --git a/module/scheme/base.scm b/module/scheme/base.scm index b97259f18..20e280467 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 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#)")) |