~ chicken-core (chicken-5) abf5ae1e4a5025cbf03b24c6ce8574ceb5af12b1
commit abf5ae1e4a5025cbf03b24c6ce8574ceb5af12b1
Author: Jim Ursetto <zbigniewsz@gmail.com>
AuthorDate: Mon Jun 18 20:16:24 2012 -0500
Commit: Mario Domenech Goulart <mario.goulart@gmail.com>
CommitDate: Wed Jun 20 13:40:23 2012 -0300
Ensure that srfi-13 string= and its string-comparison friends return booleans on success
This corrects a deficiency which exists in the reference implementation
and fixes ticket #870.
Signed-off-by: Mario Domenech Goulart <mario.goulart@gmail.com>
diff --git a/srfi-13.scm b/srfi-13.scm
index 615cbb75..e4a0509b 100644
--- a/srfi-13.scm
+++ b/srfi-13.scm
@@ -783,7 +783,7 @@
(or (and (eq? s1 s2) (= start1 start2)) ; Fast path
(%string-compare s1 start1 end1 s2 start2 end2 ; Real test
(lambda (i) #f)
- values
+ (lambda (i) (if i #t #f))
(lambda (i) #f))))))
(define (string<> s1 s2 . maybe-starts+ends)
@@ -792,9 +792,9 @@
(or (not (= (- end1 start1) (- end2 start2))) ; Fast path
(and (not (and (eq? s1 s2) (= start1 start2))) ; Quick filter
(%string-compare s1 start1 end1 s2 start2 end2 ; Real test
- values
+ (lambda (i) (if i #t #f))
(lambda (i) #f)
- values)))))
+ (lambda (i) (if i #t #f)))))))
(define (string< s1 s2 . maybe-starts+ends)
(let-string-start+end2 (start1 end1 start2 end2)
@@ -803,7 +803,7 @@
(< end1 end2)
(%string-compare s1 start1 end1 s2 start2 end2 ; Real test
- values
+ (lambda (i) (if i #t #f))
(lambda (i) #f)
(lambda (i) #f)))))
@@ -816,7 +816,7 @@
(%string-compare s1 start1 end1 s2 start2 end2 ; Real test
(lambda (i) #f)
(lambda (i) #f)
- values))))
+ (lambda (i) (if i #t #f))))))
(define (string<= s1 s2 . maybe-starts+ends)
(let-string-start+end2 (start1 end1 start2 end2)
@@ -825,8 +825,8 @@
(<= end1 end2)
(%string-compare s1 start1 end1 s2 start2 end2 ; Real test
- values
- values
+ (lambda (i) (if i #t #f))
+ (lambda (i) (if i #t #f))
(lambda (i) #f)))))
(define (string>= s1 s2 . maybe-starts+ends)
@@ -837,8 +837,8 @@
(%string-compare s1 start1 end1 s2 start2 end2 ; Real test
(lambda (i) #f)
- values
- values))))
+ (lambda (i) (if i #t #f))
+ (lambda (i) (if i #t #f))))))
(define (string-ci= s1 s2 . maybe-starts+ends)
(let-string-start+end2 (start1 end1 start2 end2)
@@ -847,7 +847,7 @@
(or (and (eq? s1 s2) (= start1 start2)) ; Fast path
(%string-compare-ci s1 start1 end1 s2 start2 end2 ; Real test
(lambda (i) #f)
- values
+ (lambda (i) (if i #t #f))
(lambda (i) #f))))))
(define (string-ci<> s1 s2 . maybe-starts+ends)
@@ -856,9 +856,9 @@
(or (not (= (- end1 start1) (- end2 start2))) ; Fast path
(and (not (and (eq? s1 s2) (= start1 start2))) ; Quick filter
(%string-compare-ci s1 start1 end1 s2 start2 end2 ; Real test
- values
+ (lambda (i) (if i #t #f))
(lambda (i) #f)
- values)))))
+ (lambda (i) (if i #t #f)))))))
(define (string-ci< s1 s2 . maybe-starts+ends)
(let-string-start+end2 (start1 end1 start2 end2)
@@ -867,7 +867,7 @@
(< end1 end2)
(%string-compare-ci s1 start1 end1 s2 start2 end2 ; Real test
- values
+ (lambda (i) (if i #t #f))
(lambda (i) #f)
(lambda (i) #f)))))
@@ -880,7 +880,7 @@
(%string-compare-ci s1 start1 end1 s2 start2 end2 ; Real test
(lambda (i) #f)
(lambda (i) #f)
- values))))
+ (lambda (i) (if i #t #f))))))
(define (string-ci<= s1 s2 . maybe-starts+ends)
(let-string-start+end2 (start1 end1 start2 end2)
@@ -889,8 +889,8 @@
(<= end1 end2)
(%string-compare-ci s1 start1 end1 s2 start2 end2 ; Real test
- values
- values
+ (lambda (i) (if i #t #f))
+ (lambda (i) (if i #t #f))
(lambda (i) #f)))))
(define (string-ci>= s1 s2 . maybe-starts+ends)
@@ -901,8 +901,8 @@
(%string-compare-ci s1 start1 end1 s2 start2 end2 ; Real test
(lambda (i) #f)
- values
- values))))
+ (lambda (i) (if i #t #f))
+ (lambda (i) (if i #t #f))))))
;;; Hash
Trap