PR 25708 Avoid seeking when parsing strings and when peeking.

2011-12-01  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/25708
	* module.c (parse_string): Read string into resizable array
	instead of parsing twice and seeking.
	(peek_atom): New implementation avoiding seeks.
	(require_atom): Save and set column and line explicitly for error
	handling.

From-SVN: r181879
This commit is contained in:
Janne Blomqvist 2011-12-01 16:12:37 +02:00
parent c136d69611
commit d7fb38e9ac
2 changed files with 123 additions and 44 deletions

View File

@ -1,3 +1,12 @@
2011-12-01 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/25708
* module.c (parse_string): Read string into resizable array
instead of parsing twice and seeking.
(peek_atom): New implementation avoiding seeks.
(require_atom): Save and set column and line explicitly for error
handling.
2011-12-01 Janne Blomqvist <jb@gcc.gnu.org>
* misc.c (gfc_open_file): Don't call stat.

View File

@ -1069,51 +1069,37 @@ module_unget_char (void)
static void
parse_string (void)
{
module_locus start;
int len, c;
char *p;
int c;
size_t cursz = 30;
size_t len = 0;
get_module_locus (&start);
atom_string = XNEWVEC (char, cursz);
len = 0;
/* See how long the string is. */
for ( ; ; )
{
c = module_char ();
if (c == EOF)
bad_module ("Unexpected end of module in string constant");
if (c != '\'')
{
len++;
continue;
}
c = module_char ();
if (c == '\'')
{
len++;
continue;
int c2 = module_char ();
if (c2 != '\'')
{
module_unget_char ();
break;
}
}
break;
if (len >= cursz)
{
cursz *= 2;
atom_string = XRESIZEVEC (char, atom_string, cursz);
}
atom_string[len] = c;
len++;
}
set_module_locus (&start);
atom_string = p = XCNEWVEC (char, len + 1);
for (; len > 0; len--)
{
c = module_char ();
if (c == '\'')
module_char (); /* Guaranteed to be another \'. */
*p++ = c;
}
module_char (); /* Terminating \'. */
*p = '\0'; /* C-style string for debug purposes. */
atom_string = XRESIZEVEC (char, atom_string, len + 1);
atom_string[len] = '\0'; /* C-style string for debug purposes. */
}
@ -1279,17 +1265,99 @@ parse_atom (void)
static atom_type
peek_atom (void)
{
module_locus m;
atom_type a;
int c;
get_module_locus (&m);
do
{
c = module_char ();
}
while (c == ' ' || c == '\r' || c == '\n');
a = parse_atom ();
if (a == ATOM_STRING)
free (atom_string);
switch (c)
{
case '(':
module_unget_char ();
return ATOM_LPAREN;
set_module_locus (&m);
return a;
case ')':
module_unget_char ();
return ATOM_RPAREN;
case '\'':
module_unget_char ();
return ATOM_STRING;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
module_unget_char ();
return ATOM_INTEGER;
case 'a':
case 'b':
case 'c':
case 'd':
case 'e':
case 'f':
case 'g':
case 'h':
case 'i':
case 'j':
case 'k':
case 'l':
case 'm':
case 'n':
case 'o':
case 'p':
case 'q':
case 'r':
case 's':
case 't':
case 'u':
case 'v':
case 'w':
case 'x':
case 'y':
case 'z':
case 'A':
case 'B':
case 'C':
case 'D':
case 'E':
case 'F':
case 'G':
case 'H':
case 'I':
case 'J':
case 'K':
case 'L':
case 'M':
case 'N':
case 'O':
case 'P':
case 'Q':
case 'R':
case 'S':
case 'T':
case 'U':
case 'V':
case 'W':
case 'X':
case 'Y':
case 'Z':
module_unget_char ();
return ATOM_NAME;
default:
bad_module ("Bad name");
}
}
@ -1299,11 +1367,12 @@ peek_atom (void)
static void
require_atom (atom_type type)
{
module_locus m;
atom_type t;
const char *p;
int column, line;
get_module_locus (&m);
column = module_column;
line = module_line;
t = parse_atom ();
if (t != type)
@ -1329,7 +1398,8 @@ require_atom (atom_type type)
gfc_internal_error ("require_atom(): bad atom type required");
}
set_module_locus (&m);
module_column = column;
module_line = line;
bad_module (p);
}
}