decl.c (match_string_p): New helper function to explicitly match a string of characters.

	* decl.c (match_string_p): New helper function to explicitly match
	a string of characters.
	(match_attr_spec): Remove no longer needed DECL_COLON from decl_types.
	Delete decls array and peek_char.  Rewrite decl attribute parser to
	avoid calling gfc_match_strings.
	* match.c (gfc_match_strings): Delete unused function.
	* match.h (gfc_match_strings): Delete prototype.

From-SVN: r128028

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d6c5e0946f73d4f91312177d1aa902dcd0d73521..b0cb8c9a2ad93cab0ff865734a69ee61a0b77dff 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2007-09-02  Roger Sayle  <roger@eyesopen.com>
+
+       * decl.c (match_string_p): New helper function to explicitly match
+       a string of characters.
+       (match_attr_spec): Remove no longer needed DECL_COLON from decl_types.
+       Delete decls array and peek_char.  Rewrite decl attribute parser to
+       avoid calling gfc_match_strings.
+       * match.c (gfc_match_strings): Delete unused function.
+       * match.h (gfc_match_strings): Delete prototype.
+
 2007-09-02  Tobias Schlüuter  <tobi@gcc.gnu.org>
 
        * dump-parse-tree.c (show_char_const): New function.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 8b3566204c6389f5f01ef8cdf6df1b85112acdc3..b1f4f35d94a633374fa98de3ff2b25aa3fba8531 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2468,6 +2468,21 @@ syntax:
 }
 
 
+/* A minimal implementation of gfc_match without whitespace, escape
+   characters or variable arguments.  Returns true if the next
+   characters match the TARGET template exactly.  */
+
+static bool
+match_string_p (const char *target)
+{
+  const char *p;
+
+  for (p = target; *p; p++)
+    if (gfc_next_char () != *p)
+      return false;
+  return true;
+}
+
 /* Matches an attribute specification including array specs.  If
    successful, leaves the variables current_attr and current_as
    holding the specification.  Also sets the colon_seen variable for
@@ -2488,7 +2503,7 @@ match_attr_spec (void)
     DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
     DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE,
     DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE,
-    DECL_IS_BIND_C, DECL_COLON, DECL_NONE,
+    DECL_IS_BIND_C, DECL_NONE,
     GFC_DECL_END /* Sentinel */
   }
   decl_types;
@@ -2496,35 +2511,12 @@ match_attr_spec (void)
 /* GFC_DECL_END is the sentinel, index starts at 0.  */
 #define NUM_DECL GFC_DECL_END
 
-  static mstring decls[] = {
-    minit (", allocatable", DECL_ALLOCATABLE),
-    minit (", dimension", DECL_DIMENSION),
-    minit (", external", DECL_EXTERNAL),
-    minit (", intent ( in )", DECL_IN),
-    minit (", intent ( out )", DECL_OUT),
-    minit (", intent ( in out )", DECL_INOUT),
-    minit (", intrinsic", DECL_INTRINSIC),
-    minit (", optional", DECL_OPTIONAL),
-    minit (", parameter", DECL_PARAMETER),
-    minit (", pointer", DECL_POINTER),
-    minit (", protected", DECL_PROTECTED),
-    minit (", private", DECL_PRIVATE),
-    minit (", public", DECL_PUBLIC),
-    minit (", save", DECL_SAVE),
-    minit (", target", DECL_TARGET),
-    minit (", value", DECL_VALUE),
-    minit (", volatile", DECL_VOLATILE),
-    minit ("::", DECL_COLON),
-    minit (NULL, DECL_NONE)
-  };
-
   locus start, seen_at[NUM_DECL];
   int seen[NUM_DECL];
   decl_types d;
   const char *attr;
   match m;
   try t;
-  char peek_char;
 
   gfc_clear_attr (&current_attr);
   start = gfc_current_locus;
