* Bugs fixed
** `symbol->string' now returns a read-only string, as per R5RS
+** Literal strings as returned by `read' are now read-only, as per R5RS
** `guile-config link' now prints `-L$libdir' before `-lguile'
** Fix memory corruption involving GOOPS' `class-redefinition'
** Fix possible deadlock in `mutex-lock'
else
str = (str == SCM_BOOL_F) ? scm_nullstr : str;
- return str;
+ return scm_i_make_read_only_string (str);
}
#undef FUNC_NAME
*buf = STRING_STRINGBUF (*str);
}
+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
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
SCM start, size_t *cstart,
SCM end, size_t *cend);
SCM_INTERNAL SCM scm_i_take_stringbufn (char *str, size_t len);
+SCM_INTERNAL SCM scm_i_make_read_only_string (SCM str);
/* deprecated stuff */
;;;; 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
(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-exception "literal string"
+ exception:read-only-string
+ (string-set! "an immutable string" 0 #\a)))
(with-test-prefix "string-split"