diff options
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 52 |
1 files changed, 52 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b249f30..615d85e 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -594,6 +594,56 @@ resolve_entries (gfc_namespace *ns) } +/* Resolve common blocks. */ +static void +resolve_common_blocks (gfc_symtree *common_root) +{ + gfc_symtree *symtree; + gfc_symbol *sym; + + if (common_root == NULL) + return; + + for (symtree = common_root; symtree->left; symtree = symtree->left); + + for (; symtree; symtree = symtree->right) + { + gfc_find_symbol (symtree->name, gfc_current_ns, 0, &sym); + if (sym == NULL) + continue; + + if (sym->attr.flavor == FL_PARAMETER) + { + gfc_error ("COMMON block '%s' at %L is used as PARAMETER at %L", + sym->name, &symtree->n.common->where, + &sym->declared_at); + } + + if (sym->attr.intrinsic) + { + gfc_error ("COMMON block '%s' at %L is also an intrinsic " + "procedure", sym->name, + &symtree->n.common->where); + } + else if (sym->attr.result + ||(sym->attr.function && gfc_current_ns->proc_name == sym)) + { + gfc_notify_std (GFC_STD_F2003, "Fortran 2003: COMMON block '%s' " + "at %L that is also a function result", sym->name, + &symtree->n.common->where); + } + else if (sym->attr.flavor == FL_PROCEDURE + && sym->attr.proc != PROC_INTERNAL + && sym->attr.proc != PROC_ST_FUNCTION) + { + gfc_notify_std (GFC_STD_F2003, "Fortran 2003: COMMON block '%s' " + "at %L that is also a global procedure", sym->name, + &symtree->n.common->where); + } + } +} + + /* Resolve contained function types. Because contained functions can call one another, they have to be worked out before any of the contained procedures can be resolved. @@ -8197,6 +8247,8 @@ resolve_types (gfc_namespace *ns) resolve_entries (ns); + resolve_common_blocks (ns->common_root); + resolve_contained_functions (ns); gfc_traverse_ns (ns, resolve_bind_c_derived_types); |