re PR fortran/30478 (FAIL: gfortran.dg/enum_2.f90 -O (internal compiler error))

2007-02-11  Tobias Schlueter  <tobi@gcc.gnu.org>

PR fortran/30478
fortran/
* decl.c (add_init_expr_to_sym): Remove ENUM specific code.
(variable_decl): Likewise.  Rewrap comment.
(match_attr_spec): Remove ENUM specific code.
(gfc_match_enum): Fix typo in error message.
(enumerator_decl): New function.
(gfc_match_enumerator_def): Use enumerator_decl instead of
variable_decl.  Adapt code accordingly.
testsuite/
* gfortran.dg/enum_4.f90: Update error message checks.

From-SVN: r121830

4 files changed, 128 insertions, 68 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 32ae40e..6314425 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2007-02-11  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/30478
+	* decl.c (add_init_expr_to_sym): Remove ENUM specific code.
+	(variable_decl): Likewise.  Rewrap comment.
+	(match_attr_spec): Remove ENUM specific code.
+	(gfc_match_enum): Fix typo in error message.
+	(enumerator_decl): New function.
+	(gfc_match_enumerator_def): Use enumerator_decl instead of
+	variable_decl.  Adapt code accordingly.
+
 2007-02-11  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/30554
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index f29b035..8165c79 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -960,10 +960,6 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp,
       *initp = NULL;
     }
 
-  /* Maintain enumerator history.  */
-  if (gfc_current_state () == COMP_ENUM)
-    create_enum_history (sym, init);
-
   return SUCCESS;
 }
 
@@ -1137,14 +1133,6 @@ variable_decl (int elem)
 
   if (m == MATCH_NO)
     as = gfc_copy_array_spec (current_as);
-  else if (gfc_current_state () == COMP_ENUM)
-    {
-      gfc_error ("Enumerator cannot be array at %C");
-      gfc_free_enum_history ();
-      m = MATCH_ERROR;
-      goto cleanup;
-    }
-
 
   char_len = NULL;
   cl = NULL;
@@ -1243,10 +1231,11 @@ variable_decl (int elem)
       goto cleanup;
     }
 
-  /* An interface body specifies all of the procedure's characteristics and these
-     shall be consistent with those specified in the procedure definition, except
-     that the interface may specify a procedure that is not pure if the procedure
-     is defined to be pure(12.3.2).  */
+  /* An interface body specifies all of the procedure's
+     characteristics and these shall be consistent with those
+     specified in the procedure definition, except that the interface
+     may specify a procedure that is not pure if the procedure is
+     defined to be pure(12.3.2).  */
   if (current_ts.type == BT_DERIVED
       && gfc_current_ns->proc_name
       && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
@@ -1360,30 +1349,6 @@ variable_decl (int elem)
       goto cleanup;
     }
 
-  /* Check if we are parsing an enumeration and if the current enumerator
-     variable has an initializer or not. If it does not have an
-     initializer, the initialization value of the previous enumerator 
-     (stored in last_initializer) is incremented by 1 and is used to
-     initialize the current enumerator.  */
-  if (gfc_current_state () == COMP_ENUM)
-    {
-      if (initializer == NULL)
-	initializer = gfc_enum_initializer (last_initializer, old_locus);
- 
-      if (initializer == NULL || initializer->ts.type != BT_INTEGER)
-	{
-	  gfc_error("ENUMERATOR %L not initialized with integer expression",
-		    &var_locus);
-	  m = MATCH_ERROR; 
-	  gfc_free_enum_history ();
-	  goto cleanup;
-	}
-
-      /* Store this current initializer, for the next enumerator
-	 variable to be parsed.  */
-      last_initializer = initializer;
-    }
-
   /* Add the initializer.  Note that it is fine if initializer is
      NULL here, because we sometimes also need to check if a
      declaration *must* have an initialization expression.  */
@@ -2195,12 +2160,6 @@ match_attr_spec (void)
       if (d == DECL_NONE || d == DECL_COLON)
 	break;
        
-      if (gfc_current_state () == COMP_ENUM)
-	{
-	  gfc_error ("Enumerator cannot have attributes %C");
-	  return MATCH_ERROR;
-	}
-
       seen[d]++;
       seen_at[d] = gfc_current_locus;
 
@@ -2219,18 +2178,6 @@ match_attr_spec (void)
 	}
     }
 
-  /* If we are parsing an enumeration and have ensured that no other
-     attributes are present we can now set the parameter attribute.  */
-  if (gfc_current_state () == COMP_ENUM)
-    {
-      t = gfc_add_flavor (&current_attr, FL_PARAMETER, NULL, NULL);
-      if (t == FAILURE)
-	{
-	  m = MATCH_ERROR;
-	  goto cleanup;
-	}
-    }
-
   /* No double colon, so assume that we've been looking at something
      else the whole time.  */
   if (d == DECL_NONE)
@@ -4457,7 +4404,7 @@ gfc_match_enum (void)
   if (m != MATCH_YES)
     return m;
 
-  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ENUM AND ENUMERATOR at %C")
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ENUM and ENUMERATOR at %C")
       == FAILURE)
     return MATCH_ERROR;
 
@@ -4465,19 +4412,116 @@ gfc_match_enum (void)
 }
 
 
