mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

(scheme base) member: return #f, not (), for no match

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

Thanks to Erik Dominikus for reporting the problem.

Closes: 43304
This commit is contained in:
Rob Browning 2020-10-04 10:43:09 -05:00
parent 7a1cd29637
commit f1547e1d58
3 changed files with 7 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

2
THANKS
View file

@ -2,6 +2,7 @@ Contributors since the last release:
Christopher Baines Christopher Baines
Greg Benison Greg Benison
Rob Browning
Tristan Colgate-McFarlane Tristan Colgate-McFarlane
Aleix Conchillo Flaqué Aleix Conchillo Flaqué
Ludovic Courtès Ludovic Courtès
@ -79,6 +80,7 @@ For fixes or providing information which led to a fix:
Josh Datko Josh Datko
David Diffenbaugh David Diffenbaugh
Hyper Division Hyper Division
Erik Dominikus
Alexandre Duret-Lutz Alexandre Duret-Lutz
Nils Durner Nils Durner
John W Eaton John W Eaton

7
module/scheme/base.scm
View file

@ -129,9 +129,10 @@
(unless (procedure? =) (unless (procedure? =)
(error "not a procedure" =)) (error "not a procedure" =))
(let lp ((ls ls)) (let lp ((ls ls))
(if (or (null? ls) (= (car ls) x)) (cond
ls ((null? ls) #f)
(lp (cdr ls))))))) ((= (car ls) x) ls)
(else (lp (cdr ls))))))))
(define* (assoc x ls #:optional (= equal?)) (define* (assoc x ls #:optional (= equal?))
(cond (cond

2
test-suite/tests/r7rs.test
View file

@ -2171,7 +2171,7 @@
(let ((out (open-output-string)) (let ((out (open-output-string))
(x (list 1))) (x (list 1)))
(set-cdr! x x) (set-cdr! x x)
(write x out) (write-shared x out)
(get-output-string out)) (get-output-string out))
;; labels not guaranteed to be 0 indexed, spacing may differ ;; labels not guaranteed to be 0 indexed, spacing may differ
'("#0=(1 . #0#)" "#1=(1 . #1#)")) '("#0=(1 . #0#)" "#1=(1 . #1#)"))