~ chicken-core (chicken-5) 5da352371df6544073186206fa505b480dfa6499

commit 5da352371df6544073186206fa505b480dfa6499
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sun Apr 22 15:49:45 2012 +0200
Commit:     Jim Ursetto <zbigniewsz@gmail.com>
CommitDate: Mon Apr 23 11:51:07 2012 -0500

    Fix #808; use memcmp instead of strncmp for comparing blobs and Scheme strings, and include our own "memcasecmp" to replace strncasecmp
    
    Signed-off-by: Jim Ursetto <zbigniewsz@gmail.com>

diff --git a/chicken.h b/chicken.h
index 8b1d7519..3854c0c0 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1156,9 +1156,9 @@ extern double trunc(double);
   (C_memcpy(C_pointer_address(to) + C_unfix(toff), C_pointer_address(from) + C_unfix(foff), \
 	    C_unfix(n)), C_SCHEME_UNDEFINED)
 #define C_set_memory(to, c, n)          (C_memset(C_data_pointer(to), C_character_code(c), C_unfix(n)), C_SCHEME_UNDEFINED)
-#define C_string_compare(to, from, n)   C_fix(C_strncmp(C_c_string(to), C_c_string(from), C_unfix(n)))
+#define C_string_compare(to, from, n)   C_fix(C_memcmp(C_c_string(to), C_c_string(from), C_unfix(n)))
 #define C_string_compare_case_insensitive(from, to, n) \
-                                        C_fix(C_strncasecmp(C_c_string(from), C_c_string(to), C_unfix(n)))
+                                        C_fix(C_memcasecmp(C_c_string(from), C_c_string(to), C_unfix(n)))
 #define C_rename_file(old, new)         C_fix(rename(C_c_string(old), C_c_string(new)))
 #define C_delete_file(fname)            C_fix(remove(C_c_string(fname)))
 #define C_poke_double(b, i, n)          (((double *)C_data_pointer(b))[ C_unfix(i) ] = C_c_double(n), C_SCHEME_UNDEFINED)
@@ -2106,6 +2106,20 @@ C_inline C_word C_u_i_string_equal_p(C_word x, C_word y)
          && !C_memcmp((char *)C_data_pointer(x), (char *)C_data_pointer(y), n));
 }
 
+/* Like memcmp but case insensitive (to strncasecmp as memcmp is to strncmp) */
+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 {
+    if (tolower(*ux++) != tolower(*uy++))
+      return (tolower(*--ux) - tolower(*--uy));
+  } while(--len != 0);
+  return 0;
+}
 
 C_inline C_word C_i_eqvp(C_word x, C_word y)
 {
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index fab5f002..f9cb61d2 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -220,6 +220,17 @@
 (assert (equal? '#${abc} '#${ab0c}))
 (assert (equal? '#${a b c} '#${0a0b0c}))
 
+;; #800: blobs and strings with embedded nul bytes should not be compared
+;; with ASCIIZ string comparison functions
+(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")))
+(assert (not (string=? "foo\x00a" "foo\x00b")))
+(assert (not (string-ci=? "foo\x00a" "foo\x00b")))
+(assert (string<? "foo\x00a" "foo\x00b"))
+(assert (string>? "foo\x00b" "foo\x00a"))
+(assert (string-ci<? "foo\x00a" "foo\x00B"))
+(assert (string-ci>? "foo\x00b" "foo\x00A"))
 
 ;;; getter-with-setter