203 lines
7.1 KiB
Diff
203 lines
7.1 KiB
Diff
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)
|
|
{
|