*initp = NULL;
}
- /* Maintain enumerator history. */
- if (gfc_current_state () == COMP_ENUM)
- create_enum_history (sym, init);
-
return SUCCESS;
}
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;
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
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. */
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;
}
}
- /* 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)
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;
}
+/* 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)
{
(¤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)