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

gcc/fortran/ChangeLog

 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.
 
 2011-11-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

gcc/fortran/module.c

@@ -1069,51 +1069,37 @@ module_unget_char (void)
 static void
 parse_string (void)
 {
-  module_locus start;
-  int len, c;
-  char *p;
-
-  get_module_locus (&start);
+  int c;
+  size_t cursz = 30;
+  size_t len = 0;
 
-  len = 0;
+  atom_string = XNEWVEC (char, cursz);
 
-  /* See how long the string is.  */
   for ( ; ; )
     {
       c = module_char ();
-      if (c == EOF)
-	bad_module ("Unexpected end of module in string constant");
 
-      if (c != '\'')
+      if (c == '\'')
 	{
-	  len++;
-	  continue;
+	  int c2 = module_char ();
+	  if (c2 != '\'')
+	    {
+	      module_unget_char ();
+	      break;
+	    }
 	}
 
-      c = module_char ();
-      if (c == '\'')
+      if (len >= cursz)
 	{
-	  len++;
-	  continue;
+	  cursz *= 2;
+	  atom_string = XRESIZEVEC (char, atom_string, cursz);
 	}
-
-      break;
+      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;
+
+  do
+    {
+      c = module_char ();
+    }
+  while (c == ' ' || c == '\r' || c == '\n');
+
+  switch (c)
+    {
+    case '(':
+      module_unget_char ();
+      return ATOM_LPAREN;
 
-  get_module_locus (&m);
+    case ')':
+      module_unget_char ();
+      return ATOM_RPAREN;
 
-  a = parse_atom ();
-  if (a == ATOM_STRING)
-    free (atom_string);
+    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;
 
-  set_module_locus (&m);
-  return a;
+    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);
     }
 }