summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2008-12-02 19:42:39 +0100
committerLudovic Courtès <ludo@gnu.org>2008-12-02 19:52:13 +0100
commit3ae3166b2307ee8588aa9b422764b486ed02ad09 (patch)
tree70092c15a1ebe07932c7a41f2bee0ccfdf35a5be
parent691343ead288625816175574d629f8b5c925fbab (diff)
downloadguile-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--NEWS1
-rw-r--r--libguile/strings.c18
-rw-r--r--test-suite/tests/strings.test51
3 files changed, 66 insertions, 4 deletions
diff --git a/NEWS b/NEWS
index 7fc29c2ce..179126ff2 100644
--- a/NEWS
+++ b/NEWS
@@ -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"