Revert previous accidental commit.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@83875 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 198 insertions, 0 deletions

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 9bc1f4fbe63..d605361ec03 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2048,6 +2048,204 @@ cleanup:
 }
 
 
+/* Match an IMPLICIT NONE statement.  Actually, this statement is
+   already matched in parse.c, or we would not end up here in the
+   first place.  So the only thing we need to check, is if there is
+   trailing garbage.  If not, the match is successful.  */
+
+match
+gfc_match_implicit_none (void)
+{
+
+  return (gfc_match_eos () == MATCH_YES) ? MATCH_YES : MATCH_NO;
+}
+
+
+/* Match the letter range(s) of an IMPLICIT statement.  */
+
+static match
+match_implicit_range (gfc_typespec * ts)
+{
+  int c, c1, c2, inner;
+  locus cur_loc;
+
+  cur_loc = gfc_current_locus;
+
+  gfc_gobble_whitespace ();
+  c = gfc_next_char ();
+  if (c != '(')
+    {
+      gfc_error ("Missing character range in IMPLICIT at %C");
+      goto bad;
+    }
+
+  inner = 1;
+  while (inner)
+    {
+      gfc_gobble_whitespace ();
+      c1 = gfc_next_char ();
+      if (!ISALPHA (c1))
+	goto bad;
+
+      gfc_gobble_whitespace ();
+      c = gfc_next_char ();
+
+      switch (c)
+	{
+	case ')':
+	  inner = 0;		/* Fall through */
+
+	case ',':
+	  c2 = c1;
+	  break;
+
+	case '-':
+	  gfc_gobble_whitespace ();
+	  c2 = gfc_next_char ();
+	  if (!ISALPHA (c2))
+	    goto bad;
+
+	  gfc_gobble_whitespace ();
+	  c = gfc_next_char ();
+
+	  if ((c != ',') && (c != ')'))
+	    goto bad;
+	  if (c == ')')
+	    inner = 0;
+
+	  break;
+
+	default:
+	  goto bad;
+	}
+
+      if (c1 > c2)
+	{
+	  gfc_error ("Letters must be in alphabetic order in "
+		     "IMPLICIT statement at %C");
+	  goto bad;
+	}
+
+      /* See if we can add the newly matched range to the pending
+         implicits from this IMPLICIT statement.  We do not check for
+         conflicts with whatever earlier IMPLICIT statements may have
+         set.  This is done when we've successfully finished matching
+         the current one.  */
+      if (gfc_add_new_implicit_range (c1, c2, ts) != SUCCESS)
+	goto bad;
+    }
+
+  return MATCH_YES;
+
+bad:
+  gfc_syntax_error (ST_IMPLICIT);
+
+  gfc_current_locus = cur_loc;
+  return MATCH_ERROR;
+}
+
+
+/* Match an IMPLICIT statement, storing the types for
+   gfc_set_implicit() if the statement is accepted by the parser.
+   There is a strange looking, but legal syntactic construction
+   possible.  It looks like:
+
+     IMPLICIT INTEGER (a-b) (c-d)
+
+   This is legal if "a-b" is a constant expression that happens to
+   equal one of the legal kinds for integers.  The real problem
+   happens with an implicit specification that looks like:
+
+     IMPLICIT INTEGER (a-b)
+
+   In this case, a typespec matcher that is "greedy" (as most of the
+   matchers are) gobbles the character range as a kindspec, leaving
+   nothing left.  We therefore have to go a bit more slowly in the
+   matching process by inhibiting the kindspec checking during
+   typespec matching and checking for a kind later.  */
+
+match
+gfc_match_implicit (void)
+{
+  gfc_typespec ts;
+  locus cur_loc;
+  int c;
+  match m;
+
+  /* We don't allow empty implicit statements.  */
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      gfc_error ("Empty IMPLICIT statement at %C");
+      return MATCH_ERROR;
+    }
+
+  /* First cleanup.  */
+  gfc_clear_new_implicit ();
+
+  do
+    {
+      /* A basic type is mandatory here.  */
+      m = gfc_match_type_spec (&ts, 0);
+      if (m == MATCH_ERROR)
+	goto error;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      cur_loc = gfc_current_locus;
+      m = match_implicit_range (&ts);
+
+      if (m == MATCH_YES)
+	{
+	  /* Looks like we have the <TYPE> (<RANGE>).  */
+	  gfc_gobble_whitespace ();
+	  c = gfc_next_char ();
+	  if ((c == '\n') || (c == ','))
+	    continue;
+
+	  gfc_current_locus = cur_loc;
+	}
+
+      /* Last chance -- check <TYPE> (<KIND>) (<RANGE>).  */
+      m = gfc_match_kind_spec (&ts);
+      if (m == MATCH_ERROR)
+	goto error;
+      if (m == MATCH_NO)
+	{
+	  m = gfc_match_old_kind_spec (&ts);
+	  if (m == MATCH_ERROR)
+	    goto error;
+	  if (m == MATCH_NO)
+	    goto syntax;
+	}
+
+      m = match_implicit_range (&ts);
+      if (m == MATCH_ERROR)
+	goto error;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      gfc_gobble_whitespace ();
+      c = gfc_next_char ();
+      if ((c != '\n') && (c != ','))
+	goto syntax;
+
+    }
+  while (c == ',');
+
+  /* All we need to now is try to merge the new implicit types back
+     into the existing types.  This will fail if another implicit
+     type is already defined for a letter.  */
+  return (gfc_merge_new_implicit () == SUCCESS) ?
+      MATCH_YES : MATCH_ERROR;
+
+syntax:
+  gfc_syntax_error (ST_IMPLICIT);
+
+error:
+  return MATCH_ERROR;
+}
+
+
 /* Given a name, return a pointer to the common head structure,
    creating it if it does not exist.
    TODO: Add to global symbol tree.  */