/* Match the stuff following a DATA statement. If ERROR_FLAG is set,
we are matching a DATA statement and are therefore issuing an error
- if we encounter something unexpected, if not, we're trying to match
+ if we encounter something unexpected, if not, we're trying to match
an old-style initialization expression of the form INTEGER I /2/. */
match
int i;
i = gfc_get_symbol (name, NULL, result);
- if (i == 0)
+ if (i == 0)
goto end;
-
+
if (gfc_current_state () != COMP_SUBROUTINE
&& gfc_current_state () != COMP_FUNCTION)
goto end;
}
-/* Function to create and update the enumerator history
+/* Function to create and update the enumerator history
using the information passed as arguments.
- Pointer "max_enum" is also updated, to point to
- enum history node containing largest initializer.
+ Pointer "max_enum" is also updated, to point to
+ enum history node containing largest initializer.
SYM points to the symbol node of enumerator.
INIT points to its enumerator value. */
-static void
+static void
create_enum_history (gfc_symbol *sym, gfc_expr *init)
{
enumerator_history *new_enum_history;
new_enum_history->next = enum_history;
enum_history = new_enum_history;
- if (mpz_cmp (max_enum->initializer->value.integer,
+ if (mpz_cmp (max_enum->initializer->value.integer,
new_enum_history->initializer->value.integer) < 0)
max_enum = new_enum_history;
}
}
-/* Function to free enum kind history. */
+/* Function to free enum kind history. */
-void
+void
gfc_free_enum_history (void)
{
- enumerator_history *current = enum_history;
- enumerator_history *next;
+ enumerator_history *current = enum_history;
+ enumerator_history *next;
while (current != NULL)
{
{
if (gfc_set_array_spec (sym, cp_as, &var_locus) == FAILURE)
gfc_internal_error ("Couldn't set pointee array spec.");
-
+
/* Fix the array spec. */
- m = gfc_mod_pointee_as (sym->as);
+ m = gfc_mod_pointee_as (sym->as);
if (m == MATCH_ERROR)
goto cleanup;
}
- }
+ }
goto cleanup;
}
else
gfc_free_array_spec (cp_as);
}
}
-
-
+
+
/* OK, we've successfully matched the declaration. Now put the
symbol in the current namespace, because it might be used in the
optional initialization expression for this symbol, e.g. this is
if (gfc_notify_std (GFC_STD_GNU, "Extension: Old-style "
"initialization at %C") == FAILURE)
return MATCH_ERROR;
-
+
return match_old_style_init (name);
}
to the matched specification. This is necessary for FUNCTION and
IMPLICIT statements.
- If implicit_flag is nonzero, then we don't check for the optional
+ If implicit_flag is nonzero, then we don't check for the optional
kind specification. Not doing so is needed for matching an IMPLICIT
statement correctly. */
if (gfc_match (" byte") == MATCH_YES)
{
- if (gfc_notify_std(GFC_STD_GNU, "Extension: BYTE type at %C")
+ if (gfc_notify_std(GFC_STD_GNU, "Extension: BYTE type at %C")
== FAILURE)
return MATCH_ERROR;
"is not available on the target machine");
return MATCH_ERROR;
}
-
+
ts->type = BT_INTEGER;
ts->kind = 1;
return MATCH_YES;
return MATCH_ERROR;
}
- if (gfc_find_symtree (gfc_current_ns->sym_root,name))
+ if (gfc_find_symtree (gfc_current_ns->sym_root,name))
{
gfc_warning ("'%s' is already IMPORTed from host scoping unit "
"at %C.", name);
d = (decl_types) gfc_match_strings (decls);
if (d == DECL_NONE || d == DECL_COLON)
break;
-
+
seen[d]++;
seen_at[d] = gfc_current_locus;
if (gfc_current_state () == COMP_DERIVED
&& d != DECL_DIMENSION && d != DECL_POINTER
- && d != DECL_COLON && d != DECL_NONE)
+ && d != DECL_COLON && d != DECL_PRIVATE
+ && d != DECL_PUBLIC && d != DECL_NONE)
{
if (d == DECL_ALLOCATABLE)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ALLOCATABLE "
"attribute at %C in a TYPE definition")
- == FAILURE)
+ == FAILURE)
{
m = MATCH_ERROR;
goto cleanup;
else
{
gfc_error ("Attribute at %L is not allowed in a TYPE definition",
- &seen_at[d]);
+ &seen_at[d]);
m = MATCH_ERROR;
goto cleanup;
}
attr = "PRIVATE";
else
attr = "PUBLIC";
-
- gfc_error ("%s attribute at %L is not allowed outside of a MODULE",
- attr, &seen_at[d]);
- m = MATCH_ERROR;
- goto cleanup;
+ if (gfc_current_state () == COMP_DERIVED
+ && gfc_state_stack->previous
+ && gfc_state_stack->previous->state == COMP_MODULE)
+ {
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Attribute %s "
+ "at %L in a TYPE definition", attr,
+ &seen_at[d])
+ == FAILURE)
+ {
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
+ }
+ else
+ {
+ gfc_error ("%s attribute at %L is not allowed outside of the "
+ "specification part of a module", attr, &seen_at[d]);
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
}
switch (d)
return 0;
}
-/* Set the kind of each enumerator. The kind is selected such that it is
+/* Set the kind of each enumerator. The kind is selected such that it is
interoperable with the corresponding C enumeration type, making
sure that -fshort-enums is honored. */
return;
if (!gfc_option.fshort_enums)
- return;
-
+ return;
+
i = 0;
do
{
kind = gfc_integer_kinds[i++].kind;
}
- while (kind < gfc_c_int_kind
+ while (kind < gfc_c_int_kind
&& gfc_check_integer_range (max_enum->initializer->value.integer,
kind) != ARITH_OK);
m = MATCH_ERROR;
goto cleanup;
}
-
+
if (sym->attr.cray_pointee && sym->as != NULL)
{
/* Fix the array spec. */
/* This routine matches Cray Pointer declarations of the form:
pointer ( <pointer>, <pointee> )
or
- pointer ( <pointer1>, <pointee1> ), ( <pointer2>, <pointee2> ), ...
- The pointer, if already declared, should be an integer. Otherwise, we
+ pointer ( <pointer1>, <pointee1> ), ( <pointer2>, <pointee2> ), ...
+ The pointer, if already declared, should be an integer. Otherwise, we
set it as BT_INTEGER with kind gfc_index_integer_kind. The pointee may
be either a scalar, or an array declaration. No space is allocated for
- the pointee. For the statement
+ the pointee. For the statement
pointer (ipt, ar(10))
any subsequent uses of ar will be translated (in C-notation) as
- ar(i) => ((<type> *) ipt)(i)
+ ar(i) => ((<type> *) ipt)(i)
After gimplification, pointee variable will disappear in the code. */
static match
if (gfc_match_char ('(') != MATCH_YES)
{
gfc_error ("Expected '(' at %C");
- return MATCH_ERROR;
+ return MATCH_ERROR;
}
-
+
/* Match pointer. */
var_locus = gfc_current_locus;
gfc_clear_attr (¤t_attr);
current_ts.type = BT_INTEGER;
current_ts.kind = gfc_index_integer_kind;
- m = gfc_match_symbol (&cptr, 0);
+ m = gfc_match_symbol (&cptr, 0);
if (m != MATCH_YES)
{
gfc_error ("Expected variable name at %C");
return m;
}
-
+
if (gfc_add_cray_pointer (&cptr->attr, &var_locus) == FAILURE)
return MATCH_ERROR;
- gfc_set_sym_referenced (cptr);
+ gfc_set_sym_referenced (cptr);
if (cptr->ts.type == BT_UNKNOWN) /* Override the type, if necessary. */
{
cptr->ts.type = BT_INTEGER;
- cptr->ts.kind = gfc_index_integer_kind;
+ cptr->ts.kind = gfc_index_integer_kind;
}
else if (cptr->ts.type != BT_INTEGER)
{
if (gfc_match_char (',') != MATCH_YES)
{
gfc_error ("Expected \",\" at %C");
- return MATCH_ERROR;
+ return MATCH_ERROR;
}
- /* Match Pointee. */
+ /* Match Pointee. */
var_locus = gfc_current_locus;
gfc_clear_attr (¤t_attr);
gfc_add_cray_pointee (¤t_attr, &var_locus);
gfc_error ("Expected variable name at %C");
return m;
}
-
+
/* Check for an optional array spec. */
m = gfc_match_array_spec (&as);
if (m == MATCH_ERROR)
if (gfc_match ("private") != MATCH_YES)
return MATCH_NO;
+ if (gfc_current_state () != COMP_MODULE
+ && (gfc_current_state () != COMP_DERIVED
+ || !gfc_state_stack->previous
+ || gfc_state_stack->previous->state != COMP_MODULE))
+ {
+ gfc_error ("PRIVATE statement at %C is only allowed in the "
+ "specification part of a module");
+ return MATCH_ERROR;
+ }
+
if (gfc_current_state () == COMP_DERIVED)
{
if (gfc_match_eos () == MATCH_YES)
if (gfc_match ("public") != MATCH_YES)
return MATCH_NO;
+ if (gfc_current_state () != COMP_MODULE)
+ {
+ gfc_error ("PUBLIC statement at %C is only allowed in the "
+ "specification part of a module");
+ return MATCH_ERROR;
+ }
+
if (gfc_match_eos () == MATCH_YES)
{
*st = ST_PUBLIC;
loop:
if (gfc_match (" , private") == MATCH_YES)
{
- if (gfc_find_state (COMP_MODULE) == FAILURE)
+ if (gfc_current_state () != COMP_MODULE)
{
- gfc_error ("Derived type at %C can only be PRIVATE within a MODULE");
+ gfc_error ("Derived type at %C can only be PRIVATE in the "
+ "specification part of a module");
return MATCH_ERROR;
}
if (gfc_match (" , public") == MATCH_YES)
{
- if (gfc_find_state (COMP_MODULE) == FAILURE)
+ if (gfc_current_state () != COMP_MODULE)
{
- gfc_error ("Derived type at %C can only be PUBLIC within a MODULE");
+ gfc_error ("Derived type at %C can only be PUBLIC in the "
+ "specification part of a module");
return MATCH_ERROR;
}
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;
+ m = MATCH_ERROR;
gfc_free_enum_history ();
goto cleanup;
}
{
match m;
try t;
-
+
gfc_clear_ts (¤t_ts);
-
+
m = gfc_match (" enumerator");
if (m != MATCH_YES)
return m;
return m;
colon_seen = (m == MATCH_YES);
-
+
if (gfc_current_state () != COMP_ENUM)
{
gfc_error ("ENUM definition statement expected before %C");
(¤t_ts)->type = BT_INTEGER;
(¤t_ts)->kind = gfc_c_int_kind;
-
+
gfc_clear_attr (¤t_attr);
t = gfc_add_flavor (¤t_attr, FL_PARAMETER, NULL, NULL);
if (t == FAILURE)
projects / platform / upstream / gcc.git / commitdiff