Mercurial > hg > CbC > CbC_gcc
diff gcc/fortran/trans-common.c @ 145:1830386684a0
gcc-9.2.0
author | anatofuz |
---|---|
date | Thu, 13 Feb 2020 11:34:05 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line diff
--- a/gcc/fortran/trans-common.c Thu Oct 25 07:37:49 2018 +0900 +++ b/gcc/fortran/trans-common.c Thu Feb 13 11:34:05 2020 +0900 @@ -1,5 +1,5 @@ /* Common block and equivalence list handling - Copyright (C) 2000-2018 Free Software Foundation, Inc. + Copyright (C) 2000-2020 Free Software Foundation, Inc. Contributed by Canqun Yang <canqun@nudt.edu.cn> This file is part of GCC. @@ -282,7 +282,7 @@ unsigned HOST_WIDE_INT desired_align, known_align; name = get_identifier (h->sym->name); - field = build_decl (h->sym->declared_at.lb->location, + field = build_decl (gfc_get_location (&h->sym->declared_at), FIELD_DECL, name, h->field); known_align = (offset & -offset) * BITS_PER_UNIT; if (known_align == 0 || known_align > BIGGEST_ALIGNMENT) @@ -339,7 +339,7 @@ /* Get storage for local equivalence. */ static tree -build_equiv_decl (tree union_type, bool is_init, bool is_saved) +build_equiv_decl (tree union_type, bool is_init, bool is_saved, bool is_auto) { tree decl; char name[18]; @@ -359,8 +359,8 @@ DECL_ARTIFICIAL (decl) = 1; DECL_IGNORED_P (decl) = 1; - if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) - || is_saved) + if (!is_auto && (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) + || is_saved)) TREE_STATIC (decl) = 1; TREE_ADDRESSABLE (decl) = 1; @@ -559,7 +559,7 @@ tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); tmp = build_array_type (type, tmp); - field = build_decl (gfc_current_locus.lb->location, + field = build_decl (gfc_get_location (&gfc_current_locus), FIELD_DECL, NULL_TREE, tmp); known_align = BIGGEST_ALIGNMENT; @@ -611,6 +611,7 @@ 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 @@ -654,6 +655,10 @@ /* 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); @@ -661,7 +666,7 @@ if (com) decl = build_common_decl (com, union_type, is_init); else - decl = build_equiv_decl (union_type, is_init, is_saved); + decl = build_equiv_decl (union_type, is_init, is_saved, is_auto); if (is_init) { @@ -706,7 +711,7 @@ { tree var_decl; - var_decl = build_decl (s->sym->declared_at.lb->location, + var_decl = build_decl (gfc_get_location (&s->sym->declared_at), VAR_DECL, DECL_NAME (s->field), TREE_TYPE (s->field)); TREE_STATIC (var_decl) = TREE_STATIC (decl); @@ -948,6 +953,59 @@ 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.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. */ @@ -965,9 +1023,12 @@ eq = NULL; /* Search the equivalence list, including the root (first) element - for the symbol that owns the segment. */ + 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 +1036,8 @@ } } + gfc_check_conflict (&dummy_symbol, e1->expr->symtree->name, &e1->expr->where); + /* Go to the next root element. */ if (eq == NULL) continue; @@ -1007,10 +1070,8 @@ add_equivalences (bool *saw_equiv) { segment_info *f; - bool seen_one, more; + bool more = TRUE; - seen_one = false; - more = TRUE; while (more) { more = FALSE; @@ -1019,7 +1080,7 @@ if (!f->sym->equiv_built) { f->sym->equiv_built = 1; - seen_one = find_equivalence (f); + bool seen_one = find_equivalence (f); if (seen_one) { *saw_equiv = true; @@ -1156,13 +1217,13 @@ gfc_warning (OPT_Walign_commons, "Padding of %d bytes required before %qs in " "COMMON %qs at %L; reorder elements or use " - "-fno-align-commons", (int)offset, + "%<-fno-align-commons%>", (int)offset, s->sym->name, common->name, &common->where); else gfc_warning (OPT_Walign_commons, "Padding of %d bytes required before %qs in " "COMMON at %L; reorder elements or use " - "-fno-align-commons", (int)offset, + "%<-fno-align-commons%>", (int)offset, s->sym->name, &common->where); } }