diff options
Diffstat (limited to 'gcc/fortran/symbol.c')
| -rw-r--r-- | gcc/fortran/symbol.c | 32 |
1 files changed, 32 insertions, 0 deletions
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index df6ada963c3..18f7b253a28 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2565,6 +2565,27 @@ select_type_insert_tmp (gfc_symtree **st) } +/* Look for a symtree in the current procedure -- that is, go up to + parent namespaces but only if inside a BLOCK. Returns NULL if not found. */ + +gfc_symtree* +gfc_find_symtree_in_proc (const char* name, gfc_namespace* ns) +{ + while (ns) + { + gfc_symtree* st = gfc_find_symtree (ns->sym_root, name); + if (st) + return st; + + if (!ns->construct_entities) + break; + ns = ns->parent; + } + + return NULL; +} + + /* Search for a symtree starting in the current namespace, resorting to any parent namespaces if requested by a nonzero parent_flag. Returns nonzero if the name is ambiguous. */ @@ -2811,6 +2832,17 @@ gfc_symbols_could_alias (gfc_symbol *lsym, gfc_symbol *rsym) if (lsym->attr.allocatable && rsym->attr.pointer) return 1; + /* Special case: Argument association, cf. F90 12.4.1.6, F2003 12.4.1.7 + and F2008 12.5.2.13 items 3b and 4b. The pointer case (a) is already + checked above. */ + if (lsym->attr.target && rsym->attr.target + && ((lsym->attr.dummy && !lsym->attr.contiguous + && (!lsym->attr.dimension || lsym->as->type == AS_ASSUMED_SHAPE)) + || (rsym->attr.dummy && !rsym->attr.contiguous + && (!rsym->attr.dimension + || rsym->as->type == AS_ASSUMED_SHAPE)))) + return 1; + return 0; } |