diff options
author | Ludovic Courtès <ludo@gnu.org> | 2008-12-02 19:42:39 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2008-12-02 19:52:13 +0100 |
commit | 3ae3166b2307ee8588aa9b422764b486ed02ad09 (patch) | |
tree | 70092c15a1ebe07932c7a41f2bee0ccfdf35a5be | |
parent | 691343ead288625816175574d629f8b5c925fbab (diff) | |
download | guile-3ae3166b2307ee8588aa9b422764b486ed02ad09.tar.gz |
Fix sloppy bound checking in `string-{ref,set!}' with the empty string.
* libguile/strings.c (scm_string_ref): Add proper range checking for the
empty string.
(scm_string_set_x): Likewise.
Reported by Bill Schottstaedt <bil@ccrma.Stanford.EDU>.
* test-suite/tests/strings.test ("string-ref"): New test prefix.
("string-set!")["empty string", "empty string and non-zero index",
"out of range", "negative index", "regular string"]: New tests.
* NEWS: Update.
-rw-r--r-- | NEWS | 1 | ||||
-rw-r--r-- | libguile/strings.c | 18 | ||||
-rw-r--r-- | test-suite/tests/strings.test | 51 |
3 files changed, 66 insertions, 4 deletions
@@ -86,6 +86,7 @@ available: Guile is now always configured in "maintainer mode". dynamic environment of the call to `raise' ** Fix potential deadlock in `make-struct' ** Fix compilation problem with libltdl from Libtool 2.2.x +** Fix sloppy bound checking in `string-{ref,set!}' with the empty string Changes in 1.8.5 (since 1.8.4) diff --git a/libguile/strings.c b/libguile/strings.c index 7399d8831..c13802664 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -670,10 +670,17 @@ SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0, "indexing. @var{k} must be a valid index of @var{str}.") #define FUNC_NAME s_scm_string_ref { + size_t len; unsigned long idx; SCM_VALIDATE_STRING (1, str); - idx = scm_to_unsigned_integer (k, 0, scm_i_string_length (str)-1); + + len = scm_i_string_length (str); + if (SCM_LIKELY (len > 0)) + idx = scm_to_unsigned_integer (k, 0, len - 1); + else + scm_out_of_range (NULL, k); + return SCM_MAKE_CHAR (scm_i_string_chars (str)[idx]); } #undef FUNC_NAME @@ -693,10 +700,17 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0, "@var{str}.") #define FUNC_NAME s_scm_string_set_x { + size_t len; unsigned long idx; SCM_VALIDATE_STRING (1, str); - idx = scm_to_unsigned_integer (k, 0, scm_i_string_length(str)-1); + + len = scm_i_string_length (str); + if (SCM_LIKELY (len > 0)) + idx = scm_to_unsigned_integer (k, 0, len - 1); + else + scm_out_of_range (NULL, k); + SCM_VALIDATE_CHAR (3, chr); { char *dst = scm_i_string_writable_chars (str); diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test index aa9196e68..51f163254 100644 --- a/test-suite/tests/strings.test +++ b/test-suite/tests/strings.test @@ -1,7 +1,7 @@ ;;;; strings.test --- test suite for Guile's string functions -*- scheme -*- ;;;; Jim Blandy <jimb@red-bean.com> --- August 1999 ;;;; -;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -161,14 +161,61 @@ (string-ci>=? (string-ints 0) (string-ints 255))))) ;; +;; string-ref +;; + +(with-test-prefix "string-ref" + + (pass-if-exception "empty string" + exception:out-of-range + (string-ref "" 0)) + + (pass-if-exception "empty string and non-zero index" + exception:out-of-range + (string-ref "" 123)) + + (pass-if-exception "out of range" + exception:out-of-range + (string-ref "hello" 123)) + + (pass-if-exception "negative index" + exception:out-of-range + (string-ref "hello" -1)) + + (pass-if "regular string" + (char=? (string-ref "GNU Guile" 4) #\G))) + +;; ;; string-set! ;; (with-test-prefix "string-set!" + (pass-if-exception "empty string" + exception:out-of-range + (string-set! (string-copy "") 0 #\x)) + + (pass-if-exception "empty string and non-zero index" + exception:out-of-range + (string-set! (string-copy "") 123 #\x)) + + (pass-if-exception "out of range" + exception:out-of-range + (string-set! (string-copy "hello") 123 #\x)) + + (pass-if-exception "negative index" + exception:out-of-range + (string-set! (string-copy "hello") -1 #\x)) + (pass-if-exception "read-only string" exception:read-only-string - (string-set! (substring/read-only "abc" 0) 1 #\space))) + (string-set! (substring/read-only "abc" 0) 1 #\space)) + + (pass-if "regular string" + (let ((s (string-copy "GNU guile"))) + (string-set! s 4 #\G) + (char=? (string-ref s 4) #\G)))) + (with-test-prefix "string-split" |