+/* Match a variable name with an optional initializer.  When this
+   subroutine is called, a variable is expected to be parsed next.
+   Depending on what is happening at the moment, updates either the
+   symbol table or the current interface.  */
+
+static match
+enumerator_decl (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_expr *initializer;
+  gfc_array_spec *as = NULL;
+  gfc_symbol *sym;
+  locus var_locus;
+  match m;
+  try t;
+  locus old_locus;
+
+  initializer = NULL;
+  old_locus = gfc_current_locus;
+
+  /* When we get here, we've just matched a list of attributes and
+     maybe a type and a double colon.  The next thing we expect to see
+     is the name of the symbol.  */
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  var_locus = gfc_current_locus;
+
+  /* OK, we've successfully matched the declaration.  Now put the
+     symbol in the current namespace. If we fail to create the symbol,
+     bail out.  */
+  if (build_sym (name, NULL, &as, &var_locus) == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  /* The double colon must be present in order to have initializers.
+     Otherwise the statement is ambiguous with an assignment statement.  */
+  if (colon_seen)
+    {
+      if (gfc_match_char ('=') == MATCH_YES)
+	{
+	  m = gfc_match_init_expr (&initializer);
+	  if (m == MATCH_NO)
+	    {
+	      gfc_error ("Expected an initialization expression at %C");
+	      m = MATCH_ERROR;
+	    }
+
+	  if (m != MATCH_YES)
+	    goto cleanup;
+	}
+    }
+
+  /* If we do not have an initializer, the initialization value of the
+     previous enumerator (stored in last_initializer) is incremented
+     by 1 and is used to initialize the current enumerator.  */
+  if (initializer == NULL)
+    initializer = gfc_enum_initializer (last_initializer, old_locus);
+ 
+  if (initializer == NULL || initializer->ts.type != BT_INTEGER)
+    {
+      gfc_error("ENUMERATOR %L not initialized with integer expression",
+		&var_locus);
+      m = MATCH_ERROR; 
+      gfc_free_enum_history ();
+      goto cleanup;
+    }
+
+  /* Store this current initializer, for the next enumerator variable
+     to be parsed.  add_init_expr_to_sym() zeros initializer, so we
+     use last_initializer below.  */
+  last_initializer = initializer;
+  t = add_init_expr_to_sym (name, &initializer, &var_locus);
+
+  /* Maintain enumerator history.  */
+  gfc_find_symbol (name, NULL, 0, &sym);
+  create_enum_history (sym, last_initializer);
+
+  return (t == SUCCESS) ? MATCH_YES : MATCH_ERROR;
+
+cleanup:
+  /* Free stuff up and return.  */
+  gfc_free_expr (initializer);
+
+  return m;
+}
+
+
 /* Match the enumerator definition statement. */
 
 match
 gfc_match_enumerator_def (void)
 {
   match m;
-  int elem; 
+  try t;
   
   gfc_clear_ts (&current_ts);
   
   m = gfc_match (" enumerator");
   if (m != MATCH_YES)
     return m;
+
+  m = gfc_match (" :: ");
+  if (m == MATCH_ERROR)
+    return m;
+
+  colon_seen = (m == MATCH_YES);
   
   if (gfc_current_state () != COMP_ENUM)
     {
@@ -4489,17 +4533,17 @@ gfc_match_enumerator_def (void)
   (&current_ts)->type = BT_INTEGER;
   (&current_ts)->kind = gfc_c_int_kind;
   
-  m = match_attr_spec ();
-  if (m == MATCH_ERROR)
+  gfc_clear_attr (&current_attr);
+  t = gfc_add_flavor (&current_attr, FL_PARAMETER, NULL, NULL);
+  if (t == FAILURE)
     {
-      m = MATCH_NO;
+      m = MATCH_ERROR;
       goto cleanup;
     }
 
-  elem = 1;
   for (;;)
     {
-      m = variable_decl (elem++);
+      m = enumerator_decl ();
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_NO)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7637326..b6a6c0a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-02-11  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/30478
+	* gfortran.dg/enum_4.f90: Update error message checks.
+
 2007-02-11  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/30554
diff --git a/gcc/testsuite/gfortran.dg/enum_4.f90 b/gcc/testsuite/gfortran.dg/enum_4.f90
index 99acda0..be506b4 100644
--- a/gcc/testsuite/gfortran.dg/enum_4.f90
+++ b/gcc/testsuite/gfortran.dg/enum_4.f90
@@ -5,12 +5,12 @@ program main
   implicit none
   enum, bind (c)
     enumerator :: red, black = 2     
-    enumerator :: blue = 1, red  ! { dg-error "already" }
+    enumerator :: blue = 1, red  ! { dg-error "already has basic type" }
   end enum
 
   enum, bind (c)
-    enumerator :: r, b(10) = 2  ! { dg-error "cannot be array" }
-    enumerator , save :: g = 1  ! { dg-error "cannot have attributes" }  
+    enumerator :: r, b(10) = 2  ! { dg-error "Syntax error" }
+    enumerator , save :: g = 1  ! { dg-error "Syntax error" }  
   end  ! { dg-error " END ENUM" } 
 
 end program main  ! { dg-excess-errors "" }