summaryrefslogtreecommitdiff
path: root/libguile/strings.c
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2008-09-22 23:03:20 +0200
committerLudovic Courtès <ludo@gnu.org>2008-09-23 18:45:27 +0200
commitfb2f8886c4d537b0c7d3e9e78a8d4e5e272a36f4 (patch)
tree16d6bbddb4c7ef0078f727dfb991e23fda94a79a /libguile/strings.c
parentfd2b17b9cb7aaa6b550ad9b6a3efe3c53c94ccce (diff)
downloadguile-fb2f8886c4d537b0c7d3e9e78a8d4e5e272a36f4.tar.gz
Make literal strings (i.e., returned by `read') read-only.
* libguile/read.c (scm_read_string): Use `scm_i_make_read_only_string ()' to return a read-only string, as mandated by R5RS. Reported by Bill Schottstaedt <bil@ccrma.Stanford.EDU>. * libguile/strings.c (scm_i_make_read_only_string): New function. (scm_i_shared_substring_read_only): Special-case the empty string so that the read-only and read-write empty strings are `eq?'. This optimization is relied on by the `substring/shared' `empty string' test case in `srfi-13.test'. * libguile/strings.h (scm_i_make_read_only_string): New declaration. * test-suite/tests/strings.test ("string-set!")["literal string"]: New test. * NEWS: Update.
Diffstat (limited to 'libguile/strings.c')
-rw-r--r--libguile/strings.c37
1 files changed, 28 insertions, 9 deletions
diff --git a/libguile/strings.c b/libguile/strings.c
index 7399d8831..ffc1eb312 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -218,6 +218,12 @@ get_str_buf_start (SCM *str, SCM *buf, size_t *start)
}
SCM
+scm_i_make_read_only_string (SCM str)
+{
+ return scm_i_substring_read_only (str, 0, STRING_LENGTH (str));
+}
+
+SCM
scm_i_substring (SCM str, size_t start, size_t end)
{
SCM buf;
@@ -234,15 +240,28 @@ scm_i_substring (SCM str, size_t start, size_t end)
SCM
scm_i_substring_read_only (SCM str, size_t start, size_t end)
{
- SCM buf;
- size_t str_start;
- get_str_buf_start (&str, &buf, &str_start);
- scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
- SET_STRINGBUF_SHARED (buf);
- scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
- return scm_double_cell (RO_STRING_TAG, SCM_UNPACK(buf),
- (scm_t_bits)str_start + start,
- (scm_t_bits) end - start);
+ SCM result;
+
+ if (SCM_UNLIKELY (STRING_LENGTH (str) == 0))
+ /* We want the empty string to be `eq?' with the read-only empty
+ string. */
+ result = str;
+ else
+ {
+ SCM buf;
+ size_t str_start;
+
+ get_str_buf_start (&str, &buf, &str_start);
+ scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
+ SET_STRINGBUF_SHARED (buf);
+ scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
+
+ result = scm_double_cell (RO_STRING_TAG, SCM_UNPACK (buf),
+ (scm_t_bits) str_start + start,
+ (scm_t_bits) end - start);
+ }
+
+ return result;
}
SCM