mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-10 15:50:50 +02:00
Code Activity

Merge branch 'read-fix'

Browse source
This commit is contained in:
Andy Wingo 2009-12-28 17:36:44 +01:00
commit b597129782
1 changed files with 16 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

30
libguile/read.c
View file

@ -200,16 +200,12 @@ read_token (SCM port, SCM buf, size_t *read)
chr = scm_getc (port); chr = scm_getc (port);
if (chr == EOF) if (chr == EOF)
{
scm_i_string_stop_writing ();
return 0; return 0;
}
chr = (SCM_CASE_INSENSITIVE_P ? uc_tolower (chr) : chr); chr = (SCM_CASE_INSENSITIVE_P ? uc_tolower (chr) : chr);
if (CHAR_IS_DELIMITER (chr)) if (CHAR_IS_DELIMITER (chr))
{ {
scm_i_string_stop_writing ();
scm_ungetc (chr, port); scm_ungetc (chr, port);
return 0; return 0;
} }
@ -224,25 +220,27 @@ read_token (SCM port, SCM buf, size_t *read)
static SCM static SCM
read_complete_token (SCM port, size_t *read) read_complete_token (SCM port, size_t *read)
{ {
SCM buffer, str = SCM_EOL; SCM buffer;
size_t len;
int overflow; int overflow;
size_t overflow_read;
SCM tail = SCM_EOL;
buffer = scm_i_make_string (READER_BUFFER_SIZE, NULL); buffer = scm_i_make_string (READER_BUFFER_SIZE, NULL);
overflow = read_token (port, buffer, read); overflow = read_token (port, buffer, read);
if (!overflow) while (overflow)
return scm_i_substring (buffer, 0, *read);
str = scm_string_copy (buffer);
do
{ {
overflow = read_token (port, buffer, &len); tail = scm_cons (buffer, tail);
str = scm_string_append (scm_list_2 (str, buffer)); buffer = scm_i_make_string (READER_BUFFER_SIZE, NULL);
*read += len; overflow = read_token (port, buffer, &overflow_read);
*read += overflow_read;
} }
while (overflow);
return scm_i_substring (str, 0, *read); if (scm_is_null (tail))
return scm_i_substring (buffer, 0, *read);
else
return scm_string_append
(scm_reverse (scm_cons (scm_i_substring (buffer, 0, overflow_read),
tail)));
} }
/* Skip whitespace from PORT and return the first non-whitespace character /* Skip whitespace from PORT and return the first non-whitespace character