aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/resolve.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/resolve.c')
-rw-r--r--gcc/fortran/resolve.c48
1 files changed, 35 insertions, 13 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6cde79f..0f96cd6 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -646,23 +646,27 @@ has_default_initializer (gfc_symbol *der)
return c != NULL;
}
-
-/* Resolve common blocks. */
+/* Resolve common variables. */
static void
-resolve_common_blocks (gfc_symtree *common_root)
+resolve_common_vars (gfc_symbol *sym, bool named_common)
{
- gfc_symbol *sym, *csym;
-
- if (common_root == NULL)
- return;
+ gfc_symbol *csym = sym;
- if (common_root->left)
- resolve_common_blocks (common_root->left);
- if (common_root->right)
- resolve_common_blocks (common_root->right);
-
- for (csym = common_root->n.common->head; csym; csym = csym->common_next)
+ for (; csym; csym = csym->common_next)
{
+ if (csym->value || csym->attr.data)
+ {
+ if (!csym->ns->is_block_data)
+ gfc_notify_std (GFC_STD_GNU, "Variable '%s' at %L is in COMMON "
+ "but only in BLOCK DATA initialization is "
+ "allowed", csym->name, &csym->declared_at);
+ else if (!named_common)
+ gfc_notify_std (GFC_STD_GNU, "Initialized variable '%s' at %L is "
+ "in a blank COMMON but initialization is only "
+ "allowed in named common blocks", csym->name,
+ &csym->declared_at);
+ }
+
if (csym->ts.type != BT_DERIVED)
continue;
@@ -680,6 +684,23 @@ resolve_common_blocks (gfc_symtree *common_root)
"may not have default initializer", csym->name,
&csym->declared_at);
}
+}
+
+/* Resolve common blocks. */
+static void
+resolve_common_blocks (gfc_symtree *common_root)
+{
+ gfc_symbol *sym;
+
+ if (common_root == NULL)
+ return;
+
+ if (common_root->left)
+ resolve_common_blocks (common_root->left);
+ if (common_root->right)
+ resolve_common_blocks (common_root->right);
+
+ resolve_common_vars (common_root->n.common->head, true);
gfc_find_symbol (common_root->name, gfc_current_ns, 0, &sym);
if (sym == NULL)
@@ -8939,6 +8960,7 @@ resolve_types (gfc_namespace *ns)
resolve_entries (ns);
+ resolve_common_vars (ns->blank_common.head, false);
resolve_common_blocks (ns->common_root);
resolve_contained_functions (ns);