found_id = MATCH_YES;
gfc_get_ha_symbol (name, &tmp_sym);
}
- else if (match_common_name (name) == MATCH_YES)
+ else if (gfc_match_common_name (name) == MATCH_YES)
{
found_id = MATCH_YES;
com_block = gfc_get_common (name, 0);
found_id = MATCH_YES;
gfc_get_ha_symbol (name, &tmp_sym);
}
- else if (match_common_name (name) == MATCH_YES)
+ else if (gfc_match_common_name (name) == MATCH_YES)
{
found_id = MATCH_YES;
com_block = gfc_get_common (name, 0);
/* Match a common block name. */
-match match_common_name (char *name)
+match
+gfc_match_common_name (char *name)
{
match m;
for (;;)
{
- m = match_common_name (name);
+ m = gfc_match_common_name (name);
if (m == MATCH_ERROR)
goto cleanup;
/* We want to use this function to check for a common-block-name
that can exist in a bind statement, so removed the "static"
- declaration of the function in match.c.
+ declaration of the function in match.c. */
- TODO: should probably rename this now that it'll be globally seen to
- gfc_match_common_name. */
-match match_common_name (char *name);
+match gfc_match_common_name (char *name);
match gfc_match_common (void);
match gfc_match_block_data (void);
resolve_common_vars (gfc_common_head *common_block, bool named_common)
{
gfc_symbol *csym = common_block->head;
+ gfc_gsymbol *gsym;
for (; csym; csym = csym->common_next)
{
+ gsym = gfc_find_gsymbol (gfc_gsym_root, csym->name);
+ if (gsym && (gsym->type == GSYM_MODULE || gsym->type == GSYM_PROGRAM))
+ gfc_error_now ("Global entity %qs at %L cannot appear in a "
+ "COMMON block at %L", gsym->name,
+ &gsym->where, &csym->common_block->where);
+
/* gfc_add_in_common may have been called before, but the reported errors
have been ignored to continue parsing.
We do the checks again here. */
--- /dev/null
+! { dg-do compile }
+
+module m ! { dg-error ".1." }
+ common m ! { dg-error "cannot appear in a COMMON" }
+end
+
--- /dev/null
+! { dg-do compile }
+
+module m ! { dg-error ".1." }
+ common /xc/ m ! { dg-error "cannot appear in a COMMON" }
+end
+
--- /dev/null
+! { dg-do compile }
+
+subroutine s
+end subroutine
+
+program pr95614
+ common /c1/ s
+ s = 9.0
+end program
--- /dev/null
+! { dg-do compile }
+
+function f()
+ f = 1.0
+end function
+
+program pr95614
+ common /c1/ f
+end program