1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

Generalize scm_read_shebang to handle other reader directives.

* libguile/read.c (READER_DIRECTIVE_NAME_MAX_SIZE): New C macro.
  (scm_read_shebang): Rewrite to handle arbitrary reader directives.
This commit is contained in:
Mark H Weaver 2012-10-23 00:29:07 -04:00
parent 3655ed8983
commit 02327c0c51

View file

@ -218,6 +218,9 @@ scm_i_read_hash_procedures_set_x (SCM value)
/* The maximum size of Scheme character names. */ /* The maximum size of Scheme character names. */
#define READER_CHAR_NAME_MAX_SIZE 50 #define READER_CHAR_NAME_MAX_SIZE 50
/* The maximum size of reader directive names. */
#define READER_DIRECTIVE_NAME_MAX_SIZE 50
/* `isblank' is only in C99. */ /* `isblank' is only in C99. */
#define CHAR_IS_BLANK_(_chr) \ #define CHAR_IS_BLANK_(_chr) \
@ -1305,35 +1308,33 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port)
static SCM static SCM
scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
{ {
int c = 0; char name[READER_DIRECTIVE_NAME_MAX_SIZE + 1];
if ((c = scm_get_byte_or_eof (port)) != 'r') int c;
int i = 0;
while (i <= READER_DIRECTIVE_NAME_MAX_SIZE)
{
c = scm_getc (port);
if (c == EOF)
scm_i_input_error ("skip_block_comment", port,
"unterminated `#! ... !#' comment", SCM_EOL);
else if (('a' <= c && c <= 'z') || ('0' <= c && c <= '9') || c == '-')
name[i++] = c;
else if (CHAR_IS_DELIMITER (c))
{ {
scm_ungetc (c, port); scm_ungetc (c, port);
return scm_read_scsh_block_comment (chr, port); name[i] = '\0';
} if (0 == strcmp ("r6rs", name))
if ((c = scm_get_byte_or_eof (port)) != '6') ; /* Silently ignore */
{ else
scm_ungetc (c, port); break;
scm_ungetc ('r', port);
return scm_read_scsh_block_comment (chr, port);
}
if ((c = scm_get_byte_or_eof (port)) != 'r')
{
scm_ungetc (c, port);
scm_ungetc ('6', port);
scm_ungetc ('r', port);
return scm_read_scsh_block_comment (chr, port);
}
if ((c = scm_get_byte_or_eof (port)) != 's')
{
scm_ungetc (c, port);
scm_ungetc ('r', port);
scm_ungetc ('6', port);
scm_ungetc ('r', port);
return scm_read_scsh_block_comment (chr, port);
}
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
}
}
while (i > 0)
scm_ungetc (name[--i], port);
return scm_read_scsh_block_comment (chr, port);
} }
static SCM static SCM