@@ -2538,29 +2530,171 @@ match_attr_spec (void)
 
   for (;;)
     {
-      d = (decl_types) gfc_match_strings (decls);
+      int ch;
 
-      if (d == DECL_NONE)
+      d = DECL_NONE;
+      gfc_gobble_whitespace ();
+
+      ch = gfc_next_char ();
+      if (ch == ':')
+       {
+         /* This is the successful exit condition for the loop.  */
+         if (gfc_next_char () == ':')
+           break;
+       }
+      else if (ch == ',')
        {
-         /* See if we can find the bind(c) since all else failed. 
-            We need to skip over any whitespace and stop on the ','.  */
          gfc_gobble_whitespace ();
-         peek_char = gfc_peek_char ();
-         if (peek_char == ',')
+         switch (gfc_peek_char ())
            {
-             /* Chomp the comma.  */
-             peek_char = gfc_next_char ();
+           case 'a':
+             if (match_string_p ("allocatable"))
+               d = DECL_ALLOCATABLE;
+             break;
+
+           case 'b':
              /* Try and match the bind(c).  */
              m = gfc_match_bind_c (NULL);
              if (m == MATCH_YES)
                d = DECL_IS_BIND_C;
              else if (m == MATCH_ERROR)
                goto cleanup;
+             break;
+
+           case 'd':
+             if (match_string_p ("dimension"))
+               d = DECL_DIMENSION;
+             break;
+
+           case 'e':
+             if (match_string_p ("external"))
+               d = DECL_EXTERNAL;
+             break;
+
+           case 'i':
+             if (match_string_p ("int"))
+               {
+                 ch = gfc_next_char ();
+                 if (ch == 'e')
+                   {
+                     if (match_string_p ("nt"))
+                       {
+                         /* Matched "intent".  */
+                         /* TODO: Call match_intent_spec from here.  */
+                         if (gfc_match (" ( in out )") == MATCH_YES)
+                           d = DECL_INOUT;
+                         else if (gfc_match (" ( in )") == MATCH_YES)
+                           d = DECL_IN;
+                         else if (gfc_match (" ( out )") == MATCH_YES)
+                           d = DECL_OUT;
+                       }
+                   }
+                 else if (ch == 'r')
+                   {
+                     if (match_string_p ("insic"))
+                       {
+                         /* Matched "intrinsic".  */
+                         d = DECL_INTRINSIC;
+                       }
+                   }
+               }
+             break;
+
+           case 'o':
+             if (match_string_p ("optional"))
+               d = DECL_OPTIONAL;
+             break;
+
+           case 'p':
+             gfc_next_char ();
+             switch (gfc_next_char ())
+               {
+               case 'a':
+                 if (match_string_p ("rameter"))
+                   {
+                     /* Matched "parameter".  */
+                     d = DECL_PARAMETER;
+                   }
+                 break;
+
+               case 'o':
+                 if (match_string_p ("inter"))
+                   {
+                     /* Matched "pointer".  */
+                     d = DECL_POINTER;
+                   }
+                 break;
+
+               case 'r':
+                 ch = gfc_next_char ();
+                 if (ch == 'i')
+                   {
+                     if (match_string_p ("vate"))
+                       {
+                         /* Matched "private".  */
+                         d = DECL_PRIVATE;
+                       }
+                   }
+                 else if (ch == 'o')
+                   {
+                     if (match_string_p ("tected"))
+                       {
+                         /* Matched "protected".  */
+                         d = DECL_PROTECTED;
+                       }
+                   }
+                 break;
+
+               case 'u':
+                 if (match_string_p ("blic"))
+                   {
+                     /* Matched "public".  */
+                     d = DECL_PUBLIC;
+                   }
+                 break;
+               }
+             break;
+
+           case 's':
+             if (match_string_p ("save"))
+               d = DECL_SAVE;
+             break;
+
+           case 't':
+             if (match_string_p ("target"))
+               d = DECL_TARGET;
+             break;
+
+           case 'v':
+             gfc_next_char ();
+             ch = gfc_next_char ();
+             if (ch == 'a')
+               {
+                 if (match_string_p ("lue"))
+                   {
+                     /* Matched "value".  */
+                     d = DECL_VALUE;
+                   }
+               }
+             else if (ch == 'o')
+               {
+                 if (match_string_p ("latile"))
+                   {
+                     /* Matched "volatile".  */
+                     d = DECL_VOLATILE;
+                   }
+               }
+             break;
            }
        }
 
-      if (d == DECL_NONE || d == DECL_COLON)
-       break;
+      /* No double colon and no recognizable decl_type, so assume that
+        we've been looking at something else the whole time.  */
+      if (d == DECL_NONE)
+       {
+         m = MATCH_NO;
+         goto cleanup;
+       }
 
       seen[d]++;
       seen_at[d] = gfc_current_locus;
@@ -2580,14 +2714,6 @@ match_attr_spec (void)
        }
     }
 
