~ chicken-core (chicken-5) 1be37b85437c8e0644964ed6ca7b54a1ecfd29b5

commit 1be37b85437c8e0644964ed6ca7b54a1ecfd29b5
Author:     Jim Ursetto <zbigniewsz@gmail.com>
AuthorDate: Mon Apr 23 12:56:22 2012 -0500
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Mon Apr 23 20:04:33 2012 +0200

    Also use C_memcasecmp for case-insensitive substring comparisons (#808)
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/chicken.h b/chicken.h
index 3854c0c0..837a51cf 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1118,7 +1118,7 @@ extern double trunc(double);
                                                            (C_char *)C_data_pointer(s2) + C_unfix(start2), \
                                                            C_unfix(len) ) == 0)
 #define C_substring_compare_case_insensitive(s1, s2, start1, start2, len) \
-                                        C_mk_bool(C_strncasecmp((C_char *)C_data_pointer(s1) + C_unfix(start1), \
+                                        C_mk_bool(C_memcasecmp((C_char *)C_data_pointer(s1) + C_unfix(start1), \
                                                                 (C_char *)C_data_pointer(s2) + C_unfix(start2), \
                                                                 C_unfix(len) ) == 0)
 /* this does not use C_mutate: */
@@ -2112,12 +2112,10 @@ C_inline int C_memcasecmp(const char *x, const char *y, unsigned int len)
   const unsigned char *ux = (const unsigned char *)x;
   const unsigned char *uy = (const unsigned char *)y;
 
-  if (len == 0) return 0;
-  
-  do {
+  while (len--) {
     if (tolower(*ux++) != tolower(*uy++))
       return (tolower(*--ux) - tolower(*--uy));
-  } while(--len != 0);
+  }
   return 0;
 }
 
diff --git a/data-structures.scm b/data-structures.scm
index 058bc511..2ed9102a 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -26,11 +26,7 @@
 
 
 (declare
- (unit data-structures)
- (foreign-declare #<<EOF
-#define C_mem_compare(to, from, n)   C_fix(C_memcmp(C_c_string(to), C_c_string(from), C_unfix(n)))
-EOF
-) )
+ (unit data-structures))
 
 (include "common-declarations.scm")
 
@@ -352,7 +348,7 @@ EOF
   (let ((len1 (##sys#size s1))
 	(len2 (##sys#size s2)) )
     (let* ((len-diff (fx- len1 len2)) 
-	   (cmp (##core#inline "C_mem_compare" s1 s2 (if (fx< len-diff 0) len1 len2))))
+	   (cmp (##core#inline "C_string_compare" s1 s2 (if (fx< len-diff 0) len1 len2))))
       (if (fx= cmp 0) 
 	  len-diff 
 	  cmp))))
diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
index df4b5591..b0f8794b 100644
--- a/tests/data-structures-tests.scm
+++ b/tests/data-structures-tests.scm
@@ -1,6 +1,5 @@
 ;;;; data-structures-tests.scm
 
-
 (use data-structures)
 
 (let ((alist '((foo . 123) ("bar" . "baz"))))
@@ -15,4 +14,26 @@
   (alist-update 'foo 999 alist)
   (assert (= (alist-ref 'foo alist) 123))
   (assert (eq? 'yep (alist-ref 'qux (alist-update 'qux 'yep alist))))
-  (assert (eq? 'ok (alist-ref "bar" (alist-update "bar" 'ok alist equal?) equal?))))
\ No newline at end of file
+  (assert (eq? 'ok (alist-ref "bar" (alist-update "bar" 'ok alist equal?) equal?))))
+
+;; #808: strings with embedded nul bytes should not be compared
+;; with ASCIIZ string comparison functions
+(assert (substring=? "foo\x00a" "foo\x00a" 1 1))
+(assert (substring-ci=? "foo\x00a" "foo\x00a" 1 1))
+(assert (substring-ci=? "foo\x00a" "foo\x00A" 1 1))
+(assert (= 2 (substring-index "o\x00bar" "foo\x00bar")))
+(assert (= 2 (substring-index-ci "o\x00bar" "foo\x00bar")))
+(assert (= 2 (substring-index-ci "o\x00bar" "foo\x00BAR")))
+(assert (not (substring=? "foo\x00a" "foo\x00b" 1 1)))
+(assert (not (substring-ci=? "foo\x00a" "foo\x00b" 1 1)))
+(assert (not (substring-index "o\x00bar" "foo\x00baz")))
+(assert (not (substring-index-ci "o\x00bar" "foo\x00baz")))
+(assert (= 0 (string-compare3 "foo\x00a" "foo\x00a")))
+(assert (> 0 (string-compare3 "foo\x00a" "foo\x00b")))
+(assert (< 0 (string-compare3 "foo\x00b" "foo\x00a")))
+(assert (= 0 (string-compare3-ci "foo\x00a" "foo\x00a")))
+(assert (= 0 (string-compare3-ci "foo\x00a" "foo\x00A")))
+(assert (> 0 (string-compare3-ci "foo\x00a" "foo\x00b")))
+(assert (> 0 (string-compare3-ci "foo\x00A" "foo\x00b")))
+(assert (< 0 (string-compare3-ci "foo\x00b" "foo\x00a")))
+(assert (< 0 (string-compare3-ci "foo\x00b" "foo\x00A")))
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index f9cb61d2..a7c17e51 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -220,8 +220,14 @@
 (assert (equal? '#${abc} '#${ab0c}))
 (assert (equal? '#${a b c} '#${0a0b0c}))
 
-;; #800: blobs and strings with embedded nul bytes should not be compared
+;; #808: blobs and strings with embedded nul bytes should not be compared
 ;; with ASCIIZ string comparison functions
+(assert (equal? '#${a b 0 c} '#${a b 0 c}))
+(assert (blob=? '#${a b 0 c} '#${a b 0 c}))
+(assert (equal=? "foo\x00a" "foo\x00a"))
+(assert (string=? "foo\x00a" "foo\x00a"))
+(assert (string-ci=? "foo\x00a" "foo\x00a"))
+(assert (string-ci=? "foo\x00a" "foo\x00A"))
 (assert (not (equal? '#${a b 0 c} '#${a b 0 d})))
 (assert (not (blob=? '#${a b 0 c} '#${a b 0 d})))
 (assert (not (equal=? "foo\x00a" "foo\x00b")))