[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-120-g190d4
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-120-g190d4b0 |
|
Date: |
Sun, 20 Mar 2011 22:34:50 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=190d4b0d93599e5b58e773dc6375054c3a6e3dbf
The branch, stable-2.0 has been updated
via 190d4b0d93599e5b58e773dc6375054c3a6e3dbf (commit)
from 95c1cfb550e2e753324c5cc57ef5df90034f072a (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 190d4b0d93599e5b58e773dc6375054c3a6e3dbf
Author: Ludovic Courtès <address@hidden>
Date: Sun Mar 20 23:34:42 2011 +0100
Make VM string literals immutable.
* libguile/strings.c (scm_i_make_string, scm_i_make_wide_string): Add
`read_only_p' parameter. All callers updated.
* libguile/vm-i-loader.c (load_string, load_wide_string): Push read-only
strings.
* test-suite/tests/strings.test ("literals"): New test prefix.
-----------------------------------------------------------------------
Summary of changes:
libguile/deprecated.c | 2 +-
libguile/goops.c | 2 +-
libguile/i18n.c | 2 +-
libguile/ports.c | 2 +-
libguile/read.c | 8 +++---
libguile/socket.c | 2 +-
libguile/srfi-13.c | 26 ++++++++++----------
libguile/srfi-14.c | 4 +-
libguile/strings.c | 50 ++++++++++++++++++++++------------------
libguile/strings.h | 7 ++++-
libguile/strports.c | 2 +-
libguile/vm-i-loader.c | 4 +-
test-suite/tests/strings.test | 28 +++++++++++++++++++---
13 files changed, 83 insertions(+), 56 deletions(-)
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index fd23e2d..4d6027c 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -2281,7 +2281,7 @@ scm_allocate_string (size_t len)
{
scm_c_issue_deprecation_warning
("`scm_allocate_string' is deprecated. Use scm_c_make_string instead.");
- return scm_i_make_string (len, NULL);
+ return scm_i_make_string (len, NULL, 0);
}
SCM_DEFINE (scm_make_keyword_from_dash_symbol,
"make-keyword-from-dash-symbol", 1, 0, 0,
diff --git a/libguile/goops.c b/libguile/goops.c
index c597044..f610208 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -670,7 +670,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
SCM_MISC_ERROR ("class object doesn't have enough fields: ~S",
scm_list_1 (nfields));
- layout = scm_i_make_string (n, &s);
+ layout = scm_i_make_string (n, &s, 0);
i = 0;
while (scm_is_pair (getters_n_setters))
{
diff --git a/libguile/i18n.c b/libguile/i18n.c
index da3c220..51bbc2f 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -1252,7 +1252,7 @@ str_to_case (SCM str, scm_t_locale c_locale,
return NULL;
}
- convstr = scm_i_make_wide_string (convlen, &c_buf);
+ convstr = scm_i_make_wide_string (convlen, &c_buf, 0);
memcpy (c_buf, c_convstr, convlen * sizeof (scm_t_wchar));
free (c_convstr);
diff --git a/libguile/ports.c b/libguile/ports.c
index 8f52e66..6e0ae6c 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -352,7 +352,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
if (count)
{
- result = scm_i_make_string (count, &data);
+ result = scm_i_make_string (count, &data, 0);
scm_take_from_input_buffers (port, data, count);
}
else
diff --git a/libguile/read.c b/libguile/read.c
index a889133..e0f3cf8 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -516,7 +516,7 @@ scm_read_string (int chr, SCM port)
unsigned c_str_len = 0;
scm_t_wchar c;
- str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL);
+ str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0);
while ('"' != (c = scm_getc (port)))
{
if (c == EOF)
@@ -528,7 +528,7 @@ scm_read_string (int chr, SCM port)
if (c_str_len + 1 >= scm_i_string_length (str))
{
- SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL);
+ SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0);
str = scm_string_append (scm_list_2 (str, addy));
}
@@ -1232,7 +1232,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port)
So here, CHR is expected to be `{'. */
int saw_brace = 0, finished = 0;
size_t len = 0;
- SCM buf = scm_i_make_string (1024, NULL);
+ SCM buf = scm_i_make_string (1024, NULL, 0);
buf = scm_i_string_start_writing (buf);
@@ -1262,7 +1262,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port)
SCM addy;
scm_i_string_stop_writing ();
- addy = scm_i_make_string (1024, NULL);
+ addy = scm_i_make_string (1024, NULL, 0);
buf = scm_string_append (scm_list_2 (buf, addy));
len = 0;
buf = scm_i_string_start_writing (buf);
diff --git a/libguile/socket.c b/libguile/socket.c
index 1059708..632dd4f 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1426,7 +1426,7 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
"use a bytevector instead.");
len = scm_i_string_length (buf);
- msg = scm_i_make_string (len, &dest);
+ msg = scm_i_make_string (len, &dest, 0);
SCM_SYSCALL (rv = recv (fd, dest, len, flg));
scm_string_copy_x (buf, scm_from_int (0),
msg, scm_from_int (0), scm_from_size_t (len));
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 06d7f3b..5bba81c 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -251,14 +251,14 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0,
0,
if (wide)
{
scm_t_wchar *wbuf = NULL;
- res = scm_i_make_wide_string (clen, &wbuf);
+ res = scm_i_make_wide_string (clen, &wbuf, 0);
memcpy (wbuf, buf, clen * sizeof (scm_t_wchar));
free (buf);
}
else
{
char *nbuf = NULL;
- res = scm_i_make_string (clen, &nbuf);
+ res = scm_i_make_string (clen, &nbuf, 0);
for (i = 0; i < clen; i ++)
nbuf[i] = (unsigned char) buf[i];
free (buf);
@@ -336,7 +336,7 @@ SCM_DEFINE (scm_reverse_list_to_string,
"reverse-list->string", 1, 0, 0,
if (i < 0)
SCM_WRONG_TYPE_ARG (1, chrs);
- result = scm_i_make_string (i, &data);
+ result = scm_i_make_string (i, &data, 0);
{
SCM rest;
@@ -439,7 +439,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
SCM_EOL);
- result = scm_i_make_string (0, NULL);
+ result = scm_i_make_string (0, NULL, 0);
tmp = ls;
switch (gram)
@@ -2486,7 +2486,7 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
- result = scm_i_make_string (cend - cstart, NULL);
+ result = scm_i_make_string (cend - cstart, NULL, 0);
p = 0;
while (cstart < cend)
{
@@ -2624,7 +2624,7 @@ SCM_DEFINE (scm_string_unfold, "string-unfold", 4, 2, 0,
ans = base;
}
else
- ans = scm_i_make_string (0, NULL);
+ ans = scm_i_make_string (0, NULL, 0);
if (!SCM_UNBNDP (make_final))
SCM_VALIDATE_PROC (6, make_final);
@@ -2636,7 +2636,7 @@ SCM_DEFINE (scm_string_unfold, "string-unfold", 4, 2, 0,
SCM ch = scm_call_1 (f, seed);
if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
- str = scm_i_make_string (1, NULL);
+ str = scm_i_make_string (1, NULL, 0);
str = scm_i_string_start_writing (str);
scm_i_string_set_x (str, i, SCM_CHAR (ch));
scm_i_string_stop_writing ();
@@ -2690,7 +2690,7 @@ SCM_DEFINE (scm_string_unfold_right,
"string-unfold-right", 4, 2, 0,
ans = base;
}
else
- ans = scm_i_make_string (0, NULL);
+ ans = scm_i_make_string (0, NULL, 0);
if (!SCM_UNBNDP (make_final))
SCM_VALIDATE_PROC (6, make_final);
@@ -2702,7 +2702,7 @@ SCM_DEFINE (scm_string_unfold_right,
"string-unfold-right", 4, 2, 0,
SCM ch = scm_call_1 (f, seed);
if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
- str = scm_i_make_string (1, NULL);
+ str = scm_i_make_string (1, NULL, 0);
str = scm_i_string_start_writing (str);
scm_i_string_set_x (str, i, SCM_CHAR (ch));
scm_i_string_stop_writing ();
@@ -2817,7 +2817,7 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
if (cstart == cend && cfrom != cto)
SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
- result = scm_i_make_string (cto - cfrom, NULL);
+ result = scm_i_make_string (cto - cfrom, NULL, 0);
result = scm_i_string_start_writing (result);
p = 0;
@@ -3129,7 +3129,7 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
else
{
size_t dst = 0;
- result = scm_i_make_string (count, NULL);
+ result = scm_i_make_string (count, NULL, 0);
result = scm_i_string_start_writing (result);
/* decrement "count" in this loop as well as using idx, so that if
@@ -3239,7 +3239,7 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
{
int i = 0;
/* new string for retained portion */
- result = scm_i_make_string (count, NULL);
+ result = scm_i_make_string (count, NULL, 0);
result = scm_i_string_start_writing (result);
/* decrement "count" in this loop as well as using idx, so that if
another thread is simultaneously changing "s" there's no chance
@@ -3281,7 +3281,7 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
{
size_t i = 0;
/* new string for retained portion */
- result = scm_i_make_string (count, NULL);
+ result = scm_i_make_string (count, NULL, 0);
result = scm_i_string_start_writing (result);
/* decrement "count" in this loop as well as using idx, so that if
diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c
index b22471d..e2f6668 100644
--- a/libguile/srfi-14.c
+++ b/libguile/srfi-14.c
@@ -1515,9 +1515,9 @@ SCM_DEFINE (scm_char_set_to_string, "char-set->string",
1, 0, 0,
count = scm_to_int (scm_char_set_size (cs));
if (wide)
- result = scm_i_make_wide_string (count, &wbuf);
+ result = scm_i_make_wide_string (count, &wbuf, 0);
else
- result = scm_i_make_string (count, &buf);
+ result = scm_i_make_string (count, &buf, 0);
for (k = 0; k < cs_data->len; k++)
for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
diff --git a/libguile/strings.c b/libguile/strings.c
index 6f4004b..cdf8141 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -262,30 +262,34 @@ SCM scm_nullstr;
/* Create a scheme string with space for LEN 8-bit Latin-1-encoded
characters. CHARSP, if not NULL, will be set to location of the
- char array. */
+ char array. If READ_ONLY_P, the returned string is read-only;
+ otherwise it is writable. */
SCM
-scm_i_make_string (size_t len, char **charsp)
+scm_i_make_string (size_t len, char **charsp, int read_only_p)
{
SCM buf = make_stringbuf (len);
SCM res;
if (charsp)
*charsp = (char *) STRINGBUF_CHARS (buf);
- res = scm_double_cell (STRING_TAG, SCM_UNPACK(buf),
- (scm_t_bits)0, (scm_t_bits) len);
+ res = scm_double_cell (read_only_p ? RO_STRING_TAG : STRING_TAG,
+ SCM_UNPACK (buf),
+ (scm_t_bits) 0, (scm_t_bits) len);
return res;
}
/* Create a scheme string with space for LEN 32-bit UCS-4-encoded
characters. CHARSP, if not NULL, will be set to location of the
- character array. */
+ character array. If READ_ONLY_P, the returned string is read-only;
+ otherwise it is writable. */
SCM
-scm_i_make_wide_string (size_t len, scm_t_wchar **charsp)
+scm_i_make_wide_string (size_t len, scm_t_wchar **charsp, int read_only_p)
{
SCM buf = make_wide_stringbuf (len);
SCM res;
if (charsp)
*charsp = STRINGBUF_WIDE_CHARS (buf);
- res = scm_double_cell (STRING_TAG, SCM_UNPACK (buf),
+ res = scm_double_cell (read_only_p ? RO_STRING_TAG : STRING_TAG,
+ SCM_UNPACK (buf),
(scm_t_bits) 0, (scm_t_bits) len);
return res;
}
@@ -889,7 +893,7 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0,
(SCM str),
{
size_t len = STRINGBUF_LENGTH (buf);
char *cbuf;
- SCM sbc = scm_i_make_string (len, &cbuf);
+ SCM sbc = scm_i_make_string (len, &cbuf, 0);
memcpy (cbuf, STRINGBUF_CHARS (buf), len);
e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
sbc);
@@ -898,7 +902,7 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0,
(SCM str),
{
size_t len = STRINGBUF_LENGTH (buf);
scm_t_wchar *cbuf;
- SCM sbc = scm_i_make_wide_string (len, &cbuf);
+ SCM sbc = scm_i_make_wide_string (len, &cbuf, 0);
u32_cpy ((scm_t_uint32 *) cbuf,
(scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
@@ -962,7 +966,7 @@ SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0,
(SCM sym),
{
size_t len = STRINGBUF_LENGTH (buf);
char *cbuf;
- SCM sbc = scm_i_make_string (len, &cbuf);
+ SCM sbc = scm_i_make_string (len, &cbuf, 0);
memcpy (cbuf, STRINGBUF_CHARS (buf), len);
e4 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
sbc);
@@ -971,7 +975,7 @@ SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0,
(SCM sym),
{
size_t len = STRINGBUF_LENGTH (buf);
scm_t_wchar *cbuf;
- SCM sbc = scm_i_make_wide_string (len, &cbuf);
+ SCM sbc = scm_i_make_wide_string (len, &cbuf, 0);
u32_cpy ((scm_t_uint32 *) cbuf,
(scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
e4 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
@@ -1066,7 +1070,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
{
char *buf;
- result = scm_i_make_string (len, NULL);
+ result = scm_i_make_string (len, NULL, 0);
result = scm_i_string_start_writing (result);
buf = scm_i_string_writable_chars (result);
while (len > 0 && scm_is_pair (rest))
@@ -1083,7 +1087,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
{
scm_t_wchar *buf;
- result = scm_i_make_wide_string (len, NULL);
+ result = scm_i_make_wide_string (len, NULL, 0);
result = scm_i_string_start_writing (result);
buf = scm_i_string_writable_wide_chars (result);
while (len > 0 && scm_is_pair (rest))
@@ -1125,7 +1129,7 @@ scm_c_make_string (size_t len, SCM chr)
{
size_t p;
char *contents = NULL;
- SCM res = scm_i_make_string (len, &contents);
+ SCM res = scm_i_make_string (len, &contents, 0);
/* If no char is given, initialize string contents to NULL. */
if (SCM_UNBNDP (chr))
@@ -1372,9 +1376,9 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
}
data.narrow = NULL;
if (!wide)
- res = scm_i_make_string (len, &data.narrow);
+ res = scm_i_make_string (len, &data.narrow, 0);
else
- res = scm_i_make_wide_string (len, &data.wide);
+ res = scm_i_make_wide_string (len, &data.wide, 0);
for (l = args; !scm_is_null (l); l = SCM_CDR (l))
{
@@ -1463,7 +1467,7 @@ scm_from_stringn (const char *str, size_t len, const char
*encoding,
{
/* If encoding is null, use Latin-1. */
char *buf;
- res = scm_i_make_string (len, &buf);
+ res = scm_i_make_string (len, &buf, 0);
memcpy (buf, str, len);
return res;
}
@@ -1502,7 +1506,7 @@ scm_from_stringn (const char *str, size_t len, const char
*encoding,
if (!wide)
{
char *dst;
- res = scm_i_make_string (u32len, &dst);
+ res = scm_i_make_string (u32len, &dst, 0);
for (i = 0; i < u32len; i ++)
dst[i] = (unsigned char) u32[i];
dst[u32len] = '\0';
@@ -1510,7 +1514,7 @@ scm_from_stringn (const char *str, size_t len, const char
*encoding,
else
{
scm_t_wchar *wdst;
- res = scm_i_make_wide_string (u32len, &wdst);
+ res = scm_i_make_wide_string (u32len, &wdst, 0);
u32_cpy ((scm_t_uint32 *) wdst, (scm_t_uint32 *) u32, u32len);
wdst[u32len] = 0;
}
@@ -1548,7 +1552,7 @@ scm_from_latin1_stringn (const char *str, size_t len)
len = strlen (str);
/* Make a narrow string and copy STR as is. */
- result = scm_i_make_string (len, &buf);
+ result = scm_i_make_string (len, &buf, 0);
memcpy (buf, str, len);
return result;
@@ -1581,7 +1585,7 @@ scm_from_utf32_stringn (const scm_t_wchar *str, size_t
len)
if (len == (size_t) -1)
len = u32_strlen ((uint32_t *) str);
- result = scm_i_make_wide_string (len, &buf);
+ result = scm_i_make_wide_string (len, &buf, 0);
memcpy (buf, str, len * sizeof (scm_t_wchar));
scm_i_try_narrow_string (result);
@@ -1999,7 +2003,7 @@ normalize_str (SCM string, uninorm_t form)
w_str = u32_normalize (form, w_str, len, NULL, &rlen);
- ret = scm_i_make_wide_string (rlen, &cbuf);
+ ret = scm_i_make_wide_string (rlen, &cbuf, 0);
u32_cpy ((scm_t_uint32 *) cbuf, w_str, rlen);
free (w_str);
@@ -2211,7 +2215,7 @@ SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR,
scm_make_string)
void
scm_init_strings ()
{
- scm_nullstr = scm_i_make_string (0, NULL);
+ scm_nullstr = scm_i_make_string (0, NULL, 1);
#include "libguile/strings.x"
}
diff --git a/libguile/strings.h b/libguile/strings.h
index ed3a067..b1fc51a 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -177,8 +177,11 @@ SCM_API SCM scm_makfromstrs (int argc, char **argv);
/* internal accessor functions. Arguments must be valid. */
-SCM_INTERNAL SCM scm_i_make_string (size_t len, char **datap);
-SCM_INTERNAL SCM scm_i_make_wide_string (size_t len, scm_t_wchar **datap);
+SCM_INTERNAL SCM scm_i_make_string (size_t len, char **datap,
+ int read_only_p);
+SCM_INTERNAL SCM scm_i_make_wide_string (size_t len, scm_t_wchar **datap,
+ int read_only_p);
+SCM_INTERNAL SCM scm_i_set_string_read_only_x (SCM str);
SCM_INTERNAL SCM scm_i_substring (SCM str, size_t start, size_t end);
SCM_INTERNAL SCM scm_i_substring_read_only (SCM str, size_t start, size_t end);
SCM_INTERNAL SCM scm_i_substring_shared (SCM str, size_t start, size_t end);
diff --git a/libguile/strports.c b/libguile/strports.c
index 594d030..b7fec47 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -357,7 +357,7 @@ scm_strport_to_string (SCM port)
if (pt->encoding == NULL)
{
char *buf;
- str = scm_i_make_string (pt->read_buf_size, &buf);
+ str = scm_i_make_string (pt->read_buf_size, &buf, 0);
memcpy (buf, pt->read_buf, pt->read_buf_size);
}
else
diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index fae39fb..0d86784 100644
--- a/libguile/vm-i-loader.c
+++ b/libguile/vm-i-loader.c
@@ -40,7 +40,7 @@ VM_DEFINE_LOADER (102, load_string, "load-string")
FETCH_LENGTH (len);
SYNC_REGISTER ();
- PUSH (scm_i_make_string (len, &buf));
+ PUSH (scm_i_make_string (len, &buf, 1));
memcpy (buf, (char *) ip, len);
ip += len;
NEXT;
@@ -113,7 +113,7 @@ VM_DEFINE_LOADER (107, load_wide_string, "load-wide-string")
}
SYNC_REGISTER ();
- PUSH (scm_i_make_wide_string (len / 4, &wbuf));
+ PUSH (scm_i_make_wide_string (len / 4, &wbuf, 1));
memcpy ((char *) wbuf, (char *) ip, len);
ip += len;
NEXT;
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index fa8e6e1..d892b70 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -1,23 +1,25 @@
;;;; strings.test --- test suite for Guile's string functions -*- scheme -*-
;;;; Jim Blandy <address@hidden> --- August 1999
;;;;
-;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009, 2010 Free
Software Foundation, Inc.
-;;;;
+;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009, 2010,
+;;;; 2011 Free Software Foundation, Inc.
+;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
-;;;;
+;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
(define-module (test-strings)
+ #:use-module ((system base compile) #:select (compile))
#:use-module (test-suite lib))
(define exception:read-only-string
@@ -241,6 +243,24 @@
(not (string? 'abc))))
;;
+;; literals
+;;
+
+(with-test-prefix "literals"
+
+ ;; The "Storage Model" section of R5RS reads: "In such systems literal
+ ;; constants and the strings returned by `symbol->string' are
+ ;; immutable objects". `eval' doesn't support it yet, but it doesn't
+ ;; really matter because `eval' doesn't coalesce repeated constants,
+ ;; unlike the bytecode compiler.
+
+ (pass-if-exception "literals are constant"
+ exception:read-only-string
+ (compile '(string-set! "literal string" 0 #\x)
+ #:from 'scheme
+ #:to 'value)))
+
+;;
;; string-null?
;;
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-120-g190d4b0,
Ludovic Courtès <=