-  /* No double colon, so assume that we've been looking at something
-     else the whole time.  */
-  if (d == DECL_NONE)
-    {
-      m = MATCH_NO;
-      goto cleanup;
-    }
-
   /* Since we've seen a double colon, we have to be looking at an
      attr-spec.  This means that we can now issue errors.  */
   for (d = GFC_DECL_BEGIN; d != GFC_DECL_END; d++)
@@ -2667,8 +2793,8 @@ match_attr_spec (void)
 
       if (gfc_current_state () == COMP_DERIVED
          && d != DECL_DIMENSION && d != DECL_POINTER
-         && d != DECL_COLON     && d != DECL_PRIVATE
-         && d != DECL_PUBLIC    && d != DECL_NONE)
+         && d != DECL_PRIVATE   && d != DECL_PUBLIC
+         && d != DECL_NONE)
        {
          if (d == DECL_ALLOCATABLE)
            {

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index dcf6ad1084be4653012abcc6926f3554ce20a157..83b887372cb56b2cac935c3cd34d391e1bae9dfc 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -417,90 +417,6 @@ gfc_match_label (void)
 }
 
 
-/* Try and match the input against an array of possibilities.  If one
-   potential matching string is a substring of another, the longest
-   match takes precedence.  Spaces in the target strings are optional
-   spaces that do not necessarily have to be found in the input
-   stream.  In fixed mode, spaces never appear.  If whitespace is
-   matched, it matches unlimited whitespace in the input.  For this
-   reason, the 'mp' member of the mstring structure is used to track
-   the progress of each potential match.
-
-   If there is no match we return the tag associated with the
-   terminating NULL mstring structure and leave the locus pointer
-   where it started.  If there is a match we return the tag member of
-   the matched mstring and leave the locus pointer after the matched
-   character.
-
-   A '%' character is a mandatory space.  */
-
-int
-gfc_match_strings (mstring *a)
-{
-  mstring *p, *best_match;
-  int no_match, c, possibles;
-  locus match_loc;
-
-  possibles = 0;
-
-  for (p = a; p->string != NULL; p++)
-    {
-      p->mp = p->string;
-      possibles++;
-    }
-
-  no_match = p->tag;
-
-  best_match = NULL;
-  match_loc = gfc_current_locus;
-
-  gfc_gobble_whitespace ();
-
-  while (possibles > 0)
-    {
-      c = gfc_next_char ();
-
-      /* Apply the next character to the current possibilities.  */
-      for (p = a; p->string != NULL; p++)
-       {
-         if (p->mp == NULL)
-           continue;
-
-         if (*p->mp == ' ')
-           {
-             /* Space matches 1+ whitespace(s).  */
-             if ((gfc_current_form == FORM_FREE) && gfc_is_whitespace (c))
-               continue;
-
-             p->mp++;
-           }
-
-         if (*p->mp != c)
-           {
-             /* Match failed.  */
-             p->mp = NULL;
-             possibles--;
-             continue;
-           }
-
-         p->mp++;
-         if (*p->mp == '\0')
-           {
-             /* Found a match.  */
-             match_loc = gfc_current_locus;
-             best_match = p;
-             possibles--;
-             p->mp = NULL;
-           }
-       }
-    }
-
-  gfc_current_locus = match_loc;
-
-  return (best_match == NULL) ? no_match : best_match->tag;
-}
-
-
 /* See if the current input looks like a name of some sort.  Modifies
    the passed buffer which must be GFC_MAX_SYMBOL_LEN+1 bytes long.
    Note that options.c restricts max_identifier_length to not more

diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index abd6ab1bf3627baf49a4a543534587a5aaac37d0..0909617e242eaabcbe92760b8a08ed3d3f8f09e8 100644 (file)
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -46,7 +46,6 @@ match gfc_match_st_label (gfc_st_label **);
 match gfc_match_label (void);
 match gfc_match_small_int (int *);
 match gfc_match_small_int_expr (int *, gfc_expr **);
-int gfc_match_strings (mstring *);
 match gfc_match_name (char *);
 match gfc_match_name_C (char *buffer);
 match gfc_match_symbol (gfc_symbol **, int);