diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index c373419..880630a 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2867,6 +2867,7 @@ bool gfc_merge_new_implicit (gfc_typespec *); void gfc_set_implicit_none (bool, bool, locus *); void gfc_check_function_type (gfc_namespace *); bool gfc_is_intrinsic_typename (const char *); +bool check_conflict (symbol_attribute *, const char *, locus *); gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *); bool gfc_set_default_type (gfc_symbol *, int, gfc_namespace *); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 67ad504..29b40fd 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -363,7 +363,7 @@ gfc_check_function_type (gfc_namespace *ns) goto conflict_std;\ } -static bool +bool check_conflict (symbol_attribute *attr, const char *name, locus *where) { static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER", @@ -496,7 +496,9 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (allocatable, elemental); conf (in_common, automatic); +#if 0 conf (in_equivalence, automatic); +#endif conf (result, automatic); conf (use_assoc, automatic); conf (dummy, automatic); diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 36370eb..4cfaf61 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -948,6 +948,61 @@ add_condition (segment_info *f, gfc_equiv *eq1, gfc_equiv *eq2) confirm_condition (f, eq1, n, eq2); } +static void +accumulate_equivalence_attributes (symbol_attribute *dummy_symbol, gfc_equiv *e) +{ + symbol_attribute attr = e->expr->symtree->n.sym->attr; + + dummy_symbol->dummy |= attr.dummy; + dummy_symbol->pointer |= attr.pointer; + dummy_symbol->target |= attr.target; + dummy_symbol->external |= attr.external; + dummy_symbol->intrinsic |= attr.intrinsic; + dummy_symbol->allocatable |= attr.allocatable; + dummy_symbol->elemental |= attr.elemental; + dummy_symbol->recursive |= attr.recursive; + dummy_symbol->in_common |= attr.in_common; + dummy_symbol->result |= attr.result; + dummy_symbol->in_namelist |= attr.in_namelist; + dummy_symbol->optional |= attr.optional; + dummy_symbol->entry |= attr.entry; + dummy_symbol->function |= attr.function; + dummy_symbol->subroutine |= attr.subroutine; + dummy_symbol->dimension |= attr.dimension; + dummy_symbol->in_equivalence |= attr.in_equivalence; + dummy_symbol->use_assoc |= attr.use_assoc; + dummy_symbol->cray_pointer |= attr.cray_pointer; + dummy_symbol->cray_pointee |= attr.cray_pointee; + dummy_symbol->data |= attr.data; + dummy_symbol->value |= attr.value; + dummy_symbol->volatile_ |= attr.volatile_; + dummy_symbol->is_protected |= attr.is_protected; + dummy_symbol->is_bind_c |= attr.is_bind_c; + dummy_symbol->procedure |= attr.procedure; + dummy_symbol->proc_pointer |= attr.proc_pointer; + dummy_symbol->abstract |= attr.abstract; + dummy_symbol->asynchronous |= attr.asynchronous; + dummy_symbol->codimension |= attr.codimension; + dummy_symbol->contiguous |= attr.contiguous; + dummy_symbol->generic |= attr.generic; + dummy_symbol->automatic |= attr.automatic; + dummy_symbol->threadprivate |= attr.threadprivate; + dummy_symbol->omp_declare_target |= attr.omp_declare_target; + dummy_symbol->omp_declare_target_link |= attr.omp_declare_target_link; + dummy_symbol->oacc_declare_copyin |= attr.oacc_declare_copyin; + dummy_symbol->oacc_declare_create |= attr.oacc_declare_create; + dummy_symbol->oacc_declare_deviceptr |= attr.oacc_declare_deviceptr; + dummy_symbol->oacc_declare_device_resident + |= attr.oacc_declare_device_resident; + + /* Not strictly correct, but probably close enough. */ + if (attr.save > dummy_symbol->save) + dummy_symbol->save = attr.save; + if (attr.intent > dummy_symbol->intent) + dummy_symbol->intent = attr.intent; + if (attr.access > dummy_symbol->access) + dummy_symbol->access = attr.access; +} /* Given a segment element, search through the equivalence lists for unused conditions that involve the symbol. Add these rules to the segment. */ @@ -966,8 +1021,11 @@ find_equivalence (segment_info *n) /* Search the equivalence list, including the root (first) element for the symbol that owns the segment. */ + symbol_attribute dummy_symbol; + memset (&dummy_symbol, 0, sizeof (dummy_symbol)); for (e2 = e1; e2; e2 = e2->eq) { + accumulate_equivalence_attributes (&dummy_symbol, e2); if (!e2->used && e2->expr->symtree->n.sym == n->sym) { eq = e2; @@ -975,6 +1033,8 @@ find_equivalence (segment_info *n) } } + check_conflict (&dummy_symbol, e1->expr->symtree->name, &e1->expr->where); + /* Go to the next root element. */ if (eq == NULL) continue; diff -Nrcp gcc-8.2.1-20180801/gcc/fortran/trans-common.c save/gcc/fortran/trans-common.c *** a/gcc/fortran/trans-common.c 2018-08-14 18:17:28.000000000 -0400 --- b/gcc/fortran/trans-common.c 2018-08-14 17:57:51.000000000 -0400 *************** build_field (segment_info *h, tree union *** 339,345 **** /* Get storage for local equivalence. */ static tree ! build_equiv_decl (tree union_type, bool is_init, bool is_saved) { tree decl; char name[18]; --- 339,345 ---- /* Get storage for local equivalence. */ static tree ! build_equiv_decl (tree union_type, bool is_init, bool is_saved, bool is_auto) { tree decl; char name[18]; *************** build_equiv_decl (tree union_type, bool *** 359,366 **** DECL_ARTIFICIAL (decl) = 1; DECL_IGNORED_P (decl) = 1; ! if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) ! || is_saved) TREE_STATIC (decl) = 1; TREE_ADDRESSABLE (decl) = 1; --- 359,367 ---- DECL_ARTIFICIAL (decl) = 1; DECL_IGNORED_P (decl) = 1; ! if (!is_auto ! && (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) ! || is_saved)) TREE_STATIC (decl) = 1; TREE_ADDRESSABLE (decl) = 1; *************** create_common (gfc_common_head *com, seg *** 611,616 **** --- 612,618 ---- tree decl; bool is_init = false; bool is_saved = false; + bool is_auto = false; /* Declare the variables inside the common block. If the current common block contains any equivalence object, then *************** create_common (gfc_common_head *com, seg *** 654,659 **** --- 656,665 ---- /* Has SAVE attribute. */ if (s->sym->attr.save) is_saved = true; + + /* Has AUTOMATIC attribute. */ + if (s->sym->attr.automatic) + is_auto = true; } finish_record_layout (rli, true); *************** create_common (gfc_common_head *com, seg *** 661,667 **** if (com) decl = build_common_decl (com, union_type, is_init); else ! decl = build_equiv_decl (union_type, is_init, is_saved); if (is_init) { --- 667,673 ---- if (com) decl = build_common_decl (com, union_type, is_init); else ! decl = build_equiv_decl (union_type, is_init, is_saved, is_auto); if (is_init) {