mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Merge remote-tracking branch 'origin/stable-2.0'

Browse source 
Conflicts:
	libguile/r6rs-ports.c
This commit is contained in:
Mark H Weaver 2013-04-01 05:42:31 -04:00
commit 1e05106562
4 changed files with 86 additions and 91 deletions
Download patch file Download diff file Expand all files Collapse all files

2
doc/ref/api-data.texi
View file

@ -3148,7 +3148,7 @@ placed between the strings, and defaults to the symbol
@item infix @item infix
Insert the separator between list elements. An empty string Insert the separator between list elements. An empty string
will produce an empty list. will produce an empty list.
@item string-infix @item strict-infix
Like @code{infix}, but will raise an error if given the empty Like @code{infix}, but will raise an error if given the empty
list. list.
@item suffix @item suffix

27
libguile/r6rs-ports.c
View file

@ -480,16 +480,11 @@ SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0, 0,
/* Don't invoke `scm_c_read ()' since it may block. */ /* Don't invoke `scm_c_read ()' since it may block. */
c_read = 0; c_read = 0;
if ((c_read == 0) && (c_count > 0)) if (c_read < c_count)
{ {
if (scm_peek_byte_or_eof (port) == EOF) if (c_read == 0)
result = SCM_EOF_VAL; result = SCM_EOF_VAL;
else else
result = scm_null_bytevector;
}
else
{
if (c_read < c_count)
result = scm_c_shrink_bytevector (result, c_read); result = scm_c_shrink_bytevector (result, c_read);
} }
@ -527,13 +522,8 @@ SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4, 0, 0,
/* Don't invoke `scm_c_read ()' since it may block. */ /* Don't invoke `scm_c_read ()' since it may block. */
c_read = 0; c_read = 0;
if ((c_read == 0) && (c_count > 0)) if (c_read == 0 && c_count > 0)
{ result = SCM_EOF_VAL;
if (scm_peek_byte_or_eof (port) == EOF)
result = SCM_EOF_VAL;
else
result = SCM_I_MAKINUM (0);
}
else else
result = scm_from_size_t (c_read); result = scm_from_size_t (c_read);
@ -583,11 +573,12 @@ SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
c_bv[c_total] = (char) c_chr; c_bv[c_total] = (char) c_chr;
c_total++; c_total++;
} }
else
break;
} }
/* XXX: We want to check for the availability of a byte, but that's /* XXX: We want to check for the availability of a byte, but that's
what `scm_char_ready_p' actually does. */ what `scm_char_ready_p' actually does. */
while (scm_is_true (scm_char_ready_p (port)) while (scm_is_true (scm_char_ready_p (port)));
&& (scm_peek_byte_or_eof_unlocked (port) != EOF));
if (c_total == 0) if (c_total == 0)
{ {
@ -647,7 +638,7 @@ SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0,
c_read = scm_c_read_unlocked (port, c_bv + c_total, c_count); c_read = scm_c_read_unlocked (port, c_bv + c_total, c_count);
c_total += c_read, c_count -= c_read; c_total += c_read, c_count -= c_read;
} }
while (scm_peek_byte_or_eof (port) != EOF); while (c_count == 0);
if (c_total == 0) if (c_total == 0)
{ {

126
libguile/srfi-13.c
View file

@ -384,7 +384,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
"@item infix\n" "@item infix\n"
"Insert the separator between list elements. An empty string\n" "Insert the separator between list elements. An empty string\n"
"will produce an empty list.\n" "will produce an empty list.\n"
"@item string-infix\n" "@item strict-infix\n"
"Like @code{infix}, but will raise an error if given the empty\n" "Like @code{infix}, but will raise an error if given the empty\n"
"list.\n" "list.\n"
"@item suffix\n" "@item suffix\n"
@ -394,91 +394,85 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
"@end table") "@end table")
#define FUNC_NAME s_scm_string_join #define FUNC_NAME s_scm_string_join
{ {
#define GRAM_INFIX 0 SCM append_list = SCM_EOL;
#define GRAM_STRICT_INFIX 1 long list_len = scm_ilength (ls);
#define GRAM_SUFFIX 2 size_t delimiter_len = 0;
#define GRAM_PREFIX 3
SCM tmp;
SCM result;
int gram = GRAM_INFIX;
size_t del_len = 0;
long strings = scm_ilength (ls);
/* Validate the string list. */ /* Validate the string list. */
if (strings < 0) if (list_len < 0)
SCM_WRONG_TYPE_ARG (1, ls); SCM_WRONG_TYPE_ARG (1, ls);
/* Validate the delimiter and record its length. */ /* Validate the delimiter and record its length. */
if (SCM_UNBNDP (delimiter)) if (SCM_UNBNDP (delimiter))
{ {
delimiter = scm_from_locale_string (" "); delimiter = scm_from_locale_string (" ");
del_len = 1; delimiter_len = 1;
} }
else else
{ {
SCM_VALIDATE_STRING (2, delimiter); SCM_VALIDATE_STRING (2, delimiter);
del_len = scm_i_string_length (delimiter); delimiter_len = scm_i_string_length (delimiter);
} }
/* Validate the grammar symbol and remember the grammar. */ /* Validate the grammar symbol. */
if (SCM_UNBNDP (grammar)) if (SCM_UNBNDP (grammar))
gram = GRAM_INFIX; grammar = scm_sym_infix;
else if (scm_is_eq (grammar, scm_sym_infix)) else if (!(scm_is_eq (grammar, scm_sym_infix)
gram = GRAM_INFIX; || scm_is_eq (grammar, scm_sym_strict_infix)
else if (scm_is_eq (grammar, scm_sym_strict_infix)) || scm_is_eq (grammar, scm_sym_suffix)
gram = GRAM_STRICT_INFIX; || scm_is_eq (grammar, scm_sym_prefix)))
else if (scm_is_eq (grammar, scm_sym_suffix))
gram = GRAM_SUFFIX;
else if (scm_is_eq (grammar, scm_sym_prefix))
gram = GRAM_PREFIX;
else
SCM_WRONG_TYPE_ARG (3, grammar); SCM_WRONG_TYPE_ARG (3, grammar);
/* Check grammar constraints. */ if (list_len == 0)
if (strings == 0 && gram == GRAM_STRICT_INFIX)
SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
SCM_EOL);
result = scm_i_make_string (0, NULL, 0);
tmp = ls;
switch (gram)
{ {
case GRAM_INFIX: if (scm_is_eq (grammar, scm_sym_strict_infix))
case GRAM_STRICT_INFIX: SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
while (scm_is_pair (tmp)) SCM_EOL);
{ else
result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp))); /* Handle empty lists specially */
if (!scm_is_null (SCM_CDR (tmp)) && del_len > 0) append_list = SCM_EOL;
result = scm_string_append (scm_list_2 (result, delimiter)); }
tmp = SCM_CDR (tmp); else if (delimiter_len == 0)
} /* Handle empty delimiters specially */
break; append_list = ls;
case GRAM_SUFFIX: else
while (scm_is_pair (tmp)) {
{ SCM *last_cdr_p = &append_list;
result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
if (del_len > 0) #define ADD_TO_APPEND_LIST(x) \
result = scm_string_append (scm_list_2 (result, delimiter)); ((*last_cdr_p = scm_list_1 (x)), \
tmp = SCM_CDR (tmp); (last_cdr_p = SCM_CDRLOC (*last_cdr_p)))
}
break; /* Build a list of strings to pass to 'string-append'.
case GRAM_PREFIX: Here we assume that 'ls' has at least one element. */
while (scm_is_pair (tmp))
{ /* If using the 'prefix' grammar, start with the delimiter. */
if (del_len > 0) if (scm_is_eq (grammar, scm_sym_prefix))
result = scm_string_append (scm_list_2 (result, delimiter)); ADD_TO_APPEND_LIST (delimiter);
result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
tmp = SCM_CDR (tmp); /* Handle the first element of 'ls' specially, so that in the loop
} that follows we can unconditionally insert the delimiter before
break; every remaining element. */
ADD_TO_APPEND_LIST (SCM_CAR (ls));
ls = SCM_CDR (ls);
/* Insert the delimiter before every remaining element. */
while (scm_is_pair (ls))
{
ADD_TO_APPEND_LIST (delimiter);
ADD_TO_APPEND_LIST (SCM_CAR (ls));
ls = SCM_CDR (ls);
}
/* If using the 'suffix' grammar, add the delimiter to the end. */
if (scm_is_eq (grammar, scm_sym_suffix))
ADD_TO_APPEND_LIST (delimiter);
#undef ADD_TO_APPEND_LIST
} }
return result; /* Construct the final result. */
#undef GRAM_INFIX return scm_string_append (append_list);
#undef GRAM_STRICT_INFIX
#undef GRAM_SUFFIX
#undef GRAM_PREFIX
} }
#undef FUNC_NAME #undef FUNC_NAME

22
libguile/strings.c
View file

@ -1401,7 +1401,8 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
#define FUNC_NAME s_scm_string_append #define FUNC_NAME s_scm_string_append
{ {
SCM res; SCM res;
size_t len = 0; size_t total = 0;
size_t len;
int wide = 0; int wide = 0;
SCM l, s; SCM l, s;
size_t i; size_t i;
@ -1416,15 +1417,18 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
{ {
s = SCM_CAR (l); s = SCM_CAR (l);
SCM_VALIDATE_STRING (SCM_ARGn, s); SCM_VALIDATE_STRING (SCM_ARGn, s);
len += scm_i_string_length (s); len = scm_i_string_length (s);
if (((size_t) -1) - total < len)
scm_num_overflow (s_scm_string_append);
total += len;
if (!scm_i_is_narrow_string (s)) if (!scm_i_is_narrow_string (s))
wide = 1; wide = 1;
} }
data.narrow = NULL; data.narrow = NULL;
if (!wide) if (!wide)
res = scm_i_make_string (len, &data.narrow, 0); res = scm_i_make_string (total, &data.narrow, 0);
else else
res = scm_i_make_wide_string (len, &data.wide, 0); res = scm_i_make_wide_string (total, &data.wide, 0);
for (l = args; !scm_is_null (l); l = SCM_CDR (l)) for (l = args; !scm_is_null (l); l = SCM_CDR (l))
{ {
@ -1432,6 +1436,8 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
s = SCM_CAR (l); s = SCM_CAR (l);
SCM_VALIDATE_STRING (SCM_ARGn, s); SCM_VALIDATE_STRING (SCM_ARGn, s);
len = scm_i_string_length (s); len = scm_i_string_length (s);
if (len > total)
SCM_MISC_ERROR ("list changed during string-append", SCM_EOL);
if (!wide) if (!wide)
{ {
memcpy (data.narrow, scm_i_string_chars (s), len); memcpy (data.narrow, scm_i_string_chars (s), len);
@ -1441,16 +1447,20 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
{ {
if (scm_i_is_narrow_string (s)) if (scm_i_is_narrow_string (s))
{ {
for (i = 0; i < scm_i_string_length (s); i++) const char *src = scm_i_string_chars (s);
data.wide[i] = (unsigned char) scm_i_string_chars (s)[i]; for (i = 0; i < len; i++)
data.wide[i] = (unsigned char) src[i];
} }
else else
u32_cpy ((scm_t_uint32 *) data.wide, u32_cpy ((scm_t_uint32 *) data.wide,
(scm_t_uint32 *) scm_i_string_wide_chars (s), len); (scm_t_uint32 *) scm_i_string_wide_chars (s), len);
data.wide += len; data.wide += len;
} }
total -= len;
scm_remember_upto_here_1 (s); scm_remember_upto_here_1 (s);
} }
if (total != 0)
SCM_MISC_ERROR ("list changed during string-append", SCM_EOL);
return res; return res;
} }
#undef FUNC_NAME #undef FUNC_NAME