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
This commit is contained in:
parent
10c5453183
commit
6133c68a73
|
@ -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
|
||||
|
|
|
@ -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 (¤t_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 (¤t_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)
|
|||
(¤t_ts)->type = BT_INTEGER;
|
||||
(¤t_ts)->kind = gfc_c_int_kind;
|
||||
|
||||
m = match_attr_spec ();
|
||||
if (m == MATCH_ERROR)
|
||||
gfc_clear_attr (¤t_attr);
|
||||
t = gfc_add_flavor (¤t_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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 "" }
|
||||
|
|
Loading…
Reference in New